From 2fddab6aaa9aec3a58bcf8ffa09cd011b18d7f9c Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 12 Feb 2018 11:23:23 +0100 Subject: [PATCH] TECO 714 --- src/_teco_/teco.714 | 20576 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 20576 insertions(+) create mode 100644 src/_teco_/teco.714 diff --git a/src/_teco_/teco.714 b/src/_teco_/teco.714 new file mode 100644 index 00000000..d3a8793e --- /dev/null +++ b/src/_teco_/teco.714 @@ -0,0 +1,20576 @@ +; -*-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 TNX,[ +IFNDEF EMCSDV,EMCSDV==0 ; CAUSES TRANSLATION OF TO EMACS: FOR TNX +IFNDEF INFODV,INFODV==0 +.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. +CHECDS==13 ;FOR FS ECHO DISPLAY$ ONLY. +CHSIO==14 ;SUPER IMAGE OUTPUT. +CHTTYO==15 ;NORMAL TYPEOUT. + +TYPIN==1_ +TSMSK==%PJATY\%PJWRO\%PJRLT,,%PIPDL+%PIMPV +TSMSK1==TYPIN + +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, +IFN TNX,.VALUE=HALTF + +IF1 EXPUNGE EDIT ;STUPID WORTHLESS EXTENDED INSTRUCTION GETS IN THE WAY. + +.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 +$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 QREG SPACE BY. +IFNDEF SLPWRD,SLPWRD==400 ;# WDS TO EXPAND BUFFER GAP BY. +IFNDEF GCOFTN,GCOFTN==5*2000*10. ;# CHARS OF QREGS 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. + +SPD==60.*60.*24. ;NUMBER OF SECONDS IN A DAY (FITS IN A HALFWORD) + +SUBTTL MACROS + +$%.==<.FNAM2_<-36>>&17*100.+<.FNAM2_<-30>>&17*10.+<.FNAM2_<-22>>&17 + +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 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==$%. +] + +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==100. +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 +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 7 +MORMCL=,. + ^P ? "V ? MORMCV: 0 ? ^M ? ^P ? "L ? ^C ? ^C ? ^C ? ^C + .BYTE +IFN 700000&(DISCPH),[ ;IF MIDAS DEFINED ALL THE TAGS 1 BYTE TO SMALL, FIX THEM UP. +IRPS XX,,DISCPV DISCPH DISC1V MORMCV +.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. +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). +MORESW: 0 ;0 => NO --MORE-- OR ANYTHING. 1 => --BOT--. 2 => --TOP--. 3 => --MIDDLE--. +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. +DISOMD: -1 ;WHAT $QMODE HAD WHEN LAST DISPLAYED. + ;IF $QMODE NE DISOMD, MUST REDISPLAY THE MODE. +TYOFLG: -1 ;>= 0 ==> TYPEOUT INITTED. +ECHACT: 0 ;-1 => SOMETHING WAS PRINTED IN THE ECHO AREA, SO ^R SHOULD CLEAR IT. FS ECHO DIRTY$. +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. + +IFNDEF DISBFL,DISBFL==MXNHLS/4+1 ;LENGTH OF TTY IOT BUFFER. + +IFN TNX,[ +EOLFLG: 0 ;KLUGE FLAG FOR TERMINALS WITH NO CLEOL +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$) +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. +DWAIT: 0 ;WAIT FOR OUTPUT TO FINISH BETWEEN LINES, TO AVOID BUFFERING UP LOTS OF STUFF. +SHOMOD: 0 ;ON PRINTING TTY, FR TYPES OUT ..J IF THIS IS NONZERO. + +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 + +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,[ +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) +PAGMOD: 0 ;NON-ZERO => LEAVE TERMINAL IN PAGE MODE (FOR ^S/^Q) +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 +TTLPOS: 0 ;REAL SCREEN POSITION (INTERNAL RFPOS/SFPOS EQUIVALENT) +CHFILI: 0 ;INPUT FILE JFN +CHFILO: 0 ;OUTPUT FILE JFN +DEFDEV: ASCII /DSK/ ;DEFAULT DEVICE + 0 +DEFDIR: BLOCK 10 ;DIRECTORY NUMBER +DEFFN1: ASCII /FILE/ ;DEFAULT TO SOMETHING RANDOM + BLOCK 7 ;NAME +DEFFN2: BLOCK 10 ;EXTENSION +DEFFN3: 0 ;GENERATION NUMBER +ERDEV: BLOCK 33 ;SAME FORMAT - LAST READ FILE'S NAME +ROUDEV: BLOCK 33 ;DITTO - REAL OUTPUT FILENAMES +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 +MORMCL: BLOCK 4 ;CLEAR MORE LINE +SAV123: 0 ;JSR HERE TO SAVE AC'S 1 2 AND 3 ON THE STACK + SAVE A + SAVE B + SAVE C + JRST @SAV123 + +%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 +] +;[ + +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 QREG STRING (FOLLOWED BY 3 CHARS HOLDING + ;21-BIT SIZE OF QREG 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 + +;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 +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 +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==760000 ;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. +MFREADO==020000 ;1 => DONT ALLOW MODIFICATION OF THIS BUFFER + +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. + + +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 ;QREG-STRING 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 +GCNRLC: 0 ;-1 => GC SHOULDN'T RELOCATE STRINGS, JUST FLUSH UNNEEDED BUFFERS. +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. +IFN TNX,CLKINT: 0 ;LENGTH OF INTERVAL AT WHICH TO RUN CLOCK ROUTINE +CLKMAC: 0 ;POINTER TO REAL-TIME CLOCK ROUTINE. +RUNFLG: 0 ;-1 ==> TECO HAS BEEN RUN. Q..Q, ETC. HAVE BEEN INITTED. +QRGCMX: INIQRB+GCOFTN ;GC QREGS WHEN QRWRT GETS THIS LARGE. +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: 0 ;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. +LTABS==100. +STAB: ;WITHIN "O" COMMAND SEARCH, HOLDS THE TAG NAME. +LBF: ;OUTPUT BUFFER FOR "@" AND "^O" COMMANDS. +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. + +MSNAME: 0 ;WORKING DIRECTORY (SIXBIT IN ITS, DIR # IN TWENEX). +HSNAME: 0 ;HOME DIRECTORY (" " "). +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. +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. +YANKMT: 0 ;0 EXCEPT INSIDE YANK, HAS WHAT MEMT HAD AT START OF YANK. + ;USED TO ELIMINATE EXCESS LOW-BIT CLEARING. +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 + +IFN ITS,BOOTSN: '.TECO. ;SNAME OF TECO PDUMP FILE FOR EJ FILES TO BOOT TECO FROM +BOOTF2: .FNAM2 ;FN2 IS TECO VERSION #. + +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. + .VALUE + 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] ? BOOTF2 ? BOOTSN] + .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 [SYS: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 + 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==50. ;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: 0 ;NON0 => SOME TEXT AFTER RRMAXP IS MISSING FROM THE SCREEN. +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 ;NEG => USE CHAR I/D FOR THIS COMMAND, POS => ONLY REASON FOR + ;UPDATING IS NOT AT END OF LINE, CAN PERHAPS LUCK OUT WITH TABS +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. +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. +RRXINV: 0 ;THIS IS THE REAL DEFINITION OF "SELF-INSERTING CHARS", 0 => SELF-INSERT +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. + +;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. + MOVE CH,LIMPUR ;CH GETS 0 IF THIS IS EITHER TECO JUST LOADED + ; OR AN EJ FILE JUST LOADED + AND CH,RUNFLG +IFN ITS,[ + MOVE E,[-8,,[.SMASK,,[TSMSK] ? .SMSK2,,[TSMSK1] ;SET MASKS, + .SPICL,,[-1] ? .SWHO1,,[0] + .RSNAME,,Q ? .RHSNAME,,HSNAME + .RIOS+CHFILI,,A ? .RIOS+CHFILO,,C]] + .SUSET E + 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,[ + 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 + IOR 3,2 + EPCAP + JUMPGE 3,GOZ4A ; NO ^C CAPABILITY? + MOVE A,[.TICCC,,2] + ATI ; ^C ON CHANNEL 2 +GOZ4A: +IFN 20X,[MOVEI 1,.PRIOU + RFMOD + LDB 1,[.BP TT%PGM,2] + MOVEM 1,PAGMOD ; SAVE INITIAL TERMINAL PAGE MODE SETTING +] + JUMPN CH,GOZ4B + GJINF + MOVEM 2,MSNAME ; CONNECTED DIRECTORY +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 ATTEMT + JFCL +] +GOZ4B: SKIPN 1,CHFILI + JRST GOZ4 + GTSTS + TLNN 1,(GS%OPN) ; FILE STILL OPEN? + CALL UICLS ; NO +GOZ4: SKIPN 1,CHFILO + JRST GOZ5 + GTSTS + TLNN 1,(GS%OPN) + TLZ FF,FLOUT +];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,3 + MOVEI A,[ASCIZ //] ;BUT USE "I-BEAM" ON IMLACS. +] +IFN TNX,[ + CAIN C,1 + 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 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 + MOVE A,[.FNAM2] + CALL SIXIN1 +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. +FSTTYI: +INITTY: +IFN ITS,[ + 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 CHECDS,[[%TJECH+%TJPP2+%TJCTN+%TJDIS+.UAO,,'TTY]] ;FOR FS ECHO DISPLAY$. + TSOPEN CHSIO,[[%TJSIO+%TJCTN+.UAO,,'TTY]] ;SUPER-IMAGE OUTPUT. + TSOPEN CHTTYO,[[%TJCTN+.UAO,,'TTY]] ;NORMAL TYPE OUT. +] + SETZM DISSAI ;DEFAULT IS DON'T PRINT SAIL CHARACTERS. + PUSHJ P,SETTTM ;SET UP RGETTY, STTYS. + MOVEM CH,RGETTY + MOVEM CH,VERBOS ;LONG ERR MSGS DEFAULT ON IFF DISPLAY TTY. +IFN ITS,[ + 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,[ +IFN 20X,[MOVEI A,.CTTRM + 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, +] +IFN 10X,MOVEI C,2400. ;DEFAULT LINE SPEED FOR 10X + MOVEM C,OSPEED ;SAVE IT + MOVE C,TTYTBS(CH) ;GET DISPATCH VECTOR FOR TERMINAL + HLRZ A,0(C) ;ENTRY 0 IS PAGE SIZE + MOVEM A,NVLNS ;NUMBER OF VERTICAL LINES + MOVE A,1(C) ;ENTRY 1 IS TTY OPTION BITS + MOVEM A,TTYOPT + 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 + TLNN A,%TOSA1 ;:TCTYP SAIL => WE SHOULD USE SAIL CHAR SET. + SETOM DISSAI + SETCA A, ;CAN'T ERASE SELECTIVELY => CAN'T USE DISPLAY FEATURES. + TLC A,%TOERS+%TOMVU + TLCE A,%TOERS+%TOMVU + CALL [MOVSI C,377777 ;WE SHOULD NEVER DO --MORE--, + MOVEM C,NVLNS +IFN ITS,[ MOVSI C,%TSMOR ;SYSTEM SHOULD DO **MORE** PROCESSING. + ANDCAM C,TTYSTS + ] + SETZB C,RGETTY ;ALSO PRETEND TO BE PRINTING TTY. + TLNN A,%TOOVR + SETOM BSNOLF ;ON GLASS TTY, PULL VARIOUS OVERPRINT-ERASE HACKS. + RET] + SETZM CHCTVP + SETZM CHCTCF + SETOM DWAIT + MOVE C,OSPEED ;SET DWAIT IF TTY'S SPEED IS KNOWN TO BE 600 BAUD OR LESS. + CAIG C,600. + SKIPN C + SETZM DWAIT + LDB C,[.BP (%TOLID),A] + MOVEM C,LID ;IF TTY CAN INSERT/DELETE LINES, DEFAULT IS TO USE THEM. + 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 + IDIVI C,6 ;COMPUTE # ECHO LINES. + CAIGE C,3 + MOVEI C,3 + SKIPN RGETTY ;NO ECHO LINES ON PRINTING TTERMINALS. + SETZ C, + CALL FSECL1 ;AND SET THAT MANY. + SKIPE RGETTY + JRST ECHOCR + 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 + .CALL STTYS1 + .VALUE + SETOM ECHOFL + TLZ Q,%TSINT+%TSSAI + MOVEM Q,TTYSTS + RET + +TTYAC2: HRROS (P) + CAIA +TTYAC1: HRRZS (P) +TTYAC4: SAVE Q + SAVE TT + SAVE TT1 + SAVE CH + .CALL RTTYS1 + .LOSE %LSFIL + TLZ Q,#%TSSAI + IOR Q,TTYSTS + SKIPGE CH,-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,[ +; DO INITIAL SETUP +SETTTM: SAVE C + MOVSI A,.TICCG ; ^G ON CHANNEL 0 + SKIPG NOQUIT ; UNLESS QUIT NOT ALLOWED + ATI + CALL DOSTIW ; SETUP TERMINAL INT MASK + MOVEI 1,.PRIIN + GTTYP ; GET TERMINAL TYPE + 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 + MOVE CH,TTYTYP(2) ; GET TERMINAL TYPE DISPATCH + RFMOD ; GET TTY MODE WORD + SKIPE CH ; 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 +] +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. +NOECHO: SETZM ECHOFL +IFN ITS,[ + SYSCAL TTYSET,[%CLIMM,,CHTTYI + [020202,,020202] ;Nothing echoes, everything activates, + [030202,,120202] ] ;^G interrupts, CR output in image mode. + .LOSE %LSFIL +] +IFN TNX,[ + SETZM ECHOF2 ;SAY DONT ECHO THINGS FOR DISPLAY TERMINAL + SKIPE RGETTY + RET + MOVEI A,.PRIOU + 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. + 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. +] + AOS INCHCT ;BUMP COUNT OF INPUT CHARACTERS READ SO FAR. + ANDI CH,777+TOP + 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 TYIMACRO$ IF THERE IS ONE + RET + CALL SAVACS + MOVE C,CH ;WITH THE CHARACTER AS ARGUMENT. + MOVE A,TYISNK + CALL MACXCP + JRST RSTACS + + +FSTBNXT:ILDB A,TYIBFP ;FS .TYINXT$: GET NEXT OLD TYI CHARACTER. + AOS (P) +TYI1: EXCH CH,TYIBFP + CAMN CH,[001400,,TYIBUF+TYIBSZ-1] + SUBI CH,TYIBSZ + 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 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 + 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 + .VALUE + HRLI 1,.FHSLF + MOVE 2,[SS%CPY+SS%RD+SS%EXE+<-600,,0>] + SETZ 3, + SSAVE +RADIX 10. + MOVSI 1,(GJ%SHT) +IFN 10X,HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] +.ELSE HRROI 2,[STRCNC [TECPUR.EXE.]\.FNAM3 ] +RADIX 8 + GTJFN + .VALUE + HRLI 1,.FHSLF + MOVE 2,[SS%CPY+SS%RD+SS%EXE+] + SSAVE + JRST INIT + +] ;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: SKIPG COMCNT + TYPRE [UEC] + SOS COMCNT + ILDB CH,CPTR + 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,"$ + 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 QREG, + CAMLE TT,B ;OR IF WANT MORE CHARS THAN QREG HAS, + MOVE TT,B ;USE QREG 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. + +FCTLK: SKIPN A,MACPTR + TYPRE [CNM] ;BARF IF NO CALLER AT ALL + HRRE A,(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. + 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!! + 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. + 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: SETZM TYISNK + SETZM TYISRC +IFN ITS,.IOT CHECHO,[^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,[ +OPNER1: 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 +] +OPNER4: 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 + MOVEI E,DEFDEV + CALL FSDFR1 ;INSERT DEFAULTS + MOVEI CH,40 + REPEAT 3,XCT LISTF5 + HRROI A,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. + 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 + 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 + HLRZ CH,MFPF-MFBLEN+1(Q) + HRRZ A,DISPRR ;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: SETOM INSBP + SETZM DISFLF + SETZM IMQUIT + SETZM INSINP + SETZM INSBP + SETZM TRCOUT + SETZM BRC1 + SETZM SLPNCR + SETZM YANKMT +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 + +;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) + 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,GCTAB ; AS IT WILL BE WHEN ON THE FREELIST). + JRST MEXIT1 + +FSBKR1: SKIPA B,[CD5A] ;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,GCTAB + 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 DON'T + ;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 + 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 UNWINF ;NOW NORMALLY ENTER A COMMAND LOOP, BUT + SKIPN A,DISPRR + JRST GO + 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 + +;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 C + SAVE B + MOVE A,BFRTOP ;OTHERWISE JUST FLUSH CORE. + CAMN A,BFRBOT ;DON'T FLUSH ALL PAGES, ELSE THE + ADDI A,1 ;GAP BETWEEN QREGS 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,POPBCA + 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,A ;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. + JRST POPBCA + +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 QREG 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 QREG 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 + 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. +;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 + TLNN FF,FLNOIN + CALL RRARGF + JUMPL FF,RRLP6 ;THIS IS ^R AS OPPOSED TO ^V + MOVE CH,INCHCT ;THEN IF THE LAST COMMAND WAS NOT AN ARG-SETTER, + SKIPE RRLAST ;THEN A COMMAND HAS JUST ENDED, SO SAVE FS TYI COUNT IN FS TYI BEG. + MOVEM CH,INCHRR + SKIPLE RRMCCT ;AND IF FS ^RMDLY ISN'T 0, + SOSLE RRMCC1 ;THEN IF IT IS ALREADY TIME TO INVOKE SECY, DO SO. + JRST RRLP6 + MOVE CH,QRB.. ;IF THERE IS ONE. IF THERE IS NONE, RRMCC1 IS NEGATIVE SO AS + SKIPN A,.QCRMC(CH) ;SOON AS THERE IS ONE AGAIN IT WILL BE RUN. + JRST RRLP6 + CALL RRMACR ;DO SO. + MOVE A,RRMCCT ;AND REINIT # CHARS TO EXECUTE BEFORE + MOVEM A,RRMCC1 ;NEXT INVOKATION. +RRLP6: SETO OUT, ;WE HAVEN'T RUN THE FS ^R DISPLAY MACRO YET. +RRLP6A: SKIPN RGETTY + JRST [ SKIPGE GEA ;ON PRINTING TTY, REDISPLAY ONLY AFTER A ^L. + JRST RRLP4 + JRST RRLP1] ;OTHERWISE JUST READ ANOTHER COMMAND. + SKIPE ECHFLS + SKIPL ECHACT ;IF ECHO AREA SHOULD BE CLEARED, DO SO. + JRST RRLP6B + SKIPL PJATY ;IF WHOLE SCREEN IS ABOUT TO BE CLEARED ANYWAY, DON'T BOTHER. + TLNE FF,FLNOIN ;CLEAR ECHO AREA ONLY AT TIMES WHEN INPUT COULD BE READ. + JRST RRLP6B + MOVEI C,^P + CALL FSECDS + MOVEI C,"C + CALL FSECDS ;FSECDS SETS RROVPO SO WE WILL REPOSITION THE CURSOR WHEN WE CAN. + SETZM ECHACT ;INDICATE ECHO AREA CLEAR NOW. +RRLP6B: SKIPE RRINHI ;IF DISPLAYING IS INHIBITED, READ ANOTHER COMMAND WITHOUT DISPLAYING + JRST [ MOVE T,MORESW ;BUT DO UPDATE THE MODE-LINE. + CALL DISMD + JRST RRLP1] + LISTEN TT + JUMPN TT,RRLP1 ;ANY BUFFERED INPUT TO PROCESS? + SKIPGE UNRCHC + SKIPE TYISRC + JRST RRLP1 + SETOM TYOFLG ;DOING ^R DISPLAY FORCES TYPEOUT TO RE-INIT. + SKIPGE GEA ;^L OR F+ HAS CLEARED THE SCREEN => REDISPLAY + JRST RRLP4 + SKIPL PJATY ;SCREEN GOT CLOBBERED, OR LOTS OF CHANGES HAPPENED, => + SKIPGE RRMNVP ;MUST CHECK THE WINDOW BEFORE DISPLAYING ANYTHING. + JRST RRLP4 + CALL RRWBLS ;IS OLD WINDOW STILL GOOD? + CALL [ TRO FF,FRUPRW ;NO => CHOOSE A NEW ONE FROM SCRATCH, AND + JRST RRALT6] ;TRY SCROLLING THE TEXT WITH INSERT/DELETE LINE. + 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? + SKIPE 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. + 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 + 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, + CALL CLREOL ;SO CLEAR THE PART WE WANT TO CLEAR, + SETOM HCDS(TT) ;AND DISABLE THE CHECKSUM MECHANISM TO FORCE OUTPUTTING. +RRLP2E: REST RRVPOS + REST RRHPOS + REST PT + MOVEI TT,DISLIN + MOVEM TT,CHCTAD + .I CHCTVS=BOTLIN + SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + CALL VBDOK3 ;DO THE DISPLAYING, + CALL RRDIS2 ;INDICATE NOW REDISPLAY NOT NEEDED. + JRST RRLP5 + +;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. + SKIPE 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. + SETOM 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. + SETZM 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 SETCU1 + 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) + SETZM RRMAXP ;ALL CHANGES ARE BEING HANDLED BY THE LINE-DELETE, SO THERE AREN'T ANY MORE. +;DELETE LINES OF TEXT FROM C(BP) TO C(RRIDVP). +RRLID5: SOS BP + MOVE CH,RRMSNG + IOR CH,RRMAXP + CALL DSLID ;MOVE THE STUFF UP, RIGHT NOW. BP HAS -1 PLUS LINE WE ARE "AT". + JUMPN CH,[ ;RRMSNG SAYS THAT THE STUFF BELOW DELETION POINT MAY NEED REDISPLAY + ;EVEN THOUGH IT'S AFTER RRMAXP, SO WE MUSNT'T TRY TO SKIP OVER IT. + MOVE TT,RRIDLB ;BUT GIVE THAT PLACE AN ACCURATE LINBEG TO RESTART + MOVEM TT,LINBEG+1(BP) ;REDISPLAY WITH. + RET] + MOVE BP,BOTLIN ;NOW ALL THAT NEEDS DISPLAYING ARE THE NEW BLANK LINES AT THE BOTTOM. + SUB BP,Q ;SO GET THE VPOS OF THE FIRST OF THEM, + CAMLE BP,TOPLIN ;AND START DISPLAYING AT THE LINE BEFORE IT, + SOS BP ;SINCE THAT'S THE LAST ONE WITH A VALID LINBEG. + EXCH BP,RRMNVP + SETZM RRMNHP ;NOTE THAT DSLID SETS RRMSNG. + MOVE CH,Z + SUB CH,RROLDZ ;NOW RELOCATE LINBEGS OF ALL LINES PAST OLD RRMNVP THRU NEW RRMNVP, +RRLID4: CAMLE BP,RRMNVP ;SINCE LINBEGS OF ALL LINES ABOVE RRMNVP ARE SUPPOSED TO BE + JRST RRLID6 ;CORRECT WITHOUT NEEDING RELOCATION. + ADDM CH,LINBEG(BP) + AOJA BP,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 C,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. + 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 + +;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] +RRXINS: SKIP E,RRXINV + SKIPN E + MOVE E,[RRDINS,,RRREPI] +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, 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. + 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 SAILL 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. + 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. + SETZ OUT, ;ON 1ST PASS OUT=-1 => AN LF HAS BEEN PASSED GOING BACKWARDS. +RRBTC0: MOVE IN,PT + CAMG IN,A + JRST RRBTC1 ;WE MOVED BACK TO WHERE WE CAN STOP. + 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 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 AN ARG-SETTING COMMAND; + RET ;DON'T FLUSH ARG OR CLOBBER FS ^R PREV$. + +;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 + 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. + +;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 + +;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. + JRST RRCTD1 + +;^D -- DELETE FORWARD. (D) +RRCTLD: SKIP + JUMPGE C,RRCTD1 + MOVNM 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: JSP E,RRREP1 + 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 + 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. + SKIPN RRCIDP ;IF NEED TO DO SOMETHING WITH I/D OR TABS, + JRST RRDLB3 + CAIE CH,^I + SKIPN DISSAI + CAIL CH,40 ;BETTER NOT BE DIFFICULT CHARACTER + CAIN CH,177 + JRST RRDLB1 ;IF IT IS, JUST REDISPLAY +RRDLB3: 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. + JRST DELCHR] + CALL CHCTHR ;ELSE REMOVE THIS CHARACTER FROM THE HASH CODE + SKIPN DISSAI ;USING RRHPOS AS THE HPOS FOR COMPUTING IT. + CAIL CH,40 + CAIN CH,177 + SETOM HCDS(BP) ;BUT THAT DOESN'T WIN FOR 2-PLACE CHARACTERS. + JUMPG T,ERSCHR ;NOW GO CLEAR OUT THE APPROPRIATE PARTS OF THE SCREEN. + 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. + JSP E,RRREP2 ;REPEAT ARG TIMES WHAT FOLLOWS (BUT FIRST OTHER STUFF) +RRRUBD: 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. + JSP E,RRREP2 ;REPEAT THE FOLLOWING ARG TIMES: + 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 NOT PLANNING TO REDISPLAY, + 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. + 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 + 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. + SKIPN RRINHI + SKIPE RRMSNG + JRST RRICH2 + SKIPE RRMAXP ;REDISPLAY NECESSARY ANYWAY => + RET ;IT WILL FIX SCREEN; WE NEEDN'T. + 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: LISTEN A ;MANY UPDATES DON'T BEAT 1 REDISPLAY. + SKIPN TYISRC + 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, + +;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 + 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: ANDCMI FF,FRARG2\FRCLN\FRSYL\FROP ;IN ANY CASE THE MACRO DOESN7T HAVE 2 ARGS. + SETZM SARG + 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. + .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: .I RRMNVP=TOPLIN ;NOW MAKE SURE THAT AFTER PROCESSING THIS CHARACTER + SETZM RRMNHP ;THE BUFFER IS REDISPLAYED OVER THE TYPEOUT. + SETOM RRMSNG ;NOTE LINES MAY NEED REDISPLAY EVEN IF 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. + 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, + 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 RREAR2 + .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: SETOM RRMSNG ;JUST TELL ^R THAT EVERY LINE NEEDS REDISPLAY + JRST RRLRDS ;BUT WINDOW IS CERTAINLY GOOD. + +;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 + MOVNS C ;RRMNVP MOVES UP WITH THE TEXT, IF IT ISN'T INFINITY. + CAME TT,[SETZ-1] + ADDM C,RRMNVP ;NOTE IT CAN'T GO PAST TOPLIN, DUE TO CAML E,RRMNVP ABOVE. + JRST RRLID5 ;GO DELETE THE LINES BELOW TOPLIN. + +RRALT4: AOS RRIDVP ;COMPENSATE FOR DIFFERENT MEANING OF THIS AND BP IF MOVING TEXT DOWN. + CALL DSLID ;MOVE IT. + JRST RRALT5 ;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: SETOM RRMSNG +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 + MOVE BP,A + CALL QBGET1 ;AND DECODE CONTENTS AS BUFFER. + MOVE T,MFBEGV(B) ;B HAS FRAME ADDR; MAKE AOBJN TO CONTENTS. + IDIVI T,5 + HRRZ J,T + MOVE T,MFZV(B) + IDIVI T,5 + SUBM J,T + HRL J,T +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, + SETOM 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 + JRST RRFORW + +RRCB1: MOVNS C + JSP E,RRREP1 + JRST RRBACK + +;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 -1L. +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 + 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 + +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 + +SUBTTL TECO COMMAND DISPATCH / ARGUMENT ARITHMETIC + +CD: SETZM NUM ;FLUSH ANY ARGUMENT, OR : OR ^. + 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 QREG SPACE HAS INCREASED BY + CAML A,QRGCMX ;GCOFTN CHARS SINCE PREVIOUS GC, + PUSHJ P,GC ;GC THE QREGS. +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. + +;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 +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. + 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. + 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 + 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,PSI ;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. +PSI: TRO FF,FRCLN + ;(PSI IS USED AS AN ENTRY POINT + ;FOR SORT. THE NAME OF THE PSEUDO + ;Q-REG IS LEFT SET UP IN CH, THE COLON + ;FLAG IS TURNED ON TO MAKE CERTAIN I + ;KNOW I AM Q-REGGING. + SAVE CH ;REMEMBER WHICH QREG TO STORE IN. + 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 QREG SPACE, + SUB C,QRWRT + SUBI C,4 ;WE'LL CERTAINLY NEED 4 FOR HEADER OF NEW QREG. + ;INS5 WILL PUT THAT IN TOTALC, # CHARS FREE TO USE. + MOVE BP,QRWRT ;START QREG 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 QREG, + 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 QREG HEADER AT <- CHAR ADDR IN BP. +INS3: REST CH ;GET BACK ADDR OF QREG TO STORE IN. + CALL QCLOSE ;STORE IN IT; OUT HAS CHAR ADDR END OF QREG. + ;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 QTAB IDX 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: 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 QREG 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 + 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,100 ;ELSE JUST MAKE 100 WORDS AT A TIME. + MOVE E,@BFRPTR + TLNE E,MFQVEC ;IN A QVECTOR, MAKE ONLY 100 WORDS OF SPACE + MOVEI D,100 ;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: IDIVI BP,5 + 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] +IFN ITS,[ + TRNN C,1777 ;IF MAKING SPACE IN UNITS OF A K, DO IT BY PAGE MAPPING + JRST SLPN0P ;TO AVOID HAVING TO SWAP EVERYTHING IN. +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 + POPJ P, + +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. + SKIPE YANKMT + MOVE BP,YANKMT + 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 QREG 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 QREGS. +;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 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 + 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. +QCLOSP: REST CH ;QREG ADDR IS ON STACK. +QCLOSE: EXCH OUT,QRWRT ;QREG ADDR IN CH. + SUB OUT,QRBUF + TLO OUT,400000 + MOVEM OUT,(CH) + RET + +;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 C + SAVE B + 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] + 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) + SAVE C + MOVE A,BFRTOP + IDIVI A,5 ;WORD FOR BLT TO STOP MOVING OUT OF (PLUS 1) + REST C + ADDI A,-1(C) + EXCH C,(P) + BLT C,(A) + 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 +POPBCA: REST B +POPCAJ: REST C + 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. +GAPSL0: SKIPN EXTRAC ;NO GAP REALLY => + JRST GAPSLN ;JUST SAY IT'S AT PT, REALLY DOESN'T MATTER. + SAVE Q + MOVE Q,PT + CAMN Q,GPT ;GAP ALREADY AT PT => NOTHING TO DO. + JRST POPQJ + CAMG Q,GPT ;MOVING GAP DOWN => DIFFERENT. + JRST GAPDN + REST Q + CALL SAVACS +GAPUP3: MOVE BP,GPT ;MOVE 1ST FEW CHARS 1 AT A TIME. + CAMN BP,PT ;(WHEN GET HERE 2ND TIME, + JRST RSTACS ;MIGHT BE NOTHING TO MOVE) + ADD BP,EXTRAC ;GET FETCHING PTR -> ABOVE GAP. + CALL GETIBP + MOVE TT,GPT + IDIVI TT,5 ;GET STORING PTR -> BELOW GAP. + MOVE A,PT + SUB A,GPT ;GET TOTAL # CHARS TO BE MOVED. + JUMPE TT1,[SOJA TT,GAPUP2] +GAPUP0: SUBI TT1,5 ;(WILL INCREM. TO 0 WHEN REACH WD BNDRY) +GAPUP1: ILDB IN,BP ;GET A CHAR FROM ABOVE GAP, + DPB IN,BTAB+5(TT1) ;PUT IT BELOW GAP, + AOS GPT ;SAY GAP HAS MOVED UP 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + AOJN TT1,GAPUP1 ;EFFECTIVELY IBP THE STORING PTR. +GAPUP2: CAIGE A,5 ;BOTTOM OF GAP NOW ON WD BNDRY, + AOJA TT,GAPUP0 ;< 1 WDS LEFT => KEEP GOING CHAR BY CHAR. + MOVEI C,1(TT) ;GET ADDR 1ST WD TO MOVE DOWN INTO. + 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, + 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) +GAPDN: MOVE Q,PT + ADD Q,PT + ADD Q,PT + ADD Q,Z ;COMPUTE WEIGHTED AVERAGE OF PT AND Z, THEN COMPARE WITH GPT + LSH Q,-2 + CAMG Q,GPT ;IS GPT CLOSER TO PT, OR TO Z? + CALL [ SAVE PT ;GPT IS MUCH CLOSER TO Z THAN TO POINT. SO FASTEST THING + MOVE Q,Z ;IS TO MOVE GAP TO Z, ADJUST WITH GAPADJ, AND + MOVEM Q,PT ;MOVE IT DOWN AGAIN USING A POP-LOOP. + CALL GAPSLP + REST PT + RET] + REST Q ;GPT CLOSER TO PT; FASTER TO MOVE GAP DIRECTLY TO POINT. + CALL SAVACS + MOVE BP,GPT + CAMN BP,Z ;IF GAP IS AT END OF BUFFER, WE CAN ADJUST ITS SIZE A LITTLE + CALL GAPADJ ;AND THEREBY ENABLE WHAT FOLLOWS TO USE A BLT. +GAPDN3: MOVE BP,GPT ;MOVE THE 1ST FEW CHARS UP, + CAMN BP,PT ;(FOR GETTING HERE 2ND TIME WITH + JRST RSTACS ;TO BE MOVED) + CALL GETBP ;GET PTR FOR FETCHING CHARS BELOW GAP, + MOVE TT,GPT + ADD TT,EXTRAC ;GET PTR FOR STORING ABOVE GAP. + IDIVI TT,5 + MOVE A,GPT ;GET TOTAL # CHARS MUST MOVE UP. + SUB A,PT + SOJL TT1,GAPDN2 ;ALREADY MOVING TO WD BNDRY. +GAPDN1: DBP7 BP ;GET PTR -> LAST CHAR BELOW GAP. + LDB CH,BP + DPB CH,BTAB(TT1) ;MOVE IT BELOW TOP OF GAP. + SOS GPT ;GAP HAS MOVED DOWN 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + SOJGE TT1,GAPDN1 ;EFFECTIVELY DBP7 THE OUTPUT BP. +GAPDN2: CAIGE A,5 ;TOP OF GAP NOW ON WD BNDRY +GAPDN5: SOJA TT,[ADDI TT1,5 ;< 1 WD LEFT, KEEP + JRST GAPDN1] ;CHAR AT A TIME. + 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 + 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 + +SUBTTL STRING SPACE GARBAGE COLLECTION + +GCNRL: SETOM GCNRLC ;GC TO RECLAIM MACRO FRAMES. DON'T MOVE QREGS. + CAIA ;(THEREFORE, CAN BE CALLED IN MID-COMMAND) +GC: +GCC: SETZM GCNRLC + CALL SAVACS +IFN ITS,[ + MOVE A,[-2,,[.SWHO1,,[.BYTE 2,3,3 ? 1 ? 6 ? 6] + .SWHO2,,[SIXBIT/QR GC/]]] + .SUSET A +] + 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 + MOVEI T,XX + CALL GCM +TERMIN + 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 QREGS TO GC. + SKIPE GCNRLC ;IF SHOULDN'T MOVE QREGS, 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,OUT + IMULI IN,5 ;COMPUTE WHERE IMPURE STRING SPACE NOW ENDS. + 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. + +;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 GCSWPL ;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. + +;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 + 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 QREG ARE CREATED. + SKIPL GCNRLC + MOVEM CH,QRGCMX + 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 QREGS 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 + HRLI CH,(Q) ;AOBJN -> PAGES TO FLUSH. + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? CH] + JFCL +GCE2: +] + 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 + 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,[15,,15] ;MAKE ROOM ON STACK + EXCH 1,-15(P) ;GET RETURN ADDRESS AND SAVE 1 + MOVEM 2,-14(P) ;SAVE 2 + MOVEI 2,-13(P) + HRLI 2,3 + BLT 2,(P) ;SAVE THE REST + SAVE 0 + JUMPL P,(1) + TYPRE [PDL] + +RSTACS: REST 0 ;RESTORE 0 + MOVSI 16,-15(P) ;GET START OF WHERE THEY ARE + HRRI 16,1 + BLT 16,16 ;RESTORE THE REST + SUB P,[16,,16] + 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,,] + SKIPE MODIFF + TLO T,MFMODIF ;STORE MODIFF OF DESELECTED BUFFER AS A BIT. + 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 + 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 +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 QCLOSE + 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 QCLOSE + 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. + +;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) + TRZ FF,FRCLN\FRUPRW\FRARG\FRARG2 + TRO FF,FRUPRW ;INSIST ON EXACT MATCH IN LOCAL VARIABLE NAME. + SAVE C + SAVE D + CALL FOCMD3 ;LOOK UP THAT VARIABLE IN THE SYMBOL TABLE. IN GETS S.T.E. ADDRESS. + TYPRE [UVN] + REST D + REST C +FCTLG5: MOVE CH,1(IN) ;EXCH VALUE IN SYMTAB ENTRY WITH THAT IN LOCAL VAR IN BUFFER TABLE. + EXCH CH,1(C) + MOVEM CH,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 C,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 VALUE TO SWAP IN AS ARG TO FLAG ROUTINE. + MOVE C,FLAGD(C) ;GET ADDRESS OF FLAG ROUTINE. + TRO FF,FRARG + CALL FSFND ;CALL IT. + REST D + REST C + MOVEM A,1(C) ;VALUE RETURNED BY FLAG ROUTINE IS VALUE BEING SWAPPED OUT. + 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 + SETOM SFINDF ;A NULL SEARCH OR SEARCHING 0 TIMES SHOULD STATE THAT IT WON. + SKIPN SEARG ;IF ARGUMENT ZERO, (ENTRY FOR "AGAIN" COMMAND) + POPJ P, ;THEN WIN, DON'T BOTHER ACTUALLY SEARCHING +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 0S0 ]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:: FSDIRS:: 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: SETOM HCDS-1(T) ;THAT WERE PREVIOUSLY IN THE ECHO AREA (AND THE OLD MORE LINE). + CAME T,NVLNS + 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. +IFN ITS,[ + ADDI C,10 + DPB C,[MORMCV] +] +IFN TNX,CALL MCLSET ;SET UP STRING THAT WILL CLEAR LINE IN C IN MORMCL + SETOM DISOMD ;INDICATE DISPLAYED "MODE" (Q..J) IS OUT OF DATE. +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 + +FSWIDTH:TRNE FF,FRARG + CAIG C,MXNHLS + JRST FSNORM + TYPRE [AOR] + +IFN TNX,[ +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,.PRIOU + 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: MOVE A,DEFDEV ;RETURN -1 IF DEFAULT DEVICE IS "FAST". +IFN ITS,CAME A,MACHINE +IFN TNX,CAME A,[ASCII/DSK/] + JRST NRET0 + JRST NRETM1 + +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 + +;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 + MOVE A,(E) ;GET THE JFN + ARGDFL + SAVE C ;SAVE ANY ARG + MOVE B,[1,,.FBWRT] + MOVEI C,A + GTFDB ;GET THE OLD WRITE DATE + 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 GAPSLP ;MOVE GAP TO PT + MOVE BP,PT ;GET BYTE POINTER TO . + CALL GETIBV + MOVE A,BP + SETZ B, + IDTIM ;READ IN TIME + SETO B, + 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 GAPSLP + MOVEI A,BAKTAB + JRST ASCIND ;INSERT IT AND RETURN + +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 + +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 +];IFN TNX + +IFN TNX,[ + +FSDIRH: MOVE B,HSNAME ;HOME DIRECTORY + JRST FSDIR3 +FSDIR2: GJINF + SKIPA B,A ;LOGIN DIR +FSDIRS: MOVE B,MSNAME ;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 + +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 ADJBRK ;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 + +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, + 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 OARG ;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+1 ;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 + +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 + 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,"' ;' 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 + 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 [ 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, + TLCE 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 CRATION OF THE QREG) +FXCMD: CALL QREGVS ;THIS CAN MAKE US SKIP! + CALL GETANU ;TAKES ARGS LIKE X, K, ETC. + SKIPA +FXCMD2: SETO 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. + TTYACT + 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 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. + 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, + +;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 ANDF DONE. + JRST FJCL3 + MOVEI CH,^J + IDPB CH,BP + POPJ P, + +;READ THE CMD STRING FROM DDT INTO GCTAB. +FJCLRD: SETZM GCTAB + MOVE A,[GCTAB,,GCTAB+1] + BLT A,GCTAB+GCTBL-2 + MOVEM A,GCTAB+GCTBL-1 ;LAST WD NOT 0 TO STOP STORING. +;FIRST, RETURN WITH GCTAB ZEROED IF THERE IS NO JCL. +IFN ITS,[ + .SUSET [.ROPTIO,,A] + TLNN A,OPTCMD ;HAS SUPERIOR SAID IT HAS CMD STRING? + POPJ P, ;NO, RETURN AS IF READ 0 FROM IT. +] +IFN 20X,[ + SETZ A, + RSCAN ;GET RSCAN BUFFER + TDN + MOVN C,A ;GET NUMBER OF CHARACTERS IN IT +FJCLR2: JUMPGE C,CPOPJ ;RETURN IF NOTHING TO READ + PBIN ;FLUSH THE FIRST WORD OF THE RSCAN LINE + CAILE A,40 + AOJA C,FJCLR2 + AOJGE C,CPOPJ +] +;THERE IS JCL, SO READ IT INTO GCTAB. +IFN ITS,.BREAK 12,[5,,GCTAB] +IFN 20X,[ + MOVEI A,-1 ;READ FROM CONTROLLING TERMINAL + HRROI B,GCTAB + SIN ;THE REST OF THE RSCAN STRING +] + POPJ P, + +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. + 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 SUBSTRIPTED, 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. +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. + CALL (TT) + MOVE CH,-1(P) ;NOW CONVERT REL. IDX. INTO QVECTOR BACK INTO ADDRESS. + MOVE CH,MFBEGV(CH) + IDIVI CH,5 + ADD CH,(P) + MOVEM A,(CH) ;AND STORE THE COMMANDS'S VALUE THERE. + SUB P,[2,,2] + RET + +;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. +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 A,(CH) + JRST POPJ1 + +;U - PUT NUMERIC ARG IN . 2 ARGS => USE 2ND, RETURN 1ST. +USE: TRZN FF,FRARG + TYPRE [WNA] + ARGDFL + CALL QREGS +USE1: CAIN CH,A + JRST POPJ1 ;MAKE SURE U* IS A NO-OP. + CAIN CH,$QBUFR ;SELECT A NEW BUFFER BEFORE! SETTING ..O, IN CASE IT GETS ERROR. + CALL BFRSET + MOVEM C,(CH) + TRZN FF,FRARG2 + POPJ P, + MOVE A,E + JRST POPJ1 + +;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] + CAIE B,QRBFR + 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: PUSH P,CH + 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. + 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,BP + SOJG J,X7 +X8: MOVE IN,E +X1: SOJL C,X2 ;MAYBE INSERTED ALL THE CHARS. + CALL GETINC ;IF NOT, INSERT THE NEXT. + IDPB CH,BP + JRST X1 + +X2: 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. + 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. + 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 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 + JRST OPENB1 ;DETECT OVERPUSH BEFORE A PDLOV INT HAPPENS. + PUSH B,(CH) +OPENB3: PUSH B,CH + MOVEM B,PF + POPJ P, + +;[[ ;] - POP FROM QREG PDL INTO . ]* POPS AND RETURNS AS VALUE. +CLOSEB: CALL QREGVS ;CAN MAKE US SKIP! +CLOSB2: MOVE B,PF + CAMN B,PFINI +OPENB1: TYPRE [QRP] + POP B,(B) + POP B,(CH) + CAIN CH,$QBUFR ;POPPING INTO Q..O => NEW BUFFER IS SELECTED. + CALL BFRSE1 ;SWITCH TO IT, CAREFULLY. +FSQPU2: MOVEM B,PF + POPJ P, + +;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: MOVE B,PF +FSQPU1: CAMG B,C ;DOWN TO DESIRED LEVEL? + 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 FSQPU0 + +FSQPU3: JUMPE A,FSQPU1 + JSP T,OPEN1 ;HANDLE UNWINDING Q..N; MUST PRESERVE TEMPS. +FSQPU6: SAVE C + MOVEM B,PF + CALL MACXQW ;EXECUTE THE INNER BINDING OF ..N (WHICH IS IN A). + REST C + HRROI T,FSQPU0 + TRZ FF,FRARG+FRARG2+FRSYL+FROP + JRST CLOSE2 ;POP WHAT OPEN PUSHED, AND GO TO FSQPU0 + +FSQPU5: MOVE A,CH ;POP INTO LONG-NAMES 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. +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 + TLO TT,MFBA2 + TRNE FF,FRARG2 + TLO TT,MFBA1 + MOVEM 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 QREG. + 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: TRZE FF,FRCLN ;HERE WHEN AN "M" COMMAND CALLS A BUILT-IN FUNCTION. + SETZM COMCNT ;:M TO BUILTIN => JUST DISCARD REST OF STRING AT THIS LEVEL. + 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 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) + 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 + SOS TT,E + TRZE FF,FRARG2 + 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 + +GRTH: SKNTOP ITRPTR + TYPRE [UMC] + TRZE FF,FRUPRW + JRST GRTH1 + SOSN ITERCT + JRST INCMA2 +GRTH1: HRRO A,ITRPTR + SUBI A,MFBLEN-MFCPTR-1 + POP A,CPTR + POP A,COMCNT + MOVEI CH,^M + 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) +INSIRP PUSH A,COMCNT CPTR CSTR ITERCT MACPDP 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 QREGS 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: SETOM SFINDF + CALL MACXQ +PS2A: MOVE T,PSMEMT + POP P,J ;RETURN POINT + POP P,E ;OLD PT-BEG + ADD E,BEG + MOVE C,PT + SKIPL SFINDF ;IF THE LAST SEARCH FAILED + SKIPA C,ZV + CAML C,ZV ;OR 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 + MOVE T,BEGV ;SET UP FOR LATER BLT + IDIVI T,5 + 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. + CAML 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 HANDELD SEPARATELY. + .I YANKMT=MEMT ;PREVENT EXCESS CLEARING OF LOW BITS IN SLPSAV + 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: SETZM YANKMT + 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 + .I YANKMT=MEMT ;IN CASE MUST MAKE SEVERAL TRIES, PREVENT EXCESS LOW-BIT CLEARING. + 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. + SETZM YANKMT + 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 + 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. + 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". + 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 SAV123 ;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,POP321 ;HAVE WE REACHED EOF? + MOVEI CH,EOFCHR ;YES + DPB CH,UTRLDT + JRST POP321 +UTRLD3: JSR SAV123 + 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: CALL GETARG + CALL CHK1A +PUNCHF: ;PUNCH OUT RANGE SPEC'D BY C,E. + CAMGE E,GPT + CAMG C,GPT ;IF GAP IS INSIDE RANGE TO BE PUCNHED, MOVE IT OUTSIDE. + JRST PUNCHG + SAVE PT + MOVEM C,PT + CALL GAPSL0 ;BUT THIS DOESN7T MEAN WE ARE MODIFYING THE BUFFER'S CONTENTS. + REST PT +PUNCHG: MOVE IN,E + MOVE BP,IN + SUBM C,IN ;IN GETS CHAR COUNT + JUMPLE IN,CPOPJ + PUSHJ P,GETIBV + PUSH P,D + MOVE E,[PPG,,A] + BLT E,E +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,300 ;TRY .IOTING OUT OF BUFFER. + JRST PCHF2 ;(TOO FEW CHARS TO BE WORTH IT) + ADDI BP,1 + MOVE CH,IN ;GET # WDS FULL IN BUFFER AFTER WHERE WE ARE. + IDIVI CH,5 +IFN ITS,[ + CAIL CH,2000 + MOVEI CH,2000 ;DON'T OUTPUT MORE THAN A K AT ONCE. + MOVNS CH + HRLI BP,(CH) ;BP HAS AOBJN -> WDS IN BUFFER. + .IOT CHFILO,BP +] +IFN TNX,[ + JSR SAV123 ;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 ;GETS POS COUNT + CAMLE OUT,IN + MOVE OUT,IN + PUSH P,OUT + JUMPE OUT,PPG1 + 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 + SKIPL UTYOCT + PUSHJ P,UTYOA + SUB IN,OUT + JUMPG IN,PCHF1 +POPDJ: POP P,D + POPJ P, + +PUNCH: +PUNCHA: SKIPGE OUTFLG + RET + TLNN FF,FLOUT + TYPRE [NDO] + TRNE FF,FRARG2 + JRST PUNCHB + MOVE D,C + MOVE C,CPTR + LDB T,C + CAIE T,"P ;IF COMMAND IS P + CAIN T,"P+40 + ILDB T,C ;THEN GET NEXT CHAR, IF W THEN DON'T YANK INTO BUFFER + JUMPL D,CPOPJ +PUN1: PUSHJ P,PUNCHR + TRZ FF,FRARG + CAIE T,"W + CAIN T,"W+40 + SKIPN COMCNT + PUSHJ P,YANKEE + MOVE E,ZV + CAMN E,BEGV + SKIPE LASTPA + 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 + 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 SAV123 ;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 POP321 ;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,,CHRAND] + 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, +FSCLKI: SKIPE C ;OR TURN OFF REAL TIME CLOCK, WITH ARG OF 0. + SKIPA A,[%RLSET,,C] + MOVSI A,%RLFLS + .REALT A, + RET + +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] + TRNE FF,FRARG ;IF HAVE ARG, IOR IT INTO OPEN-MODE. + TLO A,(C) + 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, + POPJ P, ;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: .FNAM2 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 + .FNAM2 + 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 QREG 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,[.FNAM2] ;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, + HRROI A,C + .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 + CALL ALINK2 ;ERROR IF DEVICE NOT DSK. + 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 + SKIPA CH,[%EEXFL] ;GET ERROR CODE FOR "FILE ALREADY EXISTS", +ALINK3: MOVEI CH,%EBDDV ;"WRONG TYPE DEVICE" - NOT DSK: + 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 ;ERROR IF NOT DSK, GET CORRECT SNAME 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: SETZ C, + MOVE T,DEFDEV + CAMN T,MACHIN + 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.] + JUMPE C,ALINK3 ;NOT DSK => WRONG TYPE DEVICE. + POPJ P, + +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: PUSHJ P,FFRRDD + SYSCAL DELETE,[UTFARG] + JRST OPNER1 + 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: CALL FRDOLD ;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 +FSCLKI: LSH C,4 ;CONVERT TO MS (MORE OR LESS) + MOVEM C,CLKINT ;SAVE LENGTH OF INTERVAL +IFN 20X,[ + MOVE A,[.FHSLF,,.TIMAL] ;DELETE ALL TIMERS FOR THIS FORK + TIMER +] +IFE .IIT-1,[ + MOVE A,[100000,,.FHSLF] ;DELETE ALL BEFORE THIS TIME + HRLOI B,377777 ;INFINITY + IIT +] + JFCL ;IGNORE ERRORS +FSCLK2: SKIPN B,CLKINT ;GET LENGTH OF REAL-TIME INTERVAL + RET ;NO MORE TO DO IF 0 +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 RLTCLK ;YES, RUN THE HANDLER NOW THEN + CALL FSCLK2 ;SETUP NEW TIMER FOR NEXT TIME +INSIRP POP P,C B A + DEBRK + ERJMP [JRST @INTPC2] ;NEEDLESS TO SAY THE INDIRECTION WONT WORK IN THE ERJMP ITSELF + +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 + HRROI A,BAKTAB ;CONNECTED DIRECTORY + MOVE B,MSNAME + 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 + +FRDFOU: MOVSI A,(GJ%FOU) + JRST FRD +FRD0: TDZA A,A +FRDOLD: MOVSI A,(GJ%OLD) +; 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] + +FF4: MOVEM C,BAKTAB+.GJSRC + HRR A,DEFFN3 ;GET DEFAULT GENERATION NUMBER + MOVEM A,BAKTAB+.GJGEN +.GJFN1==.GJNAM +.GJFN2==.GJEXT +IRPS STR,,[DEV DIR FN1 FN2] + SKIPN DEF!STR + TDZA A,A + HRROI A,DEF!STR + MOVEM A,BAKTAB+.GJ!STR +TERMIN +IFN EMCSDV\INFODV,[ ;TRANSLATE FOR SYSTEMS WITHOUT REAL + MOVE A,DEFDIR +IFN INFODV,[ + CAMN A,[ASCIZ /INFO/] ;WANT ? + JRST FF4A ;YES +] +IFN EMCSDV,[ + CAMN A,[ASCIZ /EMACS/] ;WANT ? + JRST FF4A ;YES +] + JRST FF4B +FF4A: HRROI A,DEFDIR + MOVEM A,BAKTAB+.GJDEV ;MAKE IT EMACS: OR INFO: + SETZM BAKTAB+.GJDIR ;AND FORGET DIRECTORY +FF4B: +] + SETZM BAKTAB+.GJPRO + SETZM BAKTAB+.GJACT + MOVEI A,BAKTAB + GTJFN + RET ;SINGLE RETURN + JRST CPOPJ1 ;SKIP RETURN WITH THE JFN + +;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,7(A) ;AND AREA WE WILL BE INSERTING INTO +FFST1: CALL LRCH ;GET A CHARACTER + SKIPGE SQUOTP ;SUPERQUOTED? + JRST FFST2 ;YES, INSERT IT THEN + 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 +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: SKIPA A,[DEFDIR] +FFSTB0: MOVEI A,DEFFN1 +FFSTB1: HRL A,(P) ;GET START OF WHERE IT IS +FFSTB2: MOVEI C,7(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,7(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 + 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 CPOP1J ;DONE + TLNE B,300000 ;IF EITHER FN1 OR FN2 SEEN, + SETZM DEFFN3 ;RESET THE GENERATION NUMBER + JUMPE TT,CPOP1J ;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,7(C) + BLT C,(A) ;SET IT UP + JRST CPOP1J ;AND RETURN +FFST4D: MOVEI C,DEFDIR ;SETTING DIRECTORY + JRST FFST4C +FFST4G: CALL FFSGN0 ;SET GENERATION NUMBER + JRST CPOP1J ;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: CALL ECOPOS ;POSITION TO CURRENT PLACE IN ECHO AREA + MOVEI A,.PRIOU + 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 + SETOM IMQUIT ;ALLOW ^G'ING OUT OF GTJFN + TRZN FF,FRARG ;:ET - GET FROM TTY IN ECHO AREA + TLZA A,-1 + HRLZ A,C ;ANY ARGUMENT IS THE GTJFN FLAGS + TLO A,(GJ%FLG) ;RETURN FLAGS AS WELL + SETZ B, ;NO STRING + MOVE C,[.PRIIN,,.PRIOU] ;FROM TTY: + CALL FF4 + JRST [CALL FFRRT1 ;RESTORE TTY MODE FIRST + JRST OPNER1] ;THEN REPORT ERROR + PUSH P,A ;SAVE JFN + CALL FFSET ;SET UP DEFAULTS FROM IT + 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 NOT THE USER, + 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,.PRIOU + SFMOD + SETZM SAVMOD ;AND NO MODE TO RESTORE + RET + +;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 CPOP1J +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: MOVEI A,DEFDEV-DEFDEV(E) + CALL ASCIND ;DEVICE + MOVEI CH,": + CALL @LISTF5 + MOVEI CH,"< + CALL @LISTF5 + MOVEI A,DEFDIR-DEFDEV(E) ;DIRECTORY + CALL ASCIND + MOVEI CH,"> + CALL @LISTF5 + 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 + JRST OPNER1 + MOVE B,[7_30.+OF%RD] ;OPEN FOR 7 BIT READ + OPENF + JRST OPNER1 + SAVE A +FCOPY3: CALL FRD0 ;GET SECOND ONE + JRST OPNER1 + MOVE B,[7_30.+OF%WR] + OPENF + JRST OPNER1 + 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 + JRST OPNER1 +IFN 10X,[ ;THIS IS EXTREMELY DISTASTEFUL + SKIPN DEFFN2 ;IS THERE SUPPOSED TO BE AN EXTENSION? + JRST RRED ;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,RRED ;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 +] +RRED: 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 + CALL IMMQIT + OPENF + JRST OPNER1 + 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 + 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 + CALL UTRLD2 ;GET A BUFFER FULL + 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 + 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 + +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 + CALL FRDFOU ;GET REAL OUTPUT FILE + JRST OPNER1 + CALL ROUNMS ;SET UP REAL OUTPUT NAMES + HRLI A,.FBUSW + SETO B, + MOVE C,[SIXBIT /TEC/+.FNAM2_-18.] ;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 + JRST OPNER1 + TRZN FF,FRCLN + JRST EJCMD2 ;EJ - MAP IN IMPURE AREAS + MOVE B,[36._30.+OF%RD] + OPENF + JRST OPNER1 + 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\PM%CPY) +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/+.FNAM2_-18.] ;A COMPATIBLE DUMP FILE? + TYPRE [AOR] ;NOPE + MOVE E,LHIPAG + MOVE D,MSNAME + MOVE T,MEMT + MOVE J,INITFL ;SAVE THESE GUYS + HRLI A,.FHSLF + GET ;THIS SHOULD ONLY HAVE IMPURE PAGES + MOVEM E,LHIPAG + MOVEM D,MSNAME + 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 + JRST OPNER1 + SAVE A + CALL FRDFOU ;GET SECOND FILE + JRST OPNER1 + CALL IMMQIT + MOVEI B,(A) + REST A + RNAMF ;DO THE RENAME + JRST OPNER1 + JRST DELQIT + +;DELETE A FILE +DELE: CALL FRDOLD ;GET OLD FILE JFN + JRST OPNER1 + DELF ;DELETE IT + JRST OPNER1 + 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 + SKIPLE A + CLOSF ;GET RID OF ANY OLD FILE + JFCL + MOVE A,CHFILO + MOVE B,[36._30.+OF%WR] ;OPEN FOR WRITE + CALL IMMQIT + OPENF + JRST OPNER1 + 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 + MOVE A,C ;ANY ARG RETURNED IN 3 + JRST POPJ1 + +;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 + 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 QREG OR ASCIZ IN A, WITH ARG IN C, SAVING CURRENT VALUE STATUS. +MACXCP: JSP T,OPEN1 + MOVEM C,NUM + CALL [ SKIPE RREBEG ;IF ^R IS DOING THIS, MUST CALL MACRO USING RRMAC. + JRST MACXQW ;SO THAT TECO KNOWS WE ARE LEAVING ^R. + JRST RRMAC5] + 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 +] + +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 + JSP CH,FSMPD1 +IFN ITS,.IOT CHECDS,CH +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 +IFN ITS,.IOT CHSIO,CH +IFN TNX,CALL [MOVEI A,(CH) ? PBOUT ? RET] + 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 +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. +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, + CALL SAVACS + MOVE C,CH + MOVEI CH,FSECO2 ;TYPE OUT EACH CHAR OF IT USING FSECO2. + HRRM CH,LISTF5 + SETO D, + CALL FGCMD1 + JRST RSTACS] + SKIPN RGETTY + JRST [ 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 + SETOM 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,DISINI + SETOM VREMEM ;TRY TO DISPLAY BFR AT SAME PLACE + PUSHJ P,GETARG + 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: SETOM TYOFLG ;SINCE WE ARE SCREWING UP VPOS AND HPOS, TYPEOUT SHOULD REINIT. + MOVE C,NLINES + CALL WINSET +VBDBL1: 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> + SAVE C + SAVE FF + TRZ FF,FRCLN\FRUPRW + CALL GETAG7 ;MOVE UP THAT MANY LINES FROM PT. + JFCL + REST FF + REST C + SUBI C,2 ;(IN CASE C IS 0) + IMUL C,NHLNS ;# CHARS TO MAKE THAT MANY CONTINUATION LINES. + ADD C,PT + CAMGE E,C ;START AT WHICHEVER PLACE COMES LATER. + MOVE E,C + MOVE IN,E ;(WE MIGHT HAVE GONE UP MORE LINES THAN WE WANTD TO) + REST C ;- MINIMUM VPOS WE WANT PT TO APPEAR AT. + JRST VBDTRY + +;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,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 +VBDOK1: SKIPN MORFLF + SKIPGE ORESET ;STOP IF FLUSHED OR QUITTING. + JRST DISCLG + CAMN IN,ZV ;STOP IF NO MORE CHARS. + 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. +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 ;STOP WHEN A (THE HPOS) REACHES TT. + MOVE TT,NHLNS + SOS TT + 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: CAME BP,OUT ;STOP IF REACH PT, GPT OR ZV. + CAMN A,TT ;STOP IF REACH RIGHT MARGIN. + AOSA A ;IN EITHER CASE, INCREMENT HPOS FOR CHAR WE JUST DID. + AOJA A,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: 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 + AOS A ;AND INCREMENTING THE HPOS + TRNE A,7 ;TILL WE REACH A TAB STOP. + CAMN A,NHLNS + CAIA + JRST VBDTAB + SOJA A,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 EITHER NORMAL 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: 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) + PUSHJ P,CHCT1A + HLRZ CH,(P) + XORI CH,100 ;AND UN-CTLED CHAR. + CALL CHCT1A +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. + 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: MOVEI Q,(CH) + ROT Q,@CHCTHP + ADDM Q,CHCTHC + 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: MOVEI Q,(CH) + ROT Q,@RRHPOS + ADDM Q,HCDS(BP) + 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: MOVEI Q,(CH) + ROT Q,@RRHPOS + MOVNS Q ;SUBTRACT SHIFTED CHAR FROM HASH CODE + ADDB Q,HCDS(BP) + 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 +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 SEND THE TERMINAL OUTPUT BUFFER + +;CALL HERE TO FORCE OUT BUFFERED OUTPUT. +;CALL AFTER EACH TECO COMMAND THAT DOES OUTPUT. +DISFLS: AOSN CHCTCF ;FORCE OUT ANY UNPROCESSED CR. + CALL CHCT5 ;THIS CAN BE A SCREW IF BETWEEN THAT CR AND A LF! + SETOM CHCTNL + SETOM DISFLF ;FORCE DISLIN TO MOVE CURSOR + 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 + SETZM HCDS + JRST .+1] + MOVE CH,CHCTHC +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 +] + SKIPN RGETTY + JRST DISLI0 ;ON PRINTING TTY, NO OLD LINE REMAINS ON SCREEN. + CAML BP,CHCTVS ;IF WE'RE WITHIN THE SCREEN AREA, + JRST DISLN5 + 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 + SETOM RRIDLB + MOVE BP,CHCTVP +IFN ITS,[MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDNOP] + MOVEM Q,DISBF1 ;DSLID CLOBBERS DISBF1! + MOVEM Q,DISBF1+1 +] +DISLI8: 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. + CAMN CH,HCDS(BP) ;OUTPUT ONLY IF HASH CODE DIFFERS, + SKIPE DISFLF ;OR IF INSIST ON OUTPUTTING + JRST DISLI4 + JRST DISLI3 + +DISLN5: MOVEM BP,DISVP ;WE'RE AT BOTTOM OF SCREEN; MUST OUTPUT, SO THAT + MOVEM BP,DISVP1 ;WE WILL CALL DISMOR IF NECESSARY, BUT ARRANGE NOT TO CLEAR +DISLI4: +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 DISLI1 ;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 +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 + CAMG BP,CHCTVS ;IF BELOW END OF SCREEN, OR + CAME Q,[041000,,DISBUF-1] ;IF NON-NULL LINE AT END OF SCREEN, + CAMGE BP,CHCTVS + JRST DISLN4 + JRST DISMOR ;GO PRINT --MORE--, COME BACK. + +DISLN4: CAMGE BP,CHCTVS ;HERE WHEN WE KNOW WE MUST OUTPUT THE LINE. STORE NEW HASHCODE. + SKIPN RGETTY + CAIA + MOVEM CH,HCDS(BP) + SETZ T, ;COUNT THE NUMBER OF UNUSED BYTES IN THE LAST WORD +DISLI2: TLNE Q,700000 ;OF THE OUTPUT BUFFER. + AOJA T,[IBP Q ? JRST DISLI2] + 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, + SKIPE RRMSNG ;AND ALL UNCHANGED LINES ARE PROPERLY ON THE SCREEN, + JRST DISLN2 + MOVE Q,LINBEG+1(BP) + ADD Q,Z ;AND 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. + SETZM RRMNHP ;THUS MAKE SURE REDISPLAY STARTS THIS FAR UP AT LEAST. +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 +] + JUMPE T,[SKIPE LID ;IF DOING INSERT/DELETE, SET RRMSNG INSTEAD OF UPPING RRMAXP + JRST [ SETOM RRMSNG ;SINCE THE LATTER WOULD SCREW IF THIS NEW INPUT WANTS + JRST RRDISX] ;TO INSERT OR DELETE 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 LINE 1(BP), +;WHEREAS FOR DOWNWARD MOTION WE MOVE DOWN TO LINE (BP). +;THE NUMBER OF LINES TO BE MOVED IS (RRIDVP)-(BP)-1 IN EITHER CASE. +;OTHER CALLERS MUST ARRANGE BP AND RRIDVP ACCORDINGLY. +;WE CLOBBER ONLY Q. +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,-1(P) + 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. + 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,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 + REST A +DSLID6: SETZM HCDS(Q) ;ZERO THE HASH CODES FOR THE INSERTED BLANK LINES. + AOS Q + CAMGE Q,BOTLIN + JRST DSLID6 + SETOM RRMSNG ;NOW, WE MUST THINK ABOUT DISPLAYING ALL THE WAY TO END OF WINDOW, + ;SO THAT WE WILL FILL THOSE BLANK LINES WITH WHAT BELONGS THERE. +DSLID3: MOVE BP,-2(P) ;NOW RESTORE CURSOR TO POSITION IT HAD ON ENTRY TO DSLID. + CALL SETCUR +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. + MOVE Q,-1(P) + 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. + 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,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 HASCODES OF THE NEWLY MADE BLANK LINES. + CAIE Q,1(BP) + SOJA Q,DSLID7 + REST A ;GET BACK LINBEG OF LINE MOVED OFF BOTTOM OF SCREEN. + SKIPN RRMORF + CAMN A,RROLZV ;IF THERE WAS DISPLAYED TEXT ON THAT LINE, + JRST DSLID2 + MOVE A,MORESW ;THEN THE MODE LINE SHOULD SAY --MIDDLE-- OR --TOP-- NOW. + TRON A,MS%DWN ;IF IT ISN'T ALREADY RIGHT, + SETZM DISOMD ;MAKE SURE THAT IT WILL BE REDISPLAYED + MOVEM A,MORESW ;SAYING THE RIGHT THING. + TRNN A,MS%UP ;THIS INCLUDES FIGURING OUT THE % ABOVE SCREEN + JRST DSLID2 + CALL DISMO6 ;IF STUFF WAS OFF THE TOP ALREADY AND NOW ALSO OFF THE BOTTOM. + HRLM A,MORESW +DSLID2: REST A + JRST DSLID3 + +SUBTTL HANDLE BOTTOM-OF-SCREEN CONDITION + +;PRINT --MORE--, GO BACK TO DISLI3 IF FLUSHED, ELSE TO DISLI7. +;IN ^R MODE, EXIT RESTORING P FROM DISPRR. +DISMOR: SKIPGE ERRFLG + JRST DISLN1 + 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 DISMO3 ;ON PRINTING TTY, JUST ASSUME FLUSHED. + MOVEI T,8 ;ON DISPLAY, MUST DO THE POSITIONING THAT DISLIN DIDN'T DO. + CAMG BP,USZ + CALL DISSIOT + SKIPN ORESET + SKIPE MORFLF + JRST DISLI3 ;ALREADY FLUSHED. + 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 [ PUSHJ P,DISTOP ;TOP OF SCREEN, THEN TRY AGAIN. + SKIPL VREMEM ;IF DISPLAYING STUFF THAT'S IN BUFFER, + JRST DISLI7 + 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 DISLI7] + 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/ + PUSHJ P,DISIOT ;PUT FLUSHED ON THE --MORE-- LINE + MOVEI T,MS%FLS + MOVEM T,MORESW ;AND REMEMBER THAT THAT IS WHAT'S THERE. +IFN TNX,[SKIPE ECHOF2 + CALL ECHOCH] ;ECHO IT NOW + JRST DISLI3 + +DISMO3: SETOM MORFLF + JRST DISLI3 + +;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 INITIALIZE DISPLAY OUTPUT + +;INIT FOR DISPLAY OUTPUT. +DISINI: SETOM TYOFLG ;"TYPEOUT" NO LONGER INITTED. + SETOM ECHCHR ;IF ^R COMMAND DOES DISPLAYING IT SHOULDN7T 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] + SETZM MORFLF ;UNDO A FLUSHED. + SETZM OLDFLF + SETOM DISVP + SETZM DISVP1 + MOVE Q,USZ + MOVEM Q,CHCTVS + SKIPN RGETTY + JRST [ 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 + 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. + 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 DISFLS ;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. +;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. +DISCLR: MOVE BP,CHCTVP + CAML BP,CHCTVS ;STOP CLEARING AT END OF WINDOW, OR END OF SCREEN. + RET + 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. + JRST DISCL1 + SETZM HCDS(BP) ;CLEAR A LINE BY CLEARING THE HASH CODE, + HRLZS BP ;MOVING TO THE LINE + CALL SETCU1 + CALL CLREOL ;AND CLEARING VIA THE SYSTEM. +DISCL1: AOS CHCTVP + JRST DISCLR + +;,FS TYO HASH$ SETS HASH CODE OF LINE. +FSHCD: MOVE E,SARG + SKIPL C ;REQUIRE VPOS TO BE IN RANGE. + CAML C,USZ + TYPRE [AOR] + MOVE A,HCDS(C) + TRZE FF,FRARG + 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. +DISMDI: MOVE Q,$QMODE ;UPDATE MODE DISPLAY IF IT IS NECESSARY + SKIPE RGETTY ;ON PRINTING TTY, WE DISPLAY IT DIFFERENTLY. + 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 DISMD9 ;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 DISMD9 + 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: CAME T,MORESW ;IF THE DESIRED STATE OF --MORE-- OR NOT IS CHANGED, + JRST DISMD9 + MOVE Q,$QMODE ;OR THE DESIRED MODE STRING IS CHANGED, WE MUST REDISPLAY THE LINE. + CAMN Q,DISOMD + RET +DISMD9: SKIPN RGETTY ;NO MODE IS SHOWN ON PRINTING TTY'S. + RET +DISMD2: MOVE Q,$QMODE + MOVEM Q,DISOMD +INSIRP PUSH P,A B TT TT1 BP CH + MOVE A,Q + CALL CLRMOR ;CLEAR THE WHOLE --MORE-- LINE. + SETOM RROHPO ;REMEMBER THAT I.T.S. CURSOR POS. IS BEING CLOBBERED. + SETOM RROVPO + CALL QLGET0 + JRST DISMD1 ;MODE STRING IS NULL? + MOVE TT,NHLNS ;NO => TRUNCATE IT IF TOO BIG TO A SIZE THAT 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. + CAML B,TT + MOVE B,TT +DISMD3: SOJL B,DISMD1 ;DISPLAY THE ..J STRING, OR AS MANY CHARS OF IT AS B SAYS. + ILDB CH,BP +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 TYOINV + JRST DISMD3 + +DISMD1: +INSIRP POP P,CH BP TT1 TT B A + MOVEM T,MORESW + JUMPE T,CPOPJ ;IF WE ARE SUPPOSED TO HAVE --MORE-- OR SOMETHING, WRITE IT. + SKIPN RGETTY + RET + 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 + JRST DISIOT + +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 + SAVE CH + 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 + REST CH + DISSTR /%--/ + JRST DISIOT + +SUBTTL CURSOR CONTROL SUBROUTINES + +IFN ITS,[ +;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] +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. +SETCU1: SKIPE RGETTY + JRST SETCU2 + SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,Q] + .LOSE %LSFIL + HLL BP,Q +SETCU2: CALL SETCUR + 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. +SETCUR: 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 + +INSCHR: HRROI Q,[ASCIC/^/] + JRST DISIOT +DELCHR: HRROI Q,[ASCIC/_/] + JRST DISIOT + +CRIF: HRROI Q,[ASCIC /A/] + JRST DISIOT + +CLRMOR: SKIPA Q,[-2,,MORMCL] ; MAYBE THIS SHOULD BE -3? +CLREOL: HRROI Q,[ASCIC/L/] +DISIOT: .IOT CHDPYO,Q + RET + +;IMMEDIATE TYPEOUT, NO HASH-CODING. +TYOINV: .IOT CHTTYO,CH + POPJ P, +] ;IFN ITS + +IFN TNX,[ +;FUNDAMENTAL DISPLAY OPERATIONS, ON A TERMINAL-INDEPENDANT BASIS. + +;TABLE TRANSLATING TWENEX TERMINAL TYPE CODES TO TECO INTERNAL TERMINAL TYPES. +;THEY ARE: 0 => PRINTING TERMINAL, 1 => DM2500, 2 => H1500, 3 => VT52, +; 4 => DM1520, 5 => IMLAC, 6 => VT05, 7 => TK4025, 10 => VT61, +; 11 => TL4041, 12 => FOX, 13 => HP2645, 14 => I400, 15 => TK4023, +; 16 => ANNARB, 17 => C100 +;VARIOUS TABLES ARE INDEXED BY THE INTERNAL TECO TYPE CODE, WHICH LIVES IN RGETTY. +NTTYPE==20. + +DEFINE DEFTYP TYPE,TABLE +IF1 [ IFNDEF TYPE,[ +PRINTX \GTTYP index for TYPE = \ +.TTYMAC FOO +IFB FOO,TYPE==0 +.ELSE TYPE==FOO +IFG TYPE-NTTYPE+1,.ERR TTYTYP TABLE ISNT LARGE ENOUGH FOR THAT +TERMIN +]] +IF2 [ +IFNDEF %%TYPE,%%TYPE==0 +%%TYPE==%%TYPE+1 +IFN TYPE,[ +%%TMP==. +LOC TTYTYP+TYPE +%%TYPE +LOC %%TMP +]] +IFN TYPE,TABLE +.ELSE 0 +TERMIN + +TTYTBS: PRINTB ;DEVICE DEPENDANT ROUTINE DISPATCH TABLE, INDEXED BY RGETTY +DEFTYP DM2500,DM25TB +DEFTYP H1500,HZ15TB +DEFTYP VT52,VT52TB +DEFTYP DM1520,DM15TB +DEFTYP IMLAC,IMLCTB +DEFTYP VT05,VT05TB +DEFTYP TK4025,TK40TB +DEFTYP VT61,VT61TB +DEFTYP TL4041,TL40TB +DEFTYP FOX,FOXTB +DEFTYP HP2645,HPTB +DEFTYP I400,I400TB +DEFTYP TK4023,TK43TB +DEFTYP ANNARB,AATB +DEFTYP C100,C100TB + +TTYTYP: BLOCK NTTYPE ;INTERNAL TYPE (RGETTY), INDEXED BY GTTYP TYPE + +PRINTB: 377777,,79. ;PRINTING TERMINAL DISPATCH VECTOR + (%TOOVR+%TOMVB+%TOLWR) +REPEAT 4,JFCL + SETZM MORMCL +REPEAT 7,JFCL + +;SET CURSOR POSITION TO VPOS,,HPOS IN 2 +CURPOS: SETOM ECHOP +CURPS0: SAVE B ;SAVE DESIRED POSITION + CALL CURPS1 ;DO WORK FIRST + REST TTLPOS + RET +CURPS1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CURSOR POSITIONING + T,,2 ;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 CPOP1J + +;CLEAR TO END OF LINE +CLREOL: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOL + T,,3 ;ENTRY 3 IN TABLE + +;CLEAR TO END OF SCREEN +CLREOS: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOS + T,,4 ;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 + T,,5 ;CLEAR SCREEN ENTRY 5 IN TABLE + +;INSERT LINES +INSLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT LINE + T,,11 ;ENTRY 11 IN TABLE + +;DELETE LINES +DELLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE LINE + T,,12 ;ENTRY 12 IN TABLE + +;INSERT CHARACTERS +INSCHR: SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT CHAR + T,,13 ;ENTRY 13 IN TABLE + +;DELETE CHARACTERS +DELCHR: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE CHAR + T,,14 ;ENTRY 14 IN TABLE + +;SET UP MORMCL TO CLEAR LINE AT VPOS IN C +MCLSET: SAVE A + JSP A,DDPYTB ;DISPATCH FOR MORE LINE SETUP + T,,6 ;ENTRY 6 IN TABLE + +;SET UP DISBF1 TO CLEAR LINE FIRST +DISMOV: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMOV + T,,7 ;ENTRY 7 IN TABLE + +;DONT CLEAR IT, JUST GO THERE +DISMV1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMV1 + T,,10 ;ENTRY 10 IN TABLE + +;TAKE TERMINAL OUT OF DISPLAY MODE +DPYRST: SAVE A + JSP A,DDPYTB ;DISPATCH FOR TERMINAL RESET + T,,15 ;ENTRY 15 IN TABLE + +;LOW LEVEL INTERFACES TO DEVICE DEPENDANT ROUTINES + +DISSIO: JSR SAV123 ;SAVE ACS + 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 DISSI4 + MOVE B,NHLNS + CAML B,CHCRHP + MOVE B,CHCRHP ;UPDATE HORIZONTAL POSITION + HRLI B,(BP) + MOVEM B,TTLPOS ;UPDATE CURSOR POSITION +IFN TK4025\ANNARB,[ + MOVE A,RGETTY ;HAVE TO KLUDGE CLEOL +IFN TK4025,[ + CAIN A,7 .SEE TTYTYP ; FOR 4025S + JRST DISSTK +] +IFN ANNARB,[ + CAIN A,16 .SEE TTYTYP + JRST DISSTK +] +] ;TK4025\ANNARB + +POP321: +DISSI4: REST C +POP21J: REST B + REST A + RET + +IFN TK4025\ANNARB,[ +DISSTK: SKIPN EOLFLG ;POSTPONED CLEARING NEEDED? + CALL CLREOL ;YES, FAKE IT + JRST POP321 +] ;TK4025\ANNARB + +;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 +CPOP2J: REST B + RET + +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 CPOP1J] + 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,POP21J ;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 POP21J + +;RETURN CURSOR TO UPPER LEFT CORNER OF SCREEN. +HOMCUR: SAVE B + SETZ B, + CALL CURPOS + JRST CPOP2J + + +;CLEAR THE MORE LINE, SMASH ONLY Q +CLRMOR: MOVE Q,RGETTY ;GET TTY TYPE +IFN VT05,[ + CAIN Q,6 ;HAS NULLS IN IT? + JRST CLRMO6 ;YES, MUST USE SOUT THEN +] +IFN TK4025,[ + CAIN Q,7 ;NEEDS SPECIAL HACKING? + JRST CLRMO7 +] +IFN ANNARB,[ + CAIN Q,16 + JRST CLRM16 +] + HRROI Q,MORMCL ;OTHERWISE JUST FALL THRU WITH WHAT WAS SETUP + +;OUTPUT ASCIZ STRING Q POINTS AT. +DISIOT: EXCH A,Q + PSOUT + EXCH A,Q + RET + +;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 POP21J] + 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 POP21J + +;GET FRESH LINE +CRIF: SAVE A + SAVE B + MOVEI A,.PRIOU + RFPOS + HRROI A,[ASCIZ/ +/] + TRNE B,-1 + PSOUT + JRST POP21J + +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 + CAIE CH,^H ;BS COMES OUT AS ITSELF + 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 POP21J + +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 + +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 POP21J + +;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: AOJL 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: AOJL 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 - SAVE POSITION + [MOVE C,ECHOPS ? MOVEM C,ECODPS ? RET] ;S - RESTORE 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 IMLAC,[ + MOVE A,RGETTY + CAIN A,5 ;BS OVERWRITES ON IMLAX + SKIPA A,[-1,,[.BYTE 7 ? 177 ? 204-176 ? 0]] +] + HRROI A,[.BYTE 7 ? 40 ? 10 ? 0] ;^PK - ERASE CURRENT CHAR + 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: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) + CALL DMCPS + CALL DMCEOL + CALL DMCEOL ;CLOSEST WE CAN COME + CALL DMCLRS + CALL DMMCLS + CALL DMDSMV + CALL DMDMV1 + CALL DMINSL + CALL DMDELL + CALL DMINSC + CALL DMDELC + CALL DMRST + +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. + SKIPN B,OSPEED ;SPEED OF OUTPUT + MOVEI B,9600. ;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 + MOVEI A,177 ;FILL CHARACTER + SKIPE C,B ;GET NUMBER OF FILL CHARS NEEDED + PBOUT + SOJG C,.-1 ;OUTPUT THAT MANY + 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 + SKIPE C,OSPEED + 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,140(BP) + PBOUT + MOVEI A,^P + PBOUT + RET + +DMMCLS: LSH C,14.+1 + XOR C,[.BYTE 7 ? ^L ? "` ? "` ? ^W ? 0] + MOVEM C,MORMCL + 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 CPOP2J + +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 + +DMDELC: SKIPA A,[440700,,[.BYTE 7 ? ^P ? ^H ? 0]] +DMINSC: HRROI A,[.BYTE 7 ? ^P ? ^\ ? 0] + PSOUT + SAVE C + MOVEI A,177 + SKIPE C,OSPEED + CAIL C,9600. ;IF AT 9600 OR MORE, + PBOUT ;NEED ONE FILL CHAR + JRST DMINS3 +] ;DM2500 + +IFN H1500,[ +SUBTTL H1500 + +HZ15TB: 24.,,79. ;DISPATCH VECTOR FOR HZ1500 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL HZCPS + CALL HZCEOL + CALL HZCEOS + CALL HZCLRS + CALL HZMCLS + CALL HZDSMV + CALL HZDMV1 + CALL HZINSL + CALL HZDELL +REPEAT 3,JFCL + +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 + +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 + +HZCLRS: HRROI A,[.BYTE 7 ? 176? ^\ ?177?177?177?177?0] + PSOUT + RET + +HZINSL: SAVE C + CALL HZIDPS +HZINS1: HRROI A,[.BYTE 7 ? 176 ? ^Z ? 0] + PSOUT + MOVEI C,8. + CALL HZFILL + SOJG Q,HZINS1 + REST C + RET + +HZFILL: HRROI A,[.BYTE 7 ? 177?177?177?177 ? 0] + PSOUT + SOJG C,.-2 + RET + +HZDELL: SAVE C + CALL HZIDPS +HZDEL1: HRROI A,[.BYTE 7 ? 176 ? ^S ? 0] + PSOUT + MOVEI C,1. + CALL HZFILL + SOJG Q,HZDEL1 + REST C + RET + +HZIDPS: MOVEI C,140(BP) + LSH C,7+1 + IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] + HRROI A,C + PSOUT + RET + +;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 + DMOVEM A,DISBF1+3 + SETZM DISBF1+5 ;ASSUME NO HORIZ POSITIONING NECSY + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST CPOP2J ;YES, DONT NEED SECOND CURSOR ADDRESS THEN +HZDSM2: MOVE A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] + CALL HZDSM1 + MOVEM A,DISBF1+5 + JRST CPOP2J + +HZDSM1: SAVE A + DPB BP,[041000+P,,] ;VPOS + MOVE B,DISCPH + DPB B,[141000+P,,] ;HPOS + REST A + RET + +HZDMV1: SAVE B + SETZM DISBF1+3 ? SETZM DISBF1+4 + JRST HZDSM2 + +HZMCLS: LSH C,7+1 + IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 176] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? ^O ? 177 ? 177 ? 0] + MOVEM C,MORMCL+1 + RET +] ;H1500 + +IFN VT52\VT61\TL4041,[ +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 + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 +REPEAT 5,JFCL +] ;VT52 +IFN VT61,[ +VT61TB: 24.,,79. ;DISPATCH VECTOR FOR VT61 +IFE VT61-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 + CALL VTINSL + CALL VTDELL + CALL VTINSC + CALL VTDELC + 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 VTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT +VTINS1: MOVEI A,"P + CALL VTESC + MOVE A,(P) ;GET DESIRED FUNCTION AGAIN + PBOUT + SOJG Q,VTINS1 + JRST CPOP1J + +VTDELC: HRROI A,[.BYTE 7 ? 33 ? "P ? "S ? 0] + PSOUT + RET +VTINSC: HRROI A,[.BYTE 7 ? 33 ? "P ? "I ? 40 ? 33 ? "P ? "I+40 ? 10 ? 0] + PSOUT + RET +] ;VT61 +IFN TL4041,[ +TL40TB: 24.,,79. ;DISPATCH VECTOR FOR TELERAY 4041 +IFE TL4041-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 + CALL TLINSL + CALL TLDELL + CALL TLINSC + CALL TLDELC + 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 VTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT + REST A ;GET DESIRED FUNCTION AGAIN + CALL VTESC + SOJG Q,.-1 + RET + +TLDELC: MOVEI A,"Q + JRST VTESC +TLINSC: MOVEI A,"P + JRST VTESC +] ;TL4041 + +VTCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST VTESC] + MOVEI A,"Y ;ELSE SEND $Y + CALL VTESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + JRST VTES1 + +VTCEOL: MOVEI A,"K ;CLEAR EOL +VTESC: SAVE A + MOVEI A,33 + PBOUT + REST A +VTES1: PBOUT + RET + +VTCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL VTESC +VTCEOS: MOVEI A,"J ;CLEAR EOS + JRST VTESC + +VTMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 33 ? "Y ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? "K ? 0) + MOVEM C,MORMCL+1 + RET + +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 CPOP2J +VTDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $Y ? $K ? ... + MOVEM B,DISBF1+4 + CALL VTDMV1 + JRST CPOP2J + +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,[ +SUBTTL FOX + +FOXTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER FOX + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL FXCPS + CALL FXCEOL + CALL FXCEOS + CALL FXCLRS + CALL FXMCLS + CALL FXDSMV + CALL FXDMV1 +REPEAT 5,JFCL + +FXCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST FXESC] + MOVEI A,"X ;ELSE SEND $X + CALL FXESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,"Y ;$Y + CALL FXESC + MOVEI A,40(B) ;+40 + JRST FXES1 + +FXCEOL: MOVEI A,"I ;CLEAR EOL +FXESC: SAVE A + MOVEI A,33 + PBOUT + REST A +FXES1: PBOUT + RET + +FXCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL FXESC +FXCEOS: MOVEI A,"J ;CLEAR EOS + JRST FXESC + +FXMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 33 ? "X ? 40 ? 33 ? "Y] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? 40 ? 33 ? "I] + MOVEM C,MORMCL+1 + RET + +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 CPOP2J +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 +] ;FOX + +IFN DM1520,[ +SUBTTL DM1520 + +DM15TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 1520 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL D1CPS + CALL D1CEOL + CALL D1CEOS + CALL D1CLRS + CALL D1MCLS + CALL D1DSMV + CALL D1DMV1 +REPEAT 5,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 + +D1MCLS: LSH C,14.+1 ;[ + ADD C,[.BYTE 7 ? ^^ ? 40 ? 40 ? ^] ? 0] + MOVEM C,MORMCL + RET + +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 CPOP2J + +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 IMLAC,[ +SUBTTL IMLAX + +IMLCTB: 44.,,88. ;DISPATCH TABLE FOR IMLAX + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) + CALL IMCPS + CALL IMCEOL + CALL IMCEOS + CALL IMCLRS + CALL IMMCLS + CALL IMDSMV + CALL IMDMV1 + CALL IMINSL + CALL IMDELL + CALL IMINSC + CALL IMDELC + JFCL + +IMCPS: MOVEI A,217 ;%TDMV0 + CALL IMCEO2 + HLRZ A,B ;VPOS + AOJ A, ;AVOID SENDING NULL + PBOUT + MOVEI A,1(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,1(BP) ;VPOS + PBOUT + MOVEI A,1 + PBOUT + REST A ;GET BACK DESIRED FUNCTION + CALL IMCEO2 + MOVEI A,(Q) ;GET REPEAT COUNT + JRST IMCPS2 + +IMINSC: SKIPA A,[225] ;%TDICP +IMDELC: MOVEI A,226 ;%TDDCP + CALL IMCEO2 + MOVEI A,1 + JRST IMCPS2 + +IMMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 177 ? 217-176 ? 1 ? 1 ? 177] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? 203-176 ? 0) + MOVEM C,MORMCL+1 + RET + +IMDSMV: SAVE B + MOVEI B,1(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 1 ? 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 CPOP2J +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 ? 1 ? 1] + 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 + CALL V0MCLS + CALL V0DSMV + CALL V0DMV1 +REPEAT 5,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 + +V0MCLS: LSH C,21.+1 + ADD C,[.BYTE 7 ? ^N ? 40 ? 0] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? 0 ? 40 ? ^^] + MOVEM C,MORMCL+1 + RET + +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 CPOP2J +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 CPOP2J + +V0DMV1: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^N ? 0) + JRST V0DSM3 + +CLRMO6: JSR SAV123 + MOVEI A,.PRIOU + HRROI B,MORMCL + MOVNI C,8 + SOUT + CALL V0FILL + JRST POP321 +] + +IFN TK4025,[ +SUBTTL TEKTRONIX 4025S + +TK40TB: 34.,,78. ;DISPATCH TABLE FOR TEKTRONIX 4025 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL TKCPS + CALL TKCEOL + CALL TKCEOS + CALL TKCLRS + CALL TKMCLS + CALL TKDSMV + CALL TKDMV1 + CALL TKINSL + CALL TKDELL + CALL TKINSC + CALL TKDELC + JFCL + + +; TKCPS - OUTPUT TEK4025 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +TKCPS: JUMPE B,[HRROI A,[ASCIZ / `UP34;/] + 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,CPOP2J + JUMPE A,[MOVEI A,^M ;FASTER IF GOING TO BEGINNING OF LINE + PBOUT + JRST CPOP2J] + HRROI A,[ASCIZ /`RIG/] ;ASSUME NEGATIVE => RIGHT + SKIPL B + HRROI A,[ASCIZ /`LEF/] + PSOUT + CALL TKCPS7 + JRST CPOP2J + +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 POP21J + +TKCPS8: + HRROI A,[ASCIZ / `UP34;/] + PSOUT + REST B ;POP OFF OLD STUFF + HLRZ B,(P) ;GET LINE + JUMPE B,TKCPS9 + HRROI A,[ASCIZ /`DOW/] + PSOUT + CALL TKCPS7 +TKCPS9: HRRZ B,(P) + JUMPE B,CPOP2J + HRROI A,[ASCIZ /`RIG/] + PSOUT + CALL TKCPS7 + JRST CPOP2J + + +TKCEOS: ; CLOSE ENOUGH FOR MOST THINGS +TKCEOL: PUSH P,A ; SAVE ACs + PUSH P,B + PUSH P,C + HRRZ C,TTLPOS ; GET CURRENT POSITION + PUSH P,C ; SAVE FOR LATER + SUBI C,79. ; MAKE HPOS-79 + HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + MOVEI A,^M + PBOUT ; BACK TO LEFT + POP P,B ; GET BACK OLD POS + JUMPE B,TKCEO1 + HRROI A,[ASCIZ /`RIG/] + PSOUT + PUSHJ P,TKCPS7 +TKCEO1: POP P,C + POP P,B + POP P,A + POPJ P, + +TKCEO2: HRROI A,[ASCIZ /`DLI;`UP;`ILI;/] + PSOUT + HRROI A,[ASCIZ / /] ; SOME SPACES FOR FILL + PSOUT + MOVEI A,^M + PBOUT + RET + +TKCLRS: HRROI A,[ASCIZ /`ERA;/] +TKCLR2: PSOUT + RET + +TKINSC: HRROI A,[ASCIZ /`ICH; `LEF1;/] + JRST TKCLR2 +TKDELC: HRROI A,[ASCIZ /`DCH;/] + JRST TKCLR2 + +; 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 + 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 + +TKMCLS: MOVEM C,MORMCL + RET + +CLRMO7: SAVE A + SAVE B + HRROI A,[ASCIZ /`UP34;`DOW/] + PSOUT + MOVE B,MORMCL + CALL TKCPS7 + HRROI A,[ASCIZ /`DLI;`UP;`ILI;/] + PSOUT + HRLZ B,MORMCL + MOVEM B,TTLPOS + JRST POP21J + + +TKDMV1: HRROS (P) + SAVE [141000,,DISBF1+1] + JRST TKDSM2 +TKDSMV: SKIPE DISCPH ;ANY HPOS? + SAVE [441000,,DISBF1] ;YES, WILL NEED WHOLE BUFFER + SAVE [141000,,DISBF1+1] + HRRZS -1(P) +TKDSM2: 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: SETZM EOLFLG ; NO CLEARING + SKIPE HCDS(BP) ;NEED CLEARING? + SKIPGE -2(P) ;AND WANT CLEARING? + SKIPA A,[-1] ;NO OR NO + SETZ A, ;YES AND YES, IT'S NEEDED + MOVEM A,EOLFLG ;SAVE IT + SKIPN DISCPH ;GET HPOS IF ANY + JRST POP21J + MOVEI A,[ASCIZ /`RIG /] + CALL TKDSMS + MOVE A,DISCPH + CALL TKDSMN + MOVEI A,"; + IDPB A,-1(P) + JRST POP21J + +TKDSMS: SAVE B + HRLI A,440700 +TKDSS2: ILDB B,A + JUMPE B,CPOP2J + 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 + CALL HPMCLS + CALL HPDSMV + CALL HPDMV1 + CALL HPINSL + CALL HPDELL + CALL HPINSC + CALL HPDELC + 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 ; ... + REST A ; RESTORE AC + RET + + +; 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,"Y ; CURSOR POSITION FOR LINE NO. ONLY + IDPB C,A + MOVEI C,^M ; THEN FOLLOW WITH A CR + IDPB C,A ; ... + JRST HPMOV1 + ] + MOVEI C,"y ; 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 + REST B ; ... + RET + +; 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: HRROI A,[ASCIZ "K"] + PSOUT + RET + + +; HPCEOS - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF SCREEN. + +HPCEOS: HRROI A,[ASCIZ "J"] + PSOUT + RET + + +; 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 + REST B ; RESTORE AC + RET + +HPDELC: HRROI A,[ASCIZ "P"] + PSOUT + RET +HPINSC: HRROI A,[ASCIZ "Q R"] + PSOUT + RET + +; HPMCLS - CALCULATE HP2645 COMMANDS TO MOVE TO THE SPECIFIED LINE AND CLEAR +; IT. THE COMMANDS ARE PUT IN MORMCL, WHICH IS OUTPUT AT SOME LATER TIME. +; ARGUMENT: +; C LINE NO. TO BE CLEARED + +HPMCLS: SAVE A ; ... + SAVE B ; ... + MOVE A,[440700,,MORMCL] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,C ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; PUT IN COMMANDS TO MOVE TO DESIRED 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 ; ... + MOVEI B,0 ; TERMINATE WITH ZERO BYTE + IDPB B,A ; ... + REST B ; RESTORE ACS + REST A ; ... + RET + + +; 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: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + 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,HPDSM4 ; ZERO BYTE TERMINATES + IDPB C,A ; PUT INTO DISBF1 + JRST HPDSM3 +HPDSM4: REST C ; RESTORE ACS + REST B ; ... + REST A ; ... + RET + + +; HPDMV1 IS JUST LIKE HPDSMV, EXCEPT THAT IT DOES NOT CLEAR. + +HPDMV1: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + 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 + SKIPN B,DISCPH ; DESIRED COLUMN ZERO? + JRST HPDSM2 ; YES, ALREADY THERE + MOVEI C,33 ; SEND THE START OF THE CURSOR POSITIONING + DPB C,A ; SEQUENCE + MOVEI C,"& ; ... + IDPB C,A ; ... + MOVEI C,"a ; ... + IDPB C,A ; ... + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI B,"C ; TERMINATE COLUMN NO. AND CURSOR POSITIONING + IDPB B,A ; ... + JRST HPDSM1 + +];IFN HP2645 + +IFN I400,[ +SUBTTL INFOTON 400 + +I400TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID) + CALL I4CPS + CALL I4CEOL + CALL I4CEOS + CALL I4CLRS + CALL I4MCLS + CALL I4DSMV + CALL I4DMV1 + CALL I4INSL + CALL I4DELL + CALL I4INSC + CALL I4DELC + CALL I4RST + +I4CPS: HRROI A,[ASCIZ /[/] ;] + PSOUT + 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 + +I4ESC: SAVE A + HRROI A,[ASCIZ /[/] ;] + PSOUT + REST A + PBOUT + RET + +I4PAR: SAVE B + IDIVI A,10. + JUMPE A,I4PAR1 + ADDI A,"0 + PBOUT +I4PAR1: MOVEI A,"0(B) + PBOUT + JRST CPOP2J + +I4CEOL: MOVEI A,"N + JRST I4ESC + +I4CEOS: MOVEI A,"J + JRST I4ESC + +I4CLRS: HRROI A,[ASCIZ //] ;] + PSOUT + RET + +I4MCLS: HRROI A,[ASCIZ //] ;] SET UP RIGHT MODE + PSOUT + MOVEI A,1(C) + IDIVI A,10. + LSH A,14.+1 + LSH B,7+1 + ADDI A,(B) + ADD A,[.BYTE 7 ? 33 ? "[ ? "0 ? "0 ? "H] ;] + MOVEM A,MORMCL + MOVE A,[.BYTE 7 ? 33 ? "[ ? "N] ;] + MOVEM A,MORMCL+1 + RET + +I4DSMV: MOVEI C,5 ; INDEX INTO DISBF1 + MOVE A,[.BYTE 8 ? 33 ? "[ ? "2 ? "N ] ;] + MOVEM A,DISBF1(C) + SOS C + JRST I4DMV3 ; ENTER REST OF CODE + +I4DMV1: MOVEI C,5 ; INDEX INTO DISBF1 +I4DMV3: MOVE A,DISCPH + 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 +I4DSM2: 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) + RET + +I4INSL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSTION CURSOR TO IT +I4INS1: HRROI A,[ASCIZ //] ;]]] + PSOUT + PUSHJ P,I4PAD ;PAD THE INSERT + SOJG Q,I4INS1 ;AND LOOP IF MORE TO DO + RET + +I4DELL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSITION CURSOR TO IT +I4DEL1: HRROI A,[ASCIZ //] ;]]] HAVE TO SWITCH MODES AND BACK + PSOUT + PUSHJ P,I4PAD ;PAD FOR THE DELETION + SOJG Q,I4DEL1 ;AND LOOP IF MORE TO DO + RET + +I4PAD: MOVE A,OSPEED ;GET SPEED IN BPS (IN A TO PRESERVE C FR IDIVI) + IDIVI A,600. ;FIND NUMBER OF PADDING CHAR'S + MOVEI B,(A) + MOVEI A,177 ;PAD WITH RUBOUTS + PBOUT + SOJG B,.-1 + RET + +I4INSC: HRROI A,[ASCIZ / /] ;]] ECHH! + PSOUT + RET + +I4DELC: MOVEI A,"P + JRST I4ESC + +I4RST: HRROI A,[ASCIZ //] ;] RESET ROLL + PSOUT + RET + +] ;IFN I400 + +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 + CALL T3MCLS + CALL T3DSMV + CALL T3DMV1 +REPEAT 5,JFCL + +T3CPS: MOVEI A,28. + PBOUT + MOVEI A,41(B) ; X POS + PBOUT + HLRZ A,B ; Y POS + ADDI A,40 + PBOUT + RET + +T3CLRS: SAVE A + SAVE B + SAVE C + 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 POP321 + +T3MCLS: MOVE A,[[.BYTE 7 ? 28. ? 41 ? 40 ? 31. ? "@ + 33 ? "O ? 1 ? 1 ? 1 + 1 ? 28. ? 40 ? 40 ? 31. + "B],,MORMCL] + BLT A,MORMCL+3 + LSH C,1+7 + ADDM C,MORMCL+2 + LSH C,7 + ADDM C,MORMCL + RET + +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 CPOP2J + +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 CPOP2J + +T3CEOS: +T3CEOL: SAVE A + SAVE B + SAVE C + HRROI A,[.BYTE 7 ? 31. ? "H ? 33 ? "O] + PSOUT + SKIPN C,OSPEED ; GOTTA PAD? + JRST T3CEO1 ; ASSUME THE WORST + SETZ A, + CAIL C,4800. + HRROI A,[.BYTE 7 ? 1 ? 1] + CAIL C,9600. +T3CEO1: 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 POP321 + +] ;IFN TK4023 + +IFN ANNARB,[ +SUBTTL ANN ARBOR + +AATB: 40.,,79. ;DISPATCH TABLE FOR ANN ARBOR + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL AACPS + CALL AACEOL + CALL AACEOS + CALL AACLRS + CALL AAMCLS + CALL AADSMV + CALL AADMV1 + JFCL + JFCL + JFCL + JFCL + 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 + REST B ; RESTORE CURSOR POSITION + RET + + +AACEOS: ; CLOSE ENOUGH FOR MOST THINGS +AACEOL: PUSH P,A ; SAVE ACs + PUSH P,B + PUSH P,C + HRRZ C,TTLPOS ; GET CURRENT POSITION + SUBI C,80. ; MAKE HPOS-80 + HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + MOVE B,TTLPOS + CALL AACPS + POP P,C + POP P,B + POP P,A + RET + + +AACLRS: MOVEI A,^L + PBOUT + RET + + +; AAMCLS - CALCULATE ANN ARBOR COMMANDS TO MOVE TO THE SPECIFIED LINE AND +; CLEAR IT. THE COMMANDS ARE PUT IN MORMCL, WHICH IS OUTPUT AT SOME LATER +; TIME. ACTUALLY WE SIMPLY PUT THE LINE NO. IN MORMCL AND CLRMOR HAS A +; SPECIAL TEST WHICH JUMPS TO CLRM16 (SIGH). + +; ARGUMENT: +; C LINE NO. TO BE CLEARED + +AAMCLS: MOVSM C,MORMCL + RET + +CLRM16: SAVE A + SAVE B + MOVE B,MORMCL + CALL AACPS + MOVEM B,TTLPOS + CALL AACEOL + JRST POP21J + + +; AADSMV - CALCULATE ANN ARBOR 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. + +AADSMV: SETZM EOLFLG ; NO CLEARING + SKIPN HCDS(BP) ; NEED CLEARING? + SETOM EOLFLG ; YES, SET FLAG TO DO IT LATER +; FALL THROUGH TO AADMV1 + + +; AADMV1 IS JUST LIKE AADSMV, EXCEPT THAT IT DOES NOT CLEAR. + +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 + REST B ; RESTORE AC + RET + +] ; IFN ANNARB + +IFN C100,[ +SUBTTL HDS CONCEPT 100 + +C100TB: 24.,,78. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL C1CPS + CALL C1CEOL + CALL C1CEOS + CALL C1CLRS + CALL C1MCLS + CALL C1DSMV + CALL C1DMV1 + CALL C1INSL + CALL C1DELL + CALL C1INSC + CALL C1DELC + JFCL + + +; C1CPS - OUTPUT C100 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +C1CPS: JUMPE B,[ + HRROI A,[ASCIZ "?"] + PSOUT + RET ] + HRROI A,[ASCIZ "a"] + PSOUT + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + PBOUT + RET + + +; C1CEOL - OUTPUT C100 COMMANDS TO CLEAR TO END OF LINE. + +C1CEOL: HRROI A,[ASCIZ ""] ;CLEAR EOL + PSOUT + RET + + +; C1CEOS - OUTPUT C100 COMMANDS TO CLEAR TO END OF SCREEN. + +C1CEOS: HRROI A,[ASCIZ ""] ;CLEAR EOS + PSOUT + RET + + +; C1CLRS - OUTPUT C100 COMMANDS TO CLEAR THE SCREEN. + +C1CLRS: MOVEI A,^L ; CLEAR SCREEN + PBOUT + RET + + +; C1INSL - OUTPUT C100 COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT + +C1INSL: MOVEI A,^R ;  - INSERT LINE + JRST C1DEL1 + + +; C1DELL - OUTPUT C100 COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE + +C1DELL: MOVEI A,^B ;  - DELETE LINE +C1DEL1: SAVE B ; SAVE AC + MOVS B,BP ; C1CPS ARG: LINE NO.,,COLUMN NO. + CALL C1CPS ; MOVE TO DESIRED LINE NO. + MOVEI B,33 ; ESC +C1ID1: EXCH A,B + PBOUT ; OUTPUT ESC + EXCH A,B + PBOUT ; OUTPUT "" OR "" + SOJG Q,C1ID1 + REST B ; RESTORE AC + RET + + +C1DELC: HRROI A,[ASCIZ ""] + PSOUT + RET + + +C1INSC: HRROI A,[ASCIZ " "] + PSOUT + MOVEI A,0 + PBOUT + RET + +; C1MCLS - CALCULATE C100 COMMANDS TO MOVE TO THE SPECIFIED LINE AND CLEAR +; IT. THE COMMANDS ARE PUT IN MORMCL, WHICH IS OUTPUT AT SOME LATER TIME. +; ARGUMENT: +; C LINE NO. TO BE CLEARED + +C1MCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 33 ? "a ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? ^S ? 0) + MOVEM C,MORMCL+1 + RET + + +; C1DSMV - 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. + +C1DSMV: SAVE B + MOVEI B,40(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? ^S] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "a] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST C1DSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $a ? $ + MOVEM B,DISBF1+5 + JRST CPOP2J +C1DSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $a ? $ ? ... + MOVEM B,DISBF1+4 + CALL C1DMV1 + JRST CPOP2J + + +; C1DMV1 IS JUST LIKE C1DSMV, EXCEPT THAT IT DOES NOT CLEAR. + +C1DMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "a ? 40 ? 40] + MOVEM A,DISBF1+5 ;$a + RET +] ;C100 + +IFN TK4025\ANNARB,[ +SPACES: ASCII / / +] ; IFN TK4025\ANNARB +];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 + JRST TSINT8 + 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: SKIPE RGETTY ;TTY GIVEN BACK TO TECO INTERRUPT. + 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. + 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 + +TSINT8: .SUSET [.RMPVA,,B] ;PUR INT: IF REFERENCE IS TO A PAGE OF A LIBRARY + LSH B,-12 ;WHICH WAS "FLUSHED" BY MOVING FS :EJPAGE$ PAST IT, + CAML B,MEMT ;TREAT AS IF IT WERE NXM AND MAKE A FRESH PAGE. + CAML B,LHIPAG + TYPRE [PUR] +TSINT4: SOS TSINT+1 + CAIL A,HUSED ;MPV INT: CATCH JUMPS TO RANDOMNESS. + .VALUE + .SUSET [.RMPVA,,A] ;GET ADR START OF MISSING PAGE. + LSH A,-12 + AOS A + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + SYSCAL CORBLK,[%CLIMM,,%CBWRT ? %CLIMM,,%JSELF ? %CLIMM,,-1(A) ? %CLIMM,,%JSNEW] + .LOSE %LSSYS + 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 + SKIPLE CH,NOQUIT + JRST TSIL + HRRZ 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 + SETZM TYISNK + 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 + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + 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: SKIPE B,SAVMOD ;RESTORE TTY MODE REQUESTED? + CALL FFRRT2 ;YES, DO IT THEN + TLNN FF,FLNOIN + SKIPE RREBEG ;FROM ^R? + SETOM STOPF + 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 + SETZM TYISNK + SKIPE RREBEG + SETOM ORESET + SKIPN RREBEG ;IF FROM ^R, ... +TSINT5: MOVEM CH,UNRCHC ;PRETEND TO READ IT RATHER THAN SETTING STOPF + HRRZ A,INTPC1 + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + 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 + 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 + MOVEI 1,.FHSLF + GTRPW + ANDI A,-1 + LSH A,-12 + AOS A + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + 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 + +.EXIT: CALL DPYRST ;TAKE TERMINAL OUT OF DISPLAY MODE + MOVEI A,.PRIOU ;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 + MOVE B,TTLPOS ;LET MONITOR KNOW WHERE WE ARE + 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 + SETOM PJATY ;MUST ASSUME WE MESSED UP THE SCREEN + SKIPGE PAGMOD ;IF NOT MESSING WITH PAGE MODE + JRST DOSTIW ;SKIP THIS STUFF + MOVEI A,.PRIOU + RFMOD + LDB C,[.BP TT%PGM,2] + MOVEM C,PAGMOD ;SAVE CURRENT PAGE MODE SETTING FIRST +IFN 20X,TRZE B,TT%PGM ;MAKE SURE PAGE MODE TURNED OFF +IFN 10X,TRZE B,TT%DAM ;FOR TENEX, BINARY MODE MAY BE LOST + SKIPN RGETTY ;ON DISPLAYS + CAIA +IFN 20X, STPAR +IFN 10X, SFMOD +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 +CPOP1J: +POPAJ: POP P,A + POPJ P, + +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 + +;^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 ^_ + +;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 [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 = VALUE OF QREG HOLDING BUFFER TO KILL. + 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,0,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 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 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 ">". + 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. + 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 +IFN ITS,FLG JNAME,.RJNAM,FSRSYS ;GET TECO'S JNAME. +IFN TNX,FLG JNAME,0,FSGTNM + FLG LASTPA,,FSRNLY ;SET BY TECO TO 0 AFTER READING LAST PAGE OF IPUT 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 ITS,FLG MACHIN,,FSRNLY ;READ MACHINE NAME + FLG MODIFI,MODIFF ;SET NONZERO WHEN BUFFER WRITTEN IN. +IFN ITS,FLG MPDISP,0,FSMPDS ;DISPLAY OUTPUT TO M.P. AREA. + FLG MSNAME,,FSDIRS ;READ WORKING DIRECTORY NAME + 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. + 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,,FSRNLY ;NON-0=> DISPLAY TERMINAL + FLG RUBCRL ;NON-0 => RUBOUT AND ^D DELETE A WHOLE CRLF AT ONCE. + 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 ;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 TNX,FLG TTPAGM,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) + FLG TTYINI,0,FSTTYI ;RE-INIT THE VARS RELATING TO TYPE OF TTY. + FLG TTYOPT,,FSRNLY ;TTY'S TTYOPT VARIABLE. +IFN TNX,FLG TTYPAG,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) + FLG TTYSMT,,FSRNLY ;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 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 VB,0,FSVB ;BEGV, BUT CAN BE PUSHED/POPPED. + FLG VERBOS,VERBOS ;<>0=> DISPLAY MOBY ERROR MESSAGES + FLG VERSIO,$%.,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 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 ^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 ^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". INITIALLY + ;IS AN INTERNAL ENTRY TO FS ^RINS$. + 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 ^RSUPP,RRALQT ;NONZERO SUPPRESSES BUILTIN COMMANDS + FLG ^RTHRO,0,FSCRTH ;THROW TO INNERMOST ^R INVOCATION. + FLG ^RUNSU,RRUNQT + 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 .TYINX,0,FSTBNXT ;ILDB THAT POINTER AND RING IT AROUND TO GET NEXT OLD TYI CHAR. + FLG .TYIPT,TYIBFP,FSRNLY ;POINTER TO NEXT TYI CHARACTER IN RING BUFFER. + FLG :EJPAG,LHIPAG ;# OF LOWEST PAGE IN USE BY PURE STRING SPACE +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 + IFCERR ;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 + HRROI B,EDIT ;^T - EDIT + 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 QREG 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,,RRREPT ;^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 + \ No newline at end of file