;;; -*-MIDAS-*- ;;; ************************************************************** ;;; ***** MACLISP ****** READ AND RELATED FUNCTIONS ************** ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** PGBOT [RDR] SUBTTL HIRSUTE READER AND INPUT PACKAGE SUBTTL HAIRY READER BIT DESCRIPTIONS ;OBJECT FLAGS - AS AN OBJECT ACCUMULATES, THE LH OF ACC T ; HAS BITS SET TO DESCRIBE THE STATE OF THE OBJECT ;BIT VALUE MEANING ;3.1 1 TOP LEVEL OBJECT ;3.2 2 FIRST OBJECT OF A LIST ;3.3 4 DOTTED PAIR OBJECT - SECOND HALF ;3.4 10 DELAYED DOT READ ;3.5 20 ALPHA ATOM (I.E., NON-NUMBER ATOM) ;3.6 40 NUMBER ATOM ;3.7 100 DECIMAL NUMBER ;3.8 200 FLOATING NUMBER ;3.9 400 NEGATIVE NUMBER ;4.1 1000 EXPONENT-MODIFIED NUMBER, E.G. ^ OR E (OR SPLICING, IF MACRO) ;4.2 2000 LSH-ED NUMBER, I.E. _ ;4.3 4000 LIST-TYPE OBJECT ;4.4 10000 SIGNED NUMBER ATOM, E.G. +A ;4.5 20000 MACRO-PRODUCED OBJECT ;4.6 40000 BIGNUM BASE 10. ;4.7 100000 BIGNUM BASE IBASE ;4.8 200000 HUNK ;4.9 400000 A form has been seen after a dot. For error checking ; splicing macros. ;CHARACTER FLAGS - THE RH OF AN ENTRY IN THE RCT TABLE ; GENERALLY HAS THE ASCII TRANSLATION FOR THE CHARACTER, ; EXCEPT MACRO-CHARACTERS, WHICH HOLD A FUNCTION TO EXECUTE ; THE LH HAS DESCRIPTOR BITS AS FOLLOWS: ;BIT VALUE MEANING ;3.1 1 ALPHABETIC, I.E. A,B,C,...,Z ;3.2 2 EXTENDED ALPHABETIC, E.G., !,",#,$, ETC. AND LOWERCASE ;3.3 4 DECIMAL DIGIT, I.E. 0,1,2,...,9 ;3.4 10 + OR - ;3.5 20 ^ OR _ ;3.6 40 SECOND CHOICE DENOTER FOR 3.4, 3.5, 4.1, AND 4.3 ;3.7 100 PRINT SHOULD SLASHIFY IF NOT FIRST CHAR ;3.8 200 . KIND OF DOT ;3.9 400 PRINT SHOULD SLASHIFY WHEN IN FIRST POSITION ;4.1 1000 THE RUBOUT CHARACTER, OR THE TTY FORCE FEED CHAR ;4.2 2000 THE READ "QUOTE" CHARACTER, I.E. / ;4.3 4000 MACRO CHARACTER, E.G. ', OR SPLICING MACRO ;4.4 10000 ) ;4.5 20000 . KIND OF DOT ;4.6 40000 ( ;4.7 100000 OR ;4.8 200000 CHARACTER OBJECT ;4.9 400000 WORTHLESS CHARACTERS, AND ANY WITH BIT 3.8 ; OR BITS 4.1-4.8 ON. IFN NEWRD,[ ;;;DEFINE READER-SYNTAX BITS ;;;THESE BITS OCCUPY 2.1-3.8. DO NOT USE 3.9 (SEE TYIPEEK) RS.FF==004000,, ;FORCE-FEED CHARACTER RS.VMO==002000,, ;VERTICAL MOTION (LF, FF) RS.SQX==001000,, ;EXPONENT MARKER, STRING QUOTE RS.BRK==000400,, ;SPECIAL ACTION NEEDED ON INPUT RS.SCO==000200,, ;SINGLE-CHARACTER OBJECT RS.WSP==000100,, ;WHITE SPACE - SPACE, TAB, COMMA, CR RS.LP ==000040,, ;LEFT PARENTHESIS RS.DOT==000020,, ;DOTTED-PAIR DOT RS.RP ==000010,, ;RIGHT PARENTHESIS RS.MAC==000004,, ;MACRO-CHARACTER (RS.ALT = SPLICING) RS.SLS==000002,, ;SLASHIFIER RS.RBO==000001,, ;RUBOUT, FORCEFEED RS.SL1==400000 ;SLASH IF FIRST IN PNAME RS.PNT==200000 ;DECIMAL POINT (FOR NUMBERS) RS.SL9==100000 ;SLASH IF NOT FIRST IN PNAME RS.ALT==040000 ;CHANGE MEANING OF OTHER BITS RS.ARR==020000 ;NUMBER MODIFIERS _ AND ^ RS.SGN==010000 ;NUMBERS SIGNS + AND - RS.DIG==004000 ;DIGITS 0 THROUGH 9 RS.XLT==002000 ;EXTENDED LETTERS (LIKE :) RS.LTR==001000 ;REGULAR LETTERS (LIKE X) IRP A,,[FF,VMO,SQX,BRK,SCO,WSP,LP,DOT,RP,MAC,SLS,RBO] RS%!A==_22 TERMIN NWTNE==:TRNE NWTNN==:TRNN DEFINE NWTN ZP,AC,SX TDN!ZP AC,[RS.!SX] TERMIN ] ;END IFN NEWRD IFE NEWRD,[ ;;;DEFINE READER-STYNTAX BITS RS.FF==0 RS.VMO==0 RS.SQX==0 RS.BRK==400000 RS.SCO==200000 RS.WSP==100000 RS.LP==40000 RS.DOT==20000 RS.RP==10000 RS.MAC==4000 RS.SLS==2000 RS.RBO==1000 RS.SL1==400 RS.PNT==200 RS.SL9==100 RS.ALT==40 RS.ARR==20 RS.SGN==10 RS.DIG==4 RS.XLT==2 RS.LTR==1 IRP A,,[FF,VMO,SQX,BRK,SCO,WSP,LP,DOT,RP,MAC,SLS,RBO] RS%!A==RS.!A TERMIN NWTNE==:TLNE NWTNN==:TLNN DEFINE NWTN ZP,AC,SX TLN!ZP AC,RS.!SX TERMIN ] ;END OF IFE NEWRD RS.CMS==RS. ;CHARACTER-MACRO SYNTAX RS.SCS==RS. ;SINGLE-CHAR-OBJ SYNTAX ;SYNTAX FOR CHARS THAT BEGIN OBJECTS RS.OBB==RS. RS.WTH==RS. ;PRETTY MUCH, ANY WORTHY CHAR RS.SEE==RS. ;ALMOST ANY CHAR THAT YOU REALLY SEE SUBTTL READCH AND ASCII FUNCTIONS, $READCH: JSP D,INCALL Q$READCH RDCH$: READCH: PUSHJ P,TYI RDCH3: MOVE TT,A JRST RDCH2 $ASCII: JSP T,FXNV1 RDCH2: CAIN TT,203 ;RARE CASE WHEN READCH IS CALLED FROM WITHIN JRST READCH ; A READLIST - MAY SEE A PSEUDO-SPACE. SA$ CAIN TT,315 ;NORMALIZE CR FOR SAIL SA$ MOVEI TT,15 ANDI TT,177 MOVE B,TT MOVE D,VOBARRAY ADDI TT,OBTSIZ+1 ROT TT,-1 JUMPL TT,.+3 HLRZ A,@1(D) JRST .+2 HRRZ A,@1(D) JUMPN A,CPOPJ MOVEI T,1 MOVEI TT,RDCHO RDCH4: PUSH P,T PUSH FXP,PNBUF-1(T) SOJG T,.-1 PUSH FXP,LPNF PUSHJ P,(TT) POP FXP,LPNF POP P,T MOVNS T HRLZS T POP FXP,PNBUF(T) AOBJN T,.-1 POPJ P, SUBTTL NEWIO INPUT FUNCTION ARGS PROCESSOR ;;; JSP D,INCALL ;;; Q ;;; PROCESSES ARGUMENTS FOR AN INPUT FUNCTION TAKING STANDARD ;;; ARGUMENTS (EOF VALUE AND/OR FILE ARRAY). SAVES F. ;;; JSP D,XINCALL ;;; Q ;;; IS SIMILAR, BUT INSISTS ON A FIXNUM RESULT (FOR TYI, TYIPEEK), ;;; AND EXPECTS F TO CONTAIN EITHER "FIX1" OR "CPOPJ". ;;; SAVES AR2A (SEE TYIPEEK). XINCALL: JUMPN T,XINCA1 PUSH P,F SFA% JRST 1(D) IFN SFA,[ INCAST: PUSHJ P,SINFGET ;GETS VINFILE IN AR1, STANDARDIZED FOR "T" HRLZI T,AS.SFA ;CHECK FOR AN SFA TDNN T,ASAR(AR1) ;FOUND AN SFA? JRST 1(D) ;NOPE, RETURN RIGHT AWAY HLRZ TT,(D) ;GET POINTER TO OP BIT MOVE T,(TT) ;GET THE ACTUAL BIT MOVEI TT,SR.WOM ;CHECK AGAINST KNOWN THINGS TDNN T,@TTSAR(AR1) ;CAN IT DO THIS SPECIFIC OPERATION? JRST 1(D) ;NO, RETURN AS NORMAL INCSEO: TLNE T,SO.TIP ;FOO! TYIPEEK IS DIFFERENT! TDZA C,C ; BUT IF NOT TYIPEEK THEN USE MOVEI C,INCSEO ; NEW EOF VALUE, SOMETHING UNIQUE PUSH FXP,D ;MAY NEED TO RETURN IF OVER-RUBOUT PUSH P,AR1 ;REMEMBER THE SFA PUSHJ P,ISTCAL ;YES, PROCESS IT POP FXP,D POP P,AR1 CAIE A,INCSEO ;DID THE SFA RETURN EOF? JRST .+3 PUSHJ P,EOF ;HANDLE EOF JRST INCAST ;IF RETURN THEN PROCEED AROUND AGAIN MOVE TT,(A) POPJ P, ;NO, RETURN ] ;END IFN SFA XINCA1: TLOA D,1 ;MUST HAVE FIXNUM RESULT INCALL: SFA$ JUMPE T,INCAST ;ZERO ARGS SFA% JUMPE T,1(D) AOJL T,INCAL2 SETZ AR1, EXCH AR1,(P) ;DEFAULT NIL FOR EOF VALUE INCAL4: JUMPE AR1,EOFBN0 ;NOT IF NIL JSP TT,XFOSP ;FILE OR SFA? JRST EOFBN0 ;NOT IF T, OR IF NOT FILE IFN SFA,[ JRST INCAL5 INCST2: HLRZ TT,(D) ;GET POINTER TO OP BIT MOVE T,(TT) ;GET THE ACTUAL BIT MOVEI TT,SR.WOM ;CHECK AGAINST KNOWN THINGS TDNN T,@TTSAR(AR1) ;CAN IT DO THIS SPECIFIC OPERATION? JRST INCALZ ;NO, HANDLE NORMALLY: LOWER LEVEL WILL TRAP POP P,C ;GET EOF VALUE TLNN D,1 ;EXPECTING A FIXNUM RESULT? JRST ISTCAL ;NOPE, CALL THE STREAM AND GO ON PUSH P,C ;REMEMBER EOF VALUE AGAIN INCST3: TLNE T,SO.TIP ;FOO! TYIPEEK IS DIFFERENT! TDZA C,C ; BUT IF NOT TYIPEEK THEN USE MOVEI C,INCST3 ; NEW EOF VALUE, SOMETHING UNIQUE PUSHJ P,ISTCAL ;CALL THE SFA POP P,C ;RESTORE EOF VALUE CAIN A,INCST3 ;DID THE SFA RETURN EOF? JRST INCST4 ;YES, HANDLE IT JSP T,FXNV1 ;ELSE THE VALUE RETURNED MUST BE A FIXNUM POPJ P, INCST4: SKIPN A,C ;FOR A NULL EOF VALUE, SNEAKILY MOVEI A,IN0-1 ; SLIP IN -1 JSP T,FXNV1 ;ELSE WHAT WAS PROVIDED POPJ P, ; MUST BE A FIXNUM ] ;END IFN SFA INCAL5: MOVE A,TTSAR(AR1) ;GET ARRAY TYPE BITS TLNN A,TTS ;MUST BE INPUT JRST INCAL1 EXCH A,AR1 PUSHJ P,[IOL [NOT AN INPUT FILESPEC!]] EXCH A,AR1 JRST INCAL4 INCAL1: TLNN A,TTS ;IF TTY ALLOW BINARY MODE TLNN A,TTS ;MUST NOT BE BINARY FILE JRST INCALZ EXCH A,AR1 PUSHJ P,[IOL [NOT ASCII FILE!]] EXCH A,AR1 JRST INCAL4 INCALZ: POP P,A ;RESTORE EOF VALUE INBIND: SKIPE B,AR1 JRST INBN4 PUSHJ P,INFGET ;GETS VINFILE IN AR1 MOVEI B,(AR1) INBN4: CAIN B,TRUTH TDZA C,C SKIPA C,[TRUTH] HRRZ AR1,V%TYI ; PUSHJ P,ATIFOK ; UNLOCKI MOVSI T,-LINBN9 ;OPEN-CODING OF SPECBIND MOVEM SP,SPSV INBN1: HRRZ TT,INBN9(T) HRRZ R,(TT) HRLI R,(TT) PUSH SP,R HLRZ R,INBN9(T) TRNN R,777760 HRRZ R,(R) MOVEM R,(TT) AOBJN T,INBN1 JSP T,SPECX ;END OF SPECBIND PUSH P,CUNBIND JRST EOFBIND INBN9: C,,TAPRED ;TABLE OF VALUE CELLS FOR INBIND B,,VINFILE ; EACH ENTRY IS OF FORM: NIL,,VINSTACK ; ,, $DEVICE,,TYIMAN ; IF NEW VALUE IS AN AC, THEN IUNTYI,,UNTYIMAN ; THE AC CONTAINS THE REAL ;; UNRD,,UNREADMAN ; NEW VALUE. ;; READP,,READPMAN LINBN9==.-INBN9 INCAL2: AOJL T,INCAL7 POP P,A ;TWO ARGS POP P,AR1 JUMPE AR1,INBIND CAIN AR1,TRUTH JRST INBIND PUSH P,A ;SAVE EOF VALUE JSP TT,XFOSP SFA% SKIPA SFA% JRST INCAL5 IFN SFA,[ JRST INCST1 JRST INCAL5 JRST INCST2 INCST1: ] ;END IFN SFA EXCH A,AR1 ;OTHER MUST BE FILE ARRAY MOVEM A,(P) ;STORE NEW EOF VALUE JRST INCAL4 ;MAKE SURE OTHER IS CORRECT INCAL7: HRRZ D,(D) ;MORE THAN TWO ARGS: FOOEY. JRST S2WNAL EOFBN0: POPI P,1 ;GET EOF VALUE OFF STACK MOVEI A,(AR1) EOFBIND: TLNN D,1 ;BIND FOR INPUT EOF TRAP JRST EOFBN3 PUSH P,F ;FOR NUMERICAL INPUT FN, FIX1 OR CPOPJ TLO A,400000 EOFBN3: PUSH P,A PUSH P,CEOFBN5 JSP T,ERSTP ;SET UP A FRAME MOVEM P,EOFRTN ;THIS IS AN EOF FRAME SETZM BFPRDP .SEE EOF2 SFA% PUSHJ P,1(D) ;RUN CALLING FUNCTION SFA$ MOVEI C,(A) ;THIS IS THE EOF VALUE FOR SFAS SFA$ PUSHJ P,INCAST ;HANDLE AN SFA, ELSE RUN THE CALLER MOVSI D,-LEP1+1(P) ;RESTORE FRAME STUFF HRRI D,ERRTN BLT D,ERRTN+LEP1-1 SUB P,[LERSTP+2,,LERSTP+2] ;FLUSH FRAME POPJ P, ;RETURN (RESULT IN A OR TT) EOFBN5: POP P,A ;COME HERE ON EOF TLZN A,400000 CEOFBN5: POPJ P,EOFBN5 SKIPN A ;FOR A NULL EOF VALUE, SNEAKILY SKIPA TT,XC-1 ; SLIP IN A -1 INSTEAD JSP T,FXNV1 ;ELSE WHAT WAS PROVIDED POPJ P, ; MUST BE A FIXNUM SUBTTL NEWIO END-OF-FILE HANDLING ;;; HANDLE EOF ON STANDARD FILE ARRAY IN AR1. EOF: PUSHJ FXP,SAV5 HRRZ T,BFPRDP ;CHECK WHETHER IN READ JUMPN T,EOFER EOF2: SFA$ MOVSI TT,AS.SFA SFA$ TDNE TT,ASAR(AR1) ;DID AN SFA GET EOF? SFA$ JRST EOFZ ;YES, NEVER ANY EOFFN MOVEI TT,FI.EOF HRRZ B,@TTSAR(AR1) JUMPE B,EOF5 EXCH B,AR1 SKIPE A,EOFRTN HRRZ A,-LERSTP-1(A) .SEE EOFBIND EXCH A,B CALLF 2,(AR1) JUMPN A,EOF4 EOF8: SKIPE TAPRED ;READING FROM INFILE? PUSHJ P,INPOP ;YES, POP THE INPUT STACK PUSHJ P,EOF7 EOF1: JSP R,PDLA2-5 POPJ P, EOF7: HRRZ A,-2(P) ;SAVED AR1 MOVE TT,TTSAR(A) TLNN TT,TTS ;DON'T CLOSE TTY INPUT, PUSHJ P,ICLOSE ; FOR THAT WAS MERELY OVER-RUBOUT POPJ P, EOF4: CAIN A,TRUTH JRST EOF1 SKIPN T,EOFRTN JRST EOF8 HRRM A,-LERSTP-1(T) .SEE EOFBIND EOF9: MOVE P,EOFRTN .SEE TYPK9 JRST ERR1 EOF5: PUSHJ P,EOF7 EOFZ: SKIPE TAPRED ;NO EOF FUNCTION. READING FROM INFILE? PUSHJ P,INPOP ;YES, POP THE STACK SKIPN EOFRTN JRST EOF1 JRST EOF9 SUBTTL NEWIO INPUSH FUNCTION ;;; HAIRY INPUSH FUNCTION. PUSHES FILE ONTO INSTACK, ;;; OR MAYBE PUSHES INFILE, OR MAYBE POPS. ;;; INPOP POPS INSTACK INTO INFILE ONCE. INPUSH: CAIN A,TRUTH ;SUBR 1 HRRZ A,V%TYI IFN SFA,[ JSP TT,AFOSP ;DO WE HAVE AN SFA? JRST INPU2 ;Nope, nothing JRST INPU1A ;Ah, a file. MOVEI T,SO.TYI+SO.RED+SO.RDL TDNN T,@TTSAR(AR1) ;Can this SFA do any of these operations? JRST INFLZE ; NO? then can't put it into INFILE JRST INPU1B INPU1A:] ;END OF IFN SFA IFE SFA,[ JSP TT,AFILEP JRST INPU2 ] ;END OF IFN SFA PUSHJ P,ATIFOK UNLOCKI INPU1B: EXCH A,VINFILE HRRZ B,VINSTACK PUSHJ P,CONS MOVEM B,VINSTACK INPU1: SKIPN A,VINFILE JRST INFLZE CAIN A,TRUTH SETZM TAPRED POPJ P, INFLZE: PUSHJ P,INFLUZ JRST INPU1 INPU2: SKOTT A,FX JRST INFLZE SKIPN TT,(A) JRST INPU1 JUMPL TT,INPU5 INPU3: HRRZ A,VINFILE ;AN INPUSH LOOP HRRZ B,VINSTACK PUSHJ P,CONS MOVEM A,VINSTACK SOJG TT,INPU3 JRST INPU1 INPOP: MOVNI TT,1 PUSH P,A ;MUST SAVE A (E.G., SEE LOAD) PUSH P,CPOPAJ INPU5: PUSH FXP,TT INPU6: SKIPN A,VINSTACK JRST INPU8 HLRZ AR1,(A) ; PUSHJ P,ATIFOK ; UNLOCKI HLRZ AR1,(A) MOVEM AR1,VINFILE HRRZ A,(A) MOVEM A,VINSTACK AOSGE (FXP) JRST INPU6 INPU7: SUB FXP,R70+1 JRST INPU1 INPU8: MOVEI A,TRUTH MOVEM A,VINFILE JRST INPU7 SUBTTL TYI FUNCTION AND RELATED ROUTINES TYI$: SKIPA F,CFIX1 ;SUBR (NIL . 0) NCALLABLE, FOR *TYI FUNCTION MOVEI F,CPOPJ PUSH P,F JRST TYI %TYI: SKIPA F,CFIX1 ;LSUBR (0 . 2) NCALLABLE, FOR TYI FUNCTION MOVEI F,CPOPJ JSP D,XINCALL SFA% Q%TYI SFA$ [SO.TYI,,],,Q%TYI TYI: MOVEI A,Q%TYI PUSH FXP,BFPRDP HRLZM A,BFPRDP PUSHJ P,@TYIMAN POP FXP,BFPRDP MOVEI A,(TT) ;BARF POPJ P, PTYI: PUSH P,CFIX1 ; +TYI: SUBR 1 (NCALLABLE) CAIN A,TRUTH MOVE A,V%TYI ;IF T, THEN MAKE IT TYI SKIPE V.RSET JRST PTYI2 MOVEI AR1,(A) PTYI1: IFN SFA,[ MOVSI T,AS.SFA ;CHECK IF AN SFA (SFA BIT SET IN ASAR?) TDNE T,ASAR(A) ; GO DO FAST SFACALL IF SO JRST PTYI3 ] ;END OF IFN SFA MOVEI D,2 ;SIGNAL TO $DEVICE TO JUST RETURN -1 ON EOF MOVEI R,Q%TYI ;THIS IS TO BE A "TYI-LIKE" OPERATION JRST .$DEV PTYI2: MOVEI AR1,(A) IFN SFA,[ JSP TT,XFOSP ;CHECK FOR AN SFA JFCL SKIPA ;NOPE JRST PTYI3 ;YUP, SO CALL IT ] ;END IFN SFA PUSHJ P,ATIFOK UNLOCKI JRST PTYI1 IFN SFA,[ PTYI3: MOVEI C,NIL ;DO FAST INTERNAL SFA CALL WITH MOVSI T,SO.TYI ;TYI OPERATION PUSHJ P,ISTCAL JSP T,FXNV1 ;BE SURE IT RETURNS A FIXNUM VALUE POPJ P, ] ;END IFN SFA ;;; MAIN UNTYI ROUTINE ;;; ACCEPTS CHARACTER IN A AND INPUT FILE IN B ;;; STICKS CHARACTER BACK INTO CHARACTER BUFFER. ;;; CLOBBERS A,B,AR1,T,TT,D. MUST SAVE C (SEE READ). ;; UNDO THE FORMER TYI OPERATION. -- user interface. UNTYI: CAIN B,TRUTH MOVE B,V%TYI ;IF T, THEN MAKE IT TYI MOVEI AR1,(B) SKIPN V.RSET JRST UNTYI2 JSP TT,XFOSP JFCL ;FOR RANDOM OBJS, AND FOR FILE ARRAYS, PUSHJ P,[ PUSHJ P,ATIFOK ; CHECK FOR ASCII INPUT FILE JRST INTREL ] UNTYI2: JSP T,FXNV1 MOVE A,TT ;GET ACTUAL FIXNUM VALUE INTO A PUSHJ P,UNTYI1 JRST TRUE IUNTYI: PUSHJ P,SINFGET ;INTERNAL UNTYI'ER -- GETS VINFILE IN AR1 UNTYI1: IFN SFA,[ MOVSI TT,AS.SFA ;HANDLE DIFFERENTLY IF AN SFA TDNE TT,ASAR(AR1) ;SKIP IF NOT AN SFA JRST SUNTYI ;SFA UNTYI ] ;END IFN SFA MOVEI D,300000(A) ;USE 200000 BIT (IN CASE OF ^@) MOVEI TT,FI.BBC ;THE 100000 BIT IS A CROCK FOR PRATT ;THAT MEANS DO NOT PUT CHAR OUT ON ECHOFILES HLRZ T,@TTSAR(AR1) ;GET SINGLE BUFFERED CHAR JUMPE T,UNTYI3 ;THERE IS NONE - THIS IS EASY HRRZ B,@TTSAR(AR1) ;FOOEY - WE MUST CONS THE MOVEI TT,-200000(T) ; OLD BUFFERED BACK CHAR JSP T,FXCONS ; INTO THE LIST TO LEAVE ROOM PUSHJ P,CONS ; FOR THE NEW ONE MOVEI TT,FI.BBC HRRZM A,@TTSAR(AR1) UNTYI3: HRLM D,@TTSAR(AR1) ;BUFFER BACK NEW CHAR POPJ P, IFN SFA,[ SUNTYI: PUSH P,C ;CANNOT BASH C MOVEI TT,(A) ;CHARACTER INTO TT JSP T,FXCONS ;GENERATE A LISP FIXNUM (really won't "cons") MOVSI T,SO.UNT ;UNTYI OPERATION MOVEI C,(A) ;ARGUMENT INTO C (CHARACTER TO UNTYI) PUSHJ P,ISTCAL ;GO TO THE SFA CALLER POP P,C POPJ P, ] ;END IFN SFA ;;; MAIN INPUT FILE ARRAY HANDLER ;;; FILE ARRAY IN VINFILE. ;;; SAVES A,B,C,AR2A; CLOBBERS AR1. ;;; RETURNS CHARACTER IN TT. ;;; ACCUMULATOR D IS ZERO FOR PEEKING, 1 FOR NORMAL INPUT, AND 2 FOR ;;; INPUT WHICH MERELY RETURNS -1 AT EOF. $PEEK: TDZA D,D $DEVICE: MOVEI D,1 $DEV$: PUSHJ P,SINFGET ;GETS VINFILE IN AR1 IFN SFA,[ MOVSI T,AS.SFA ;BREAK AWAY HERE IF SFA TDNE T,ASAR(AR1) ;SFA? JRST $DEVSFA ;NOPE, CONTINUE AS USUAL ] ;END OF IFN SFA MOVSI T,TTS TDNE T,TTSAR(AR1) JRST $DVLUZ ;INPUT (FILE) CLOSED LOSSAGE! $DEV0: HLRZ R,BFPRDP .$DEV: .SEE .TYI LOCKI ;ALREADY HAVE MOST ACS SETUP WITH INFO MOVE T,TTSAR(AR1) ; SUCH AS FILE-ARRAY IN AR1, "TYPE" IN R SKIPN TT,FI.BBC(T) JRST $DEV2 ;ANY "BUFFERED-BACK" CHARS? JUMPE R,$DEV1 TLNN T,TTS ;IF THIS FILE-ARRAY ISN'T A TTY, THEN WE CAN JRST $DEV1 ; JUST TAKE THE BUFFERED BACK CHAR CAIE R,Q%TYI ;FOR "READ" OR "READLINE" REQUESTS, WE MAY WANT JRST $DEV2A ; TO RUN THE TTYBUF FUNCTION. $DEV1: TLZN TT,200000 JRST $DEV1A HLRZ TT,TT SKIPE D HRRZS FI.BBC(T) JRST $DEV1B $DEV1A: MOVS TT,(TT) ;THERE IS A BUFFER-BACK LIST SKIPE D HLRZM TT,FI.BBC(T) ;"CDR" IT IF NOT MERELY PEEKING MOVE TT,(TT) ;AND TAKE TOP CHAR $DEV1B: TRZN TT,100000 ;100000 MEANS DON'T OUTPUT TO ECHOFILES JRST $DEVECO UNLKPOPJ .SEE UNTYI ;;; NO CHARS BUFFERED BACK, SO DISPATCH ON FILE TYPE $DEV2: TLNN T,TTS ;IF THIS ISN'T A TTY, JRST $DEV4 ; THEN FORGET CLEVER HACKS CAIN R,Q%TYI ;IF THIS IS "TYI", THEN JRST $DEVAH ; PULL CLEVER ACTIVATION HACK $DEV2A: MOVE F,F.MODE(T) JUMPE R,$DEV4 ;NIL MEANS NO CLEVERNESS AT ALL HRRZ R,TI.BFN(T) JUMPN R,$DEVPS TLNN F,FBT ;NO PRE-SCAN FUNCTION IN FILE JRST $DEV4 UNLOCKI ;CANT "PRESCAN" FROM TTY WITH 12.-BIT CHARS PUSHJ P,INFLUZ JRST $DEV$ ;;; MOBY WINNING PRESCAN READER FOR TTYs $DEVPS: IFN D20,[ SKIPN TENEXP ;No RDTTY on TENEX, and SIN doesn't do rubouts TLNN F,FBT SKIPA JRST $DEVLM ] ;END OF INF D20 HRLM D,(P) ;INVOKE THE PRE-SCAN FUNCTION PUSHJ FXP,SAV5 ;FIRST, SAVE THE WORLD THEN CALL THE SCANNER MOVEI AR2A,(R) ;FUNCTION WITH 3 ARGUMENTS: MOVEI A,(AR1) ; (1) THE FILE ARRAY HLRZ B,BFPRDP ; (2) THE FUNCTION TO BUFFER FOR LDB T,[002100,,BFPRDP] ; (3) IF (2) IS 'READ, THE UNLOCKI PUSH FXP,T ; NUMBER OF HANGING OPEN MOVEI C,(FXP) ; PARENTHESES PUSH FXP,BFPRDP PUSH FXP,LPNF CALLF 3,(AR2A) POP FXP,LPNF POP FXP,BFPRDP HRRZS BFPRDP SUB FXP,R70+1 HRRZ AR1,-1(P) JUMPE A,$DVEF0 ;NIL MEANS OVER-RUBOUT, ERGO EOF MOVEI C,(A) SKIPE V.RSET CAIN R,QTTYBUF ;DON'T NEED TO CHECK RESULT IF JRST $DVPS1 ; IT WAS OUR OLD FRIEND TTYBUF MOVEI B,(C) HLRZ A,(B) ;LOOP TO VERIFY THAT RESULTS FROM TTY JSP F,TYOARG ; PRESCAN ARE INDEED ASCII VALUES HRRZ B,(B) JUMPN B,.-3 $DVPS1: LOCKI $DVPS0: HRRZ AR1,-1(P) MOVE T,TTSAR(AR1) EXCH C,FI.BBC(T) ;SO ADD LIST OF CHARS TO BUFFER-BACK JUMPN C,$DVPS2 ; OOPS, SOME "SNEAKED" IN $DVPSX: JSP R,PDLA2-5 HLRZ D,(P) UNLOCKI JRST $DEV$ ;AND TRY AGAIN! $DVPS2: TLZE C,200000 JRST $DVPS3 MOVE A,FI.BBC(T) MOVEI B,(C) ;BUFFER-BACK LIST "SNEAKED" UP IN THE MEANTIME PUSHJ P,.NCONC ; JUST TACK IT ON END (SINCE IT WAS "LATER") JRST $DVPSX $DVPS3: LDB TT,[221400,,C] ;BUFFER-BACK CHAR "SNEAKED" UP IN THE MEANTIME MOVEI C,0 EXCH C,FI.BBC(T) ;LIST FROM TTYSCAN PLACED IN C UNLOCKI ;FOO! PERMIT CONSING. FOO! FOO! FOO! JSP T,FXCONS MOVE B,C PUSHJ P,CONS MOVE C,A JRST $DVPS1 ;;; LINEMODE FOR TTYs IFN D20,[ $DEVLM: SKIPE TT,FI.BBC(T) ;It may happen, for re-entrant READs, that JRST $DEV1 ; there is dispatch to "Pre-Scan", even though HRLM D,(P) ; there are already chars in the buffer. POP FXP,TT ;POP THE LOCKI WORD PUSHJ FXP,SAV5 PUSHN FXP,80. ;;; THIS IS SUBOPTIMAL BEHAVIOR -- SEE ABOVE ;; SKIPE TENEXP ;; JRST $DVLMX MOVEI 1,-80.+1(FXP) HRLI 1,440700 MOVE 2,[RD%RND+RD%BEL 400.] SETZ 3, MOVE R,1 ;SAVE BP IN R HRROM TT,INHIBIT ;make up .5LOCKI RDTTY ERJMP IIOERR HRREI F,-400.(2) $DVLMQ: JUMPN F,$DVLM0 POPI FXP,80. PUSH FXP,TT ;RESTORE LOCKI WORD JRST $DVPSX ;EXIT AND TRY AGAIN IF NOTHING INPUT $DVLM0: PUSH FXP,TT ;RESTORE LOCKI WORD UNLOCKI ;UNLOCK TO PERMIT CONSING MOVEI B,NIL $DVLM1: ILDB TT,R ;;; SEE ABOVE -- SIN LOSSAGE, WILL NEVER GET HERE ON TENEX ;; SKIPN TENEXP ;IF NOT TENEX ;; CAIE TT,37 ;OR NOT ;; SKIPA ;THEN LEAVE AS IS ;; MOVEI TT,15 ;ELSE CONVERT TO ^M JSP T,FXCONS PUSHJ P,CONS MOVE B,A AOJL F,$DVLM1 POPI FXP,80. PUSHJ P,NREVERSE ;CONS UP THE LIST MOVE C,A JRST $DVPS1 ; AND JOIN "PRESCANNER" CODE ;;$DVLMX: ;; MOVEI 2,-80.+1(FXP) ;; HRLI 2,440700 ;; MOVEI 3,400. ;; MOVEI 4,37 ;; MOVEI 1,-1 ;; HRROM TT,INHIBIT ;; MOVE R,2 ;; SIN ;; ERJMP IIOERR ;; HRREI F,-400.(3) ;; MOVE 1,2 ;; HRR 2,3 ;; JRST $DVLMQ ] ;END OF IFN D20 î ;;; UNIT INPUT ON REAL DEVICE - INCLUDING "TTY" IN CASE OF CALL TO TYI FUNCT $DEV4: SKIPL F,F.MODE(T) .SEE FBT.CM JRST $DEV5 HRRO TT,(FXP) ;This had better get the saved INHIBIT .SEE $DEV0 MOVEM TT, INHIBIT ;TURN THE LOCKI INTO A .5LOCKI IFN ITS,[ MOVE R,F.CHAN(T) LSH R,27 IOR R,[.IOT 0,TT] SPECPRO INTTYX TYIXCT: XCT R ;INPUT CHARACTER NOPRO $DEV4B: JUMPL TT,$DEVEF ;JUMP ON EOF AOS F.FPOS(T) ;OTHERWISE INCREMENT FILE POSITION (OK EVEN IF F.FLEN NEG) JRST $DEV6 ] ;END OF IFN ITS IFN D20,[ $DEV4C: PUSHJ FXP,SAV3 HRRZ 1,F.JFN(T) SPECPRO INTTYX TYIXCT: BIN ;INPUT CHARACTER ERJMP $DEV4T NOPRO MOVE TT,2 PUSHJ FXP,RST3 AOS F.FPOS(T) ;OTHERWISE INCREMENT FILE POSITION (OK EVEN IF F.FLEN NEG) SKIPN TENEXP JRST $DEV6 TRNN F,10 ;SAIL DOES THIS TOO? TLNE F,FBT ;I DON'T UNDERSTAND THIS JRST $DEV6 CAIN TT,37 ;TENEX ^_ IS CR, BARF MOVEI TT,^M ;^_ -> CR JRST $DEV6 ] ;END OF IFN D20 IFN D10,[ SA$ $DEV4C: ;SAIL WANT'S LINMOD CHECK EVEN FOR TYI MOVE R,[INCHWL TT] TLNN F,FBT SA% $DEV4C: MOVE R,[INCHRW TT] SPECPRO INTTYX TYIXCT: XCT R NOPRO IFN SAIL,[ TRNE F,10 ;FORGET THIS HACK FOR IMAGE MODE JRST $DEV6 MOVEI R,(TT) ;CANONICALIZE ASCII CODES TLNE F,FBT ;I DON'T UNDERSTAND THIS JRST $DEVS4 ;BUT CONVERT IN NON-FULL MODE CAIN R,32 ;TILDE: 32 => 176 HRROI R,176 CAIN R,176 ;RIGHT BRACE: 176 => 175 HRROI R,175 CAIN R,175 ;ALTMODE: 175 => 33 HRROI R,33 CAIN R,33 ;NOT EQUALS: 33 => 32 HRROI R,32 $DEVS4: ANDI TT,600 IORI TT,(R) TLNE F,FBT ;IF FULL CHARACTER SET (BUCKY BITS), JRST $DEV4S ; DON'T DO ANY CONVERSIONS CAIN TT,33 ;ALTMODE? JRST $DEV4S ;YUP! SO LEAVE IT ALONE CAIGE TT,40 ;A CONTROL CHARACTER? ADDI TT,%TXCTL+"@ ;YES, CONVERT TO EXTENDED ASCII FORMAT $DEV4S: TRNN TT,%TXCTL+%TXMTA ;USE PRESENCE OF CONTROL BIT TO CHECK FOR INT JRST $DEV6 ; PUSH FXP,TT ;SAVE THE ACTUAL CHARACTER ; SUBI TT,%TXCTL+"@ ; CAIL TT,"a-"@ ;IS IT A LOWER CASE LETTER? ; CAILE TT,"z-"@ ; SKIPA ;NOPE, LEAVE ALONE ; SUBI TT,"a-"@-1 ;ELSE CONVERT TO REAL CONTROL CHARACTER ; SKIPL TT ; CAILE TT,"_ ;IS IT A REAL "CONTROL" CHARACTER? ; JRST $DEV4V ;NO, FIXUP THE WORLD AND PROCEED ] ;END OF IFN SAIL SA% CAIL TT,40 ;CONTROL CHARS CAUSE AN INTERRUPT WHEN READ SA% JRST $DEV6 $DEV4U: HRLM D,(P) MOVEI D,(TT) ;ONLY INTERRUPT IF INT FUNCTION EXISTS ROT D,-1 ;CLEVER ARRAY ACCESS AS PER TTYICH ADDI D,FB.BUF(T) PUSH FXP,R HLRZ R,(D) SKIPGE D HRRZ R,(D) JUMPE R,$DEV4Z MOVEI D,400000(TT) HRLI D,(AR1) ;THERE IS NO OBVIOUS NEED FOR THIS NOW PUSHJ P,UCHINT ;GIVE USER INTERRUPT FOR TTY INT CHAR $DEV4Z: POP FXP,R HLRZ D,(P) ; SA$ $DEV4V: POP FXP,TT ;RESTORE THE CONTROL CHARACTER JRST $DEV6 ] ;END OF IFN D10 IFN D20,[ $DEV4T: GTSTS TLNN 2,(GS%EOF) JRST IIOERR JRST $DEVEF ] ;END OF IFN D20 ;;; A TRICKY HACK TO BE CLEVER ABOUT IMMEDIATE ACTIVATION ;;; WHEN TYI (OR READCH, OR WHATEVER) IS INVOLVED. $DEVAH: SKIPL F,F.MODE(T) ;MUST BE THE TTY FOR THIS TO WORK JRST $DEV5 HRRO TT,(FXP) ;This had better get the saved INHIBIT .SEE $DEV0 MOVEM TT,INHIBIT ;TURN THE LOCKI INTO A .5LOCKI IT% JRST $DEV4C ;IGNORE LINE MODE, AND USE CHARACTER INPUT UUO IFN ITS,[ SPECPRO INTTYX TYICAL: .CALL $DEV4M ;GOBBLE CHAR, EVEN IF NOT ACTIVATED NOPRO .LOSE 1400 MOVE TT,TTSAR(AR1) SKIPN R,FT.CNS(TT) JRST $DVAH1 ;DONE IF NO ASSOCIATED OUTPUT TTY HRLM D,(P) MOVE TT,TTSAR(R) ;UPDATE CHARPOS AND LINENUM FROM CURSOR PUSH FXP,T PUSHJ FXP,CLRO4 ; POSITION OF ASSOCIATED OUTPUT TTY POP FXP,T HLRZ D,(P) MOVE TT,TTSAR(AR1) $DVAH1: EXCH T,TT JRST $DEV4B $DEV4M: SETZ SIXBIT \IOT\ ;I/O TRANSFER 5000,,%TIACT ;READ CHARACTER IMMEDIATELY EVEN IF NOT ACTIVATOR ,,F.CHAN(T) ;CHANNEL # 402000,,T ;SINGLE CHAR RETURNED HERE (T, NOT TT!) ] ;END OF IFN ITS ;;; CODE FOR FILE ARRAYS WITH A BUFFER $DEV5A: PUSHJ P,$DEVBUF ;GET A NEW BUFFER LOAD. WATCH OUT FOR EOF JRST $DEVEF $DEV5: ;BASIC GET-1-CHAR FROM BUFFERED FILE 10$ HRRZ TT,FB.HED(T) 10$ SOSGE 2(TT) 10% SOSGE FB.CNT(T) ;GOBBLE NEXT INPUT CHAR JRST $DEV5A ;MAY NEED TO GET NEW BUFFER 10$ ILDB TT,1(TT) 10% ILDB TT,FB.BP(T) 10$ TLNN T,TTS ;IN IMAGE MODE, WHAT YOU SEES IS WHAT YOU GETS 10$ JUMPE TT,$DEV5 ;IN ASCII MODE, A NULL IS LITTERA NON GRATA JRST $DEV6W ;;; READ IN A NEW BUFFERLOAD - SKIP RETURN ON SUCCESS, NO SKIP ON EOF ;;; EXPECTS ARRAY PTR IN AR1, TTSAR IN T - SAVES D AND F .SEE FPOS5 $DEV5K: ;LOSING SYMBOL FOR DSK:JLK;LISPT PATCH $DEVBUF: PUSH FXP,D MOVE D,FB.BVC(T) ADDM D,F.FPOS(T) ;UPDATE FILEPOS BY NUMBER OF VALID BYTES SETZM FB.BVC(T) IFN ITS,[ EXCH T,TT MOVE D,FB.BFL(TT) ;BYTE COUNT MOVE T,FB.IBP(TT) ;BYTE POINTER TYICA1: .CALL SIOT .LOSE 1400 EXCH T,TT SUB D,FB.BFL(T) ;NEGATIVE OF NUMBERS OF BYTES READ MOVNM D,FB.CNT(T) MOVNM D,FB.BVC(T) ] ;END OF IFN ITS IFN D20,[ PUSHJ FXP,SAV3 ;PRESERVE LOW THREE AC'S HRRZ 1,F.JFN(T) MOVE 2,FB.IBP(T) MOVN 3,FB.BFL(T) SIN ;READ A BUFFERFUL ADD 3,FB.BFL(T) MOVEM 3,FB.CNT(T) ;STORE COUNT OF BYTES READ IN FILE OBJECT MOVEM 3,FB.BVC(T) MOVE D,3 PUSHJ FXP,RST3 ] ;END OF IFN D20 IFN D10,[ MOVE TT,F.CHAN(T) LSH TT,27 IFE SAIL,[ TLNN T,TTS.BM JRST $DEV5R HRRZ TT,FB.HED(T) ;MAYBE BUFFER HAS BEEN RELOCATED? THEN FOR MOVSI D,(BF.IOU) ANDCAB D,@(TT) ;TURNS OFF BUFFER-IN-USE BIT AND ADVANCES BUFFER SKIPGE (D) ;BF.IOU MUST BE BIT 4.9 FOR THIS TO WORK JRST $DEV5S MOVSI TT,TTS.BM ANDCAM TT,TTSAR(AR1) ;TURN OFF "BUFFER-MOVED" BIT, BUT LEAVE BUF ADDR IN D MOVE TT,F.CHAN(T) LSH TT,27 HRR TT,D ] ;END OF IFE SAIL $DEV5R: TLO TT,(IN 0,) XCT TT ;READ A NEW BUFFERFUL JRST $DEV5M ;SUCCESS! SA% ANDCMI TT,-1 XOR TT,[#] XCT TT JRST IIOERR ;LOSEY,LOSEY IFN SAIL,[ MOVE D,FB.HED(T) MOVE D,2(D) MOVEM D,FB.BVC(T) JUMPG D,$DEV5M ] ;END OF IFN SAIL ] ;END OF IFN D10 IFN ITS+D20, JUMPN D,$DEV5M ;D HOLDS "NOT-EOF-P" POP FXP,D ;FALLS THRU TO HERE ON EOF CONDITION POPJ P, ; AND EXITS WITHOUT SKIPPING IFN D10*<1-SAIL>,[ $DEV5S: HRRZ TT,FB.HED(T) HRRZM D,(TT) ;STORE CURRENT BUFFER ADDR IN CONTROL BLOCK TLZ D,-1 ADD D,[0700,,1] TLNE T,TTS.BN TLC D,0700#4400 MOVEM D,1(TT) ;CONSTRUCT NEW BP FOR BUFFER MOVE D,(D) TLNN T,TTS.BN IMULI D,5 MOVEM D,2(TT) ;STORE NEW BYTE COUNT INITO BUFFERCONTROL-BLOCK ;FALL THRU TO $DEV5M ] ;END OF IFN D10*<1-SAIL> $DEV5M: ;MORE INPUT WAS OBTAINED BY BUFFERED INPUT IFN D10,[ MOVE D,FB.HED(T) MOVE D,2(D) ;NUMBER OF VALID BYTES MOVEM D,FB.BVC(T) ] ;END OF IFN D10 .ELSE,[ MOVE TT,FB.IBP(T) MOVEM TT,FB.BP(T) ;INITIALIZE BUFFER POINTER ] ;END OF .ELSE POP FXP,D JRST POPJ1 ;SKIP RETURN ON SUCCESS ;;; WRAP UP, WITH NEW CHAR IN TT. UPDATE "PAGENUM" AND "LINENUM", AND ECHO $DEV6: SETOM INHIBIT ;RECONVERT .5LOCKI TO LOCKI SKIPN F,FI.BBC(T) JRST $DEV6W HRLM D,(P) MOVE R,T PUSHJ FXP,SAV5 JSP T,FXCONS PUSHJ P,NCONS MOVE C,A JRST $DVPS0 $DEV6W: JUMPN D,$DEV6B MOVEI D,(TT) ANDI D,177+%TXCTL ;? THIS MAY SCREW CONTROL CHARS ON SAIL TRZN D,%TXCTL JRST $DEV6A CAIE D,177 TRZ D,140 $DEV6A: TRO D,200000 HRLM D,FI.BBC(T) SETZ D, $DEV6B: CAIN TT,^J AOS AT.LNN(T) CAIE TT,^L JRST $DEVECO SETZM AT.LNN(T) AOS AT.PGN(T) $DEVECO: SKIPE AR1,VECHOFILES ;SKIP UNLESS ECHO FILES SKIPN D ;DON'T ECHO PEEKED-AT CHARS UNLKPOPJ SA$ CAIN TT,203 SA$ UNLKPOPJ SA$ CAIE TT,%TXCTL+"M SA$ CAIN TT,%TXCTL+"m SA$ MOVEI TT,15 HRLI AR1,200000 ;LIST OF FILES, NO TTY HRLM TT,AR2A PUSH P,AR2A JSP T,GTRDTB ;GET READTABLE LDB TT,[220700,,(P)] ;WATCHIT! CHAR COULD BE 12. BITS UNLOCKI PUSHJ P,TYO6 ;PUSH CHAR INTO ALL ECHO FILES HLRZ TT,(P) POP P,AR2A POPJ P, $DEVEF: UNLOCKI ;COME HERE ON EOF $DVEF1: MOVNI TT,1 TRNN D,1 .SEE .TYI ;0 SAYS ONLY PEEKING, SO RETURN -1 POPJ P, ; 2 SAYS DON'T DO EOF, SO RETURN -1 PUSHJ P,EOF ;SIGNAL EOF JRST $DEVICE ;RETRY IF WE SURVIVE $DVEF0: JSP R,PDLA2-5 ;EOF AFTER TTYSCANNING JRST $DVEF1 ;;; LOSING CODE FOR "$DEVICE"ING A SFA IFN SFA,[ $DEVSFA: PUSHJ FXP,SAV5 PUSH FXP,D ;SAVE D OVER CALL SETZ C, ;NIL AS OP DEPENDENT ARGS JUMPE D,$DEVPE ;PEEKING, MIGHT HANDLE THE SFA DIFFERENTLY HRLZI T,SO.TYI ;WE ARE DOING A TYI $DEVP1: PUSHJ P,ISTCAL ;INTERNAL SFA CALL, SFA IN AR1 $DEVP2: PUSHJ FXP,RST5M1 POP FXP,D SKIPE A ;ALLOW NIL JSP T,FXNV1 ;INSURE FIXNUM AND GET INTO TT JUMPN A,POPAJ ;IF NON-NIL THEN GOT SOMETHING, SO RETURN IT MOVNI TT,1 JUMPE D,POPAJ ;ONLY PEEKING, SO MERELY RETURN -1 PUSHJ P,EOF ;SIGNAL EOF POP P,A JRST $DEVICE ;RETRY IF WE SURVIVE $DEVPE: MOVEI TT,SR.WOM ;CHECK THE WHICH-OPERATIONS MASK FOR TYIPEEK MOVSI T,SO.TIP TDNE T,@TTSAR(AR1) ;CAN IT DO IT? JRST $DEVP1 ;YES, DO IT DIRECTLY MOVSI T,SO.TYI ;ELSE DO IT AS TYI/UNTYI PUSHJ P,ISTCAL ;DO THE TYI JUMPE A,$DEVP2 ;HIT EOF PUSH P,A ;REMEMBER THE CHAR WE WERE HANDED MOVSI T,SO.UNT ;NOW UNTYI THE CHARACTER MOVEI C,(A) ;THE ARG IS THE CHARACTER MOVE AR1,-2(P) ;GET THE SFA AS FIRST ARG PUSHJ P,ISTCAL ;DO THE UNTYI POP P,A ;FUDGE THE CHARACTER AS THE RETURNED VALUE JRST $DEVP2 ] ;END IFN SFA INFGT0: PUSHJ P,INFLUZ INFGET: SKIPN AR1,VINFILE ;GET VINFILE IN AR1 JRST INFGT0 POPJ P, SINFGET: SKIPN AR1,VINFILE ;Standardizing INFile GETter PUSHJ P,INFGET ;GETS VINFILE IN AR1 SKIPE TAPRED CAIN AR1,TRUTH HRRZ AR1,V%TYI POPJ P, $DVLUZ: PUSH P,[$DEV$] INFLZZ: SKIPA T,[[SIXBIT \INFILE CLOSED!\]] INFLUZ: MOVEI T,[SIXBIT \BAD VALUE FOR INFILE!\] PUSH P,A MOVEI A,TRUTH ;INFILE IS A LOSER! EXCH A,VINFILE PUSH P,CPOPAJ %FAC (T) SUBTTL READLIST, IMPLODE, MAKNAM BYTEAC==TT MKNR6C: MOVEM T,MKNCH JSP TT,IRDA SKIPA MKR6DB: IDPB BYTEAC,C PUSHJ P,@MKNCH JRST RDAEND SOJGE D,MKR6DB PUSH FXP,BYTEAC PUSHJ FXP,RDA4 JSP TT,IRDA1 POP FXP,BYTEAC SOJA D,MKR6DB READLIST: JUMPE A,RDL12 MOVEI B,RDLTYI MOVEI C,RDLUNTYI JSP T,SPECBIND 0 A,RDLARG 0 B,TYIMAN 0 C,UNTYIMAN MOVEI A,RDIN MOVEI TT,READ0A MOVEI T,LPNBUF PUSHJ P,RDCH4 SKIPE T,RDLARG ;REALLY OUGHT TO ALLOW CAIN T,-1 ; A TRAILING SPACE JRST UNBIND LERR RDRM1 ;TOO MANY CHARS READ0A: PUSHJ P,REKRD ;READ AS IF "RE-ENTRANT", BUT TLNN T,4060 ; DON'T PERMIT TOP-LEVEL SPLICING MACROS JRST RMCER POPJ P, ;;; READLIST PEEK AND TYI ROUTINES. (CF. $DEVICE). ;;; SAVES A,B,C,AR2A; CLOBBERS AR1. RETURNS CHARACTER IN TT. RDLPEK: JRST RDLPK1 ;RDLTYI-1 IS FOR PEEKING (SEE TYIPEEK) RDLTYI: PUSH P,A SKIPN A,RDLARG JRST RDLTY2 CAIN A,-1 LERR RDRM3 ;TOO FEW CHARS HRRZ AR1,(A) MOVEM AR1,RDLARG RDLTY1: HLRZ A,(A) RDLTY3: JSP T,CHNV1 JRST POPAJ RDLTY9: SIXBIT \NOT ASCII CHAR!\ RDLTY2: HLLOS RDLARG MOVEI TT,203 ;PSEUDO-SPACE JRST POPAJ RDLPK1: SKIPE TT,RDLARG CAIN TT,-1 JRST M1TTPJ ;RETURN -1 FOR PEEKING AT "EOF" PUSH P,A HLRZ A,@RDLARG JRST RDLTY3 ;ELSE RETURN CHAR, BUT DON'T FLUSH RDLUNTYI: MOVEI TT,(A) JSP T,FXCONS HRRZ B,RDLARG PUSHJ P,CONS MOVEM A,RDLARG POPJ P, READ6C: PUSH FXP,A MOVEI T,R6C1 PUSHJ FXP,MKNR6C SUB FXP,R70+1 JRST RINTERN R6C1: ILDB TT,-1(FXP) JUMPE TT,CPOPJ ADDI TT,40 JRST POPJ1 SUBTTL READ FUNCTION ;;; ********** HIRSUTE READER ********** READ$: MOVEI T,0 ;FOR "*READ", WHICH IS "READ" WITH NO ARGS JRST READ OREAD: JSP D,INCALL SFA% QOREAD SFA$ [SO.RED,,],,QOREAD READ: MOVEI A,QOREAD ;ENABLE TTY PRE-SCAN HRLM A,BFPRDP MOVEI A,RDIN HRRZ T,BFPRDP JUMPN T,READ0 ;OOOOPS, A RE-ENTRANT CALL TO READ PUSHJ P,READ0B ;TOP-LEVEL READ HLLZS BFPRDP SKIPA B,RDBKC READ0: PUSHJ P,REKRD ;RE-ENTRANT READ TLC T,21000 ;LOSING SPLICING MACROS AT TOP LEVEL TLCN T,21000 JRST READST ;JUST GO AROUND AND TRY AGAIN READS0: TLNE B,100000 ;IF WE ENDED WITH A PSEUDO-SPACE TLNN B,40 ; (40-BIT SET IN SPACE SYNTAX), TLNN T,60 ; OR IF OBJECT WASN'T AN ATOM, POPJ P, ; THEN DO NOT BUFFER BACK A CHAR ;;; READS0: TLNN B,100000 ;IF WE ENDED WITH A "WHITE-SPACE" CHARACTER ;;; TLNN T,60 ; OR IF OBJECT WASN'T AN ATOM, ;;; POPJ P, ; THEN DO NOT BUFFER BACK A CHAR JSP R,RVRCT ;OTHERWISE MUST UNTYI A CHARACTER EXCH A,C PUSHJ P,@UNTYIMAN JRST CRETJ ;We got a splicing macro at top level. If it's NIL, we go around again ;Otherwise, we just CDR it. READST: JUMPE A,READ ;If we have NIL, we have nothing! PUSHJ P,RDSMCK ;Check for it being a legal frob w/ CDR null HLRZ A,(A) ;Take the CAR of it. JRST READS0 ;and finish up as if it were what we'd read ;;; ***** HERE IT IS FANS, THE BASIC READER ***** READ0B: HRRZM A,RDINCH ;READ-IN CHANNEL FILTER RD0B1: JSP T,RDIBGT JSP T,RSXST RD0B2A: BG$ SUBI TT,10. BG$ MOVEM TT,NRD10FL MOVSI T,3 ;TOP LEVEL, FIRST OF LIST FLAGS PUSHJ P,RDOBJ1 ;READ ONE OBJECT HRRZS A SETZB C,AR1 MOVEI AR2A,0 POPJ P, ;; PRE-FETCH VALUE OF IBASE, CHECK FOR CONSISTENCY, AND SAVE IN "RDIBS" RDIBGT: HRRZ TT,VIBASE IFN USELESS,[ CAIN TT,QROMAN JRST RD0BRM ] ;END OF IFN USELESS SKOTT TT,FX JRST IBSERR MOVE TT,@VIBASE JUMPLE TT,IBSERR CAIL TT,200 JRST IBSERR IFN USELESS, SETZM RDROMP MOVEM TT,RDIBS JRST (T) IFN USELESS,[ RD0BRM: MOVEI TT,10. SETOM RDROMP JRST (T) ] ;END OF IFN USELESS RVRCT: MOVE C,VREADTABLE MOVSI TT,-LRCT+2 CAME B,@TTSAR(C) AOBJN TT,.-1 JUMPGE TT,ER3 ;BLAST? - READ MOVEI C,(TT) JRST (R) REKRD: SOVE RDINCH RDIBS PUSHJ P,READ0B REKRD1: RSTR RDIBS RDINCH POPJ P, RDOBJ3: TLNE B,RS%WSP ;TAB,SPACE,COMMA JRST RDOBJ1 TLNN T,1 POPJ P, HRRZ TT,BFPRDP JUMPN TT,RMCER RDOBJ1: JSP TT,RDCHAR ;*** READ ONE OBJECT ROUTINE *** RDOBJ: NWTN N,B,OBB ;OBJECT BEGIN CHAR - NOT USAGE AT TYIPEEK JRST RDOBJ3 MOVEI TT,400000 IORM TT,BFPRDP TLNE B,RS%MAC JRST RDOBM2 ;MACRO CHAR. TLNE B,RS%SCO JRST RDCHO1 ;SINGLE CHAR OBJ. NWTNE B,RS. JRST RDALPH ;RDOBJ WILL EXIT WITH OBJECT READ TLNE B,RS%LP ;IN ACC A, AND RCT ENTRY OF BREAK JRST RDLST ;CHARACTER IN ACC B NWTNE B,RS.DIG JRST RDNUM NWTNE B,RS.SGN JRST RDOBJ6 ;+,- MOVE AR1,B JSP TT,RDCHAR ;DEFAULT IS . TLNN AR1,RS.PNT JRST RDOBJ0 ;WAS DOTTED PAIR POINT ONLY NWTNE B,RS.DIG ;IS NEXT CHAR A DIGIT? JRST RDOBJ5 ;IF SO, THEN MUST BE FLOATING NUM COMING UP TLNN AR1,RS%DOT JRST RDJ2A ;IF NOT DOTTED PAIR, THEN TRY ALPHABETIC RDOBJ0: TLNE AR1,RS%DOT ;*** DOT IS DOTTED-PAIR DOT *** TLNE T,1 JRST ER2 TLOE T,4 ;LOSE IF ALREADY IN DOTTED PAIR JRST ER2 TLNN T,200000 ;SO GET SECOND PART OF DOTTED PAIR JRST RDOBJ ; BUT IF HUNK, THEN DO SOME CHECKING FIRST PUSHJ P,RDSKWH POPJ P, ;ENCOUNTERED %RP, EXIT LOOKING LIKE SECOND TLZ T,4 ; PART OF DOT-PAIR TO SIGNAL HUNK ENDING JRST RDOBJ ;;;. WITH DECIMAL SYNTAX ONLY TURNS INTO SCO, IF FOLLOWED BY BREAK ;;;OR BEGINNING OF ALPHA IF FOLLOWED BY ALPHA RDJ2A: TLNN B,RS% NWTNN B,RS. JRST RDCHO4 JRST RDJ2A1 RDOBJ5: TLOA T,200 ;FOUND FLOATING NUM RDOBJ2: TLO T,10000 ;NUM FORCED WITH "+" RDJ2A1: JSP TT,IRDA IDPB AR1,C AOS D JRST RDNUM2 RDOBJ6: JSP TT,IRDA ;PROCESS OBJ BEGINNING WITH + OR - IDPB B,C SOS D NWTNE B,RS.ALT TLO T,400 ;- JSP TT,RDCHAR JRST @RDOBJ8 ;CHECK FOR WHITE'S + HAC, USING RD8W, OR DONT BOTHER, USING RD8N RDJ6A: TLNE B,RS% JRST RDOBJ4 NWTNN B,RS.PNT JRST ER1 MOVE AR1,B JSP TT,RDCHAR TLNE T,4 JRST ER1 JRST RDOBJ5 ;+.D DECIMAL FLOATING FORMAT RDOBJ7: NWTNE B,RS.DIG JRST RDNUM2 ;+ TLO T,20 ;+ OR + JRST RDA1 ER1: LERR RDRM2 RDOBJ4: TLO T,20 ;SINGLE CHARA "+" OR "-" JRST RDBK RD8W: NWTNE B,RS. JRST RDOBJ2 JRST RDJ6A RD8N: NWTNE B,RS. JRST RDOBJ7 JRST RDJ6A RDNUM: JSP TT,IRDA ;*** NUMBER ATOM *** RDNUM2: IFE BIGNUM, SETZM AR1 ;FLAG INDICATES HOW MANY DIGITS BEYOND OVERFLOW RDNM10: SETZB F,R ;BASE 10. NUMBER IN R, BASE IBASE IN F TLOA T,40 RDNUM1: JSP TT,RDCHAR NWTNE B,RS.PNT JRST RDNUM4 ;DECIMAL POINT [WITHOUT BREAK BIT SET] SOSLE D IDPB B,C NWTNE B,RS.DIG JRST RDNUM5 TLNE T,300 ;ALPHA CHAR SEEN JRST RDNUM8 NWTNN B,RS.LTR JRST RDNUM7 TLNN T,10000 JRST RDNUM6 NW% MOVEI TT,(B) ;GET CHTRAN NW$ HRRZ TT,B NW$ ANDI TT,177 CAIL TT,"a ;ALLOW FOR LOWER CASE LETTERS SUBI B,"a-"A SUBI B,"A-"0-10. ;LETTERS ARE SUPRA-DECIMAL: JRST RDNUM5 ; A=10., B=11., ..., Z=35. RDNUM8: NW% CAIE A,"E ;UPPER AND LOWER CASE E ALLOWED NW% CAIN A,"e ;MUST TIDY THIS UP SOMEDAY NW$ TLNE B,RS%SQX ;EXPONENT OR (SOMEDAY) STRING-QUOTE JRST RDNM8A NWTNN B,RS.XLT JRST ER1 RDNUM7: TLNE T,37000 ;EXTENDED ALPHA CHAR SEEN JRST ER1 NWTNN B,RS.ARR JRST RDNUM6 NWTNE B,RS.ALT TLOA T,2000 ;_ TLO T,1000 ;^ BG$ SKIPN NRD10FL ;IF WE ARE READING IN BASE 10., THEN BG$ TLO T,100 ; F HAS NOTHING IN IT - SO MUST TAKE R RDNUM9: TLNN T,140000 JRST RDNM9E TLNE T,300 ;FOR EXPONENT-IFIED BIGNUMS, RDNSV WILL HRR AR2A,AR1 ;BE MEANINGLESS HRLI AR2A,0 TLNE T,400 ;BIGNUM OF CORRECT BASE AND SIGN IS PUT IN AR2A TLO AR2A,-1 JRST RDNM9B RDNM9E: TLNE T,300 MOVE F,R TLNE T,400 MOVNS F MOVEM F,RDNSV RDNM9B: TLZ T,500 ;ZERO OUT SIGN AND DECIMAL BITS MOVEI D,BYTSWD*LPNBUF JSP TT,RDCHAR RDNM9C: NWTNN B,RS. JRST ER1 NWTNN B,RS.SGN JRST RDNM10 NWTNE B,RS.ALT ;SKIP IF + TLO T,400 JSP TT,RDCHAR JRST RDNM10 RDNUM0: IDPB B,C RDNUM6: TLZ T,340 ;TWAS REALLY AN ALPHA ATOM TLO T,20 JRST RDA3 RDNM8A: TLZ T,100 TLO T,1200 MOVEM D,RDDSV JRST RDNUM9 RDNMF: JRST 2,@[.+1] ;CLEAR OUT ALL ARITHMETIC OVERFLOW BITS MOVE B,T MOVE TT,F ;FINISHED WITH NUMBER READ, SO PICK UP NUMBER IN BASE IBASE BG$ SKIPN NRD10FL BG$ TLO T,100 TLNN T,300 JRST RDNM2 MOVE TT,R ;PICK UP NUMBER IN BASE 10. IFE BIGNUM,[ JUMPE AR1,RDNM2 ;NUMBER OF OVERFLOW DIGITS IN AR1 TLNN T,200 JRST RDNMER ADDM AR1,D ADDM AR1,RDDSV ] RDNM2: TLNE T,400 MOVNS TT ;NEGATIVE NUMBER, IF INDICATED BG$ TLNE T,140000 BG$ JRST RDBIGN RDNM2A: TLNE T,200 JRST RDFLNM RDFXNM: TLNE T,3000 JRST RDFXEX RDFX1: JSP T,FXCONS RDFL1: MOVE T,B JRST RDNMX RDNUM5: JFCL 8.,.+1 ;BASIC LOOP THAT INCREMENTALLY ADDS IN ONE DIGIT IFE BIGNUM, JUMPN AR1,RDNUMC IFN BIGNUM,[ TLNE T,40000 JRST RDBG10 ] RDNUMD: MOVE TT,R ;BASE 10. VALUE ACCUMULATES IN R IMULI R,10. ;BASE IBASE VALUE IN F NW% ADDI R,-"0(B) NW$ LDB A,[001100,,B] NW$ ADD R,A JFCL 8,RD10OV IFN BIGNUM,[ TLNE T,100000 ;BIGNUM VALUE BASE 10. HELD IN AR1 JRST RDBGIB ;BIGNUM VALUE BASE IBASE HELD IN AR2A RDNUMB: SKIPN NRD10FL JRST RDNUM1 ] IFE BIGNUM, RDNUMB: JFCL 8,.+1 ;MIGHT BE SET IF OVFL ON BASE 10. READIN, WENT TO RD10OV, DID A C1CONS, MOVE TT,F ;DID A GC, HACKED AROUND AND SET IT AGAIN! IMUL F,RDIBS NW% ADDI F,-"0(B) NW$ LDB A,[001100,,B] NW$ ADD F,A JFCL 8,RDIBOV JRST RDNUM1 IFE BIGNUM,[ RDIBOV: MOVE F,T MOVE T,TT ;OVERFLOW WHILE ACCUMULATING NUMBER MUL T,RDIBS ;IN BASE IBASE. TRY TO RECUPERATE LSH T+1,1 ;TO ALLOW, FOR EXAMPLE, 400000000000 LSHC T,35. NW% ADDI T,-"0(B) NW$ ADD T,A EXCH T,F JRST RDNUM1 RD10OV: MOVE R,TT RDNUMC: AOJA AR1,RDNUMB ] RDFXEX: IFN BIGNUM, CAIG A,77 TLNE T,600 JRST ER1 ANDI TT,777 EXCH TT,RDNSV TLNN T,2000 JRST .+3 LSH TT,@RDNSV JRST RDFX1 IFN BIGNUM,[ SKIPGE TT TLO T,400 MOVMS TT RX1: SOSGE RDNSV JRST RDFX2 TLNE T,100000 JRST RDEX3 ] IFE BIGNUM,[ RX1: SOSGE RDNSV JRST RDFX1 ] MUL TT,RDIBS IFN BIGNUM,JUMPN TT,RDEXOF LSH TT+1,1 LSHC TT,35. JRST RX1 IFN BIGNUM,[ RDFX2: TLNE T,100000 JRST RDBIGM TLNE T,400 MOVNS TT JRST RDFX1 ] RDFLNM: TLNN T,1000 JRST RDFL3 MOVE D,RDDSV ADD D,TT AOS D MOVE TT,RDNSV RDFL3: HRREI R,-BYTSWD*LPNBUF-1(D) IFN BIGNUM,[ TLZE T,140000 JRST RDFL3A ] IDIVI TT,400000 SKIPE TT TLC TT,254000 TLC TT+1,233000 SKIPE KA10P JRST .+7 PUSH FLP,TT+1 SETZ TT+1, PUSH FLP,TT+1 DFAD TT,-1(FLP) POPI FLP,2 JRST .+2 FADL TT,TT+1 RDFL3A: MOVM T,R RDFL2A: JUMPGE R,RDL2A2 RDFL2D: SETZ R, CAIG T,30. JRST RDL2D3 FSC TT,54. ;SCALE, SO THERE WONT BE UNDERFLOWS MOVNI R,54. RDL2D0: SKIPN KA10P JRST .+5 FDVL TT,D1.0E8 ;LOOP FOR MULTIPLYING-IN NEGATIVE POWER OF 10.0 FDVR TT+1,D1.0E8 FADL TT,TT+1 JRST .+2 DFDV TT,D1.0E8 SUBI T,8 RDL2D3: CAILE T,8 JRST RDL2D0 JUMPE T,RDFL2E RDL2D1: SKIPN KA10P JRST .+5 FDVL TT,D10.0 FDVR TT+1,D10.0 FADL TT,TT+1 JRST .+2 DFDV TT,D10.0 SOJG T,RDL2D1 RDFL2E: SKIPE KA10P JRST RDL2EB SKIPGE T,TT ;REMEMBER SIGN IN T DMOVN TT,TT ;NEGATE SO THAT "ROUNDP" TEST CAN BE EASY. TLNE TT+1,200000 ;DECIDE WHAT EFFECT, IF ANY, ROUNDING WILL HAVE TRON TT,1 ; LSB WAS 0, SO JUST SET IT JRST RDL2EC ; OR NO EFFECT AT ALL MOVE TT+1,TT ;"HEAVY" CASE. CREATE A FLONUM IN TT+1 WHOSE AND TT+1,[777000,,1] ; VALUE IS 1 LSB OF FRACTION (ACCOUNTING FOR JUMPGE T,RDL2EB ; A PROPOGATED CARRY). MOVNS TT ;RE-NEGATE BACK, IF NECESSARY MOVNS TT+1 RDL2EB: FADR TT,TT+1 ;ADD IN THE ROUNDING BIT RDL2EA: FSC TT,(R) JFCL 8,RDL2E1 RDL2E0: JSP T,FPCONS JRST RDFL1 RDL2E1: JSP T,.+1 SKIPE VZUNDERFLOW TLNN T,100 ;RANDOM FP UNDERFLOW BIT JRST RDNMER MOVEI TT,0 JRST RDL2E0 RDL2EC: SKIPG T MOVNS TT JRST RDL2EA RDL2A0: SKIPN KA10P ;LOOP FOR MULTIPLYING-IN POSITIVE POWER OF 10.0 JRST .+7 MOVE TT+2,TT+1 FMPR TT+2,D1.0E8 FMPL TT,D1.0E8 UFA TT+1,TT+2 FADL TT,TT+2 JRST .+2 DFMP TT,D1.0E8 SUBI T,8 RDL2A2: CAIL T,8 JRST RDL2A0 JUMPE T,RDL2A3 RDL2A1: SKIPN KA10P JRST .+7 MOVE TT+2,TT+1 FMPRI TT+2,(10.0) FMPL TT,D10.0 UFA TT+1,TT+2 FADL TT,TT+2 JRST .+2 DFMP TT,D10.0 SOJG T,RDL2A1 RDL2A3: SETZ R, JRST RDFL2E RDLST: AOS BFPRDP PUSH P,T ;*** READ LIST *** PUSH P,R70 ;POINTER TO LAST OF FORMING LIST HRLZI T,2 JRST RDLST3 RDLSTA: TLZE T,2 ;"ADD" AN ITEM TO A FORMING LIST JRST RDLSAA HLR B,(P) ;IFN NEWRD,?? HRRM A,(B) JRST (TT) RDLSAA: MOVEM A,(P) JRST (TT) RDHNK1: TLZN T,4060 ;IF THE NULL ITEM, FOLLOWED BY %RP JRST RDLSX ; FOR HUNK, THEN EXIT. RDLST1: PUSHJ P,NCONS ;GOT NEXT ITEM FOR LIST (OR HUNK) JSP TT,RDLSTA HRLM A,(P) RDLST0: MOVE B,AR2A ;ZAP OUT OBJECT BITS, EXCEPT FOR "HUNK" AND RDHNKA: TLZA T,-1#200002; "FIRST OBJECT" (MAYBE null splicing macro RDLST3: JSP TT,RDCHAR ; causes return to here with nothing accumulated). RDLS3Y: PUSHJ P,RDOBJ TLZE T,4 JRST RDLST4 ;OJBECT JUST READ WAS PRECEEDED BY A DOT MOVEM B,AR2A TLZE T,20000 JRST RDLS3D ;MACRO-PRODUCED OBJ RETURNED TLNE T,200000 JRST RDHNK1 ;CONTINUING WITH A HUNK TLNE T,24060 ;EXIT IF NO OBJECT READ JRST RDLST1 RDLSX: TLNN B,RS%RP LERR RDRM6 ;BLAST, MISSING ")" SOS BFPRDP POP P,A TLZE T,200000 PUSHJ P,MAKHUNK POP P,T RDLSX1: MOVSI B,RS% ;THROWAWAY BREAK-CHARACTER TLO T,4000 POPJ P, RDLS3D: TLNN T,4060 ;MACRO-OBJECT RETURNED WITHIN A LIST, HENCE RMCER: LERR RDRM5 ;READ MACRO CONTEXT ERROR TLNN T,1000 JRST RDLST1 ;NORMAL MACRO OBJECT TLZ T,-1#200002 ;DONT FLUSH "HUNK" OR "1ST OBJ OF LIST" BITS JUMPE A,RDLST0 ;NIL is just ignored MOVEI TT,(A) ;Let's check this out, is this an atom? LSH TT,-SEGLOG ;Get the segment number SKIPL ST(TT) ;Is it a CARCDRable? JRST RDSMER ; yes, let him know he lost JSP TT,RDLSTA JSP AR1,RLAST ;SPLICING MACRO OBJECT HRLM A,(P) JRST RDLST0 RDLST4: JUMPN T,RDLS4A ;OJBECT JUST READ WAS PRECEEDED BY A DOT SKIPN VMAKHUNK JRST ER2 TLO T,200000 ; BUT NOTHING AFTER THE DOT EXCEPT A %RP JRST RDLSX RDLS4A: TLNE T,2 ;*** DOT PAIR *** JRST ER2 TLZ T,60 TLNE T,200000 ;COMBINATION OF "HUNK" AND "DOT" BITS ON JRST RDLSX ; WHEN EXITING FROM RDOBJ MEANS ".)" CASE MOVS TT,(P) HRRM A,(TT) TLZE T,20000 TLZN T,1000 ;OJBECT IMMEDIATELY FOLLOWING "DOT" IS JRST RDLS4B MOVE AR2A,RCT0+". ;MACRO-PRODUCED SPLICING OBJECT AS "DOT"+OBJ JUMPE A,RDLST0 ;THROW AWAY IF RETURN () HRRZ AR2A,(A) JUMPN AR2A,ER2 HLRZ A,(A) HRRM A,(TT) RDLS4B: PUSHJ P,RDSKWH ;SCAN CHARS FOLLOWING OBJ TO RIGHT OF DOT JRST RDLSX ; HOPEFULLY, NEXT INTERESTING ONE IS A %RP TLNE B,RS%DOT JRST RDHNK ;IF ITS ANOTHER DOT, THEN WE HAVE A HUNK TLNE B,RS%MAC NWTNN B,RS.ALT JRST ER2 PUSHJ P,RDOBJM ;SPLICING MACRO AFTER "DOT"+OBJECT JUMPE A,RDLS4B ;THROW AWAY IF RETURN () JRST RDSME2 ;Otherwise, it's gotta be an error! RDHNK: SKIPN VMAKHUNK JRST ER2 TLO T,200000 ;BEGIN NOTICING THAT THIS IS A HUNK MOVS TT,(P) HRRZ A,(TT) ;UNDO THE CDR OF THE CELL PUSHJ P,NCONS HRRM A,(TT) HRLM A,(P) PUSHJ P,RDSKWX ;SCAN CHARS FOLLOWING OBJ TO RIGHT OF DOT JRST RDLSX ; HOPEFULLY, NEXT INTERESTING ONE IS A %RP JRST RDHNKA RDSKWH: TLNE B,RS%RP ;RIGHT PAREN? THEN EXIT NORMALLY POPJ P, NWTN E,B,WTH JRST POPJ1 ;EXIT BY SKIPPING IF "INTERESTING" CHAR IS NOT PARENS RDSKWX: JSP TT,RDCHAR ;IF CHAR IS UNWORTHY, THEN FLUSH IT AND TRY AGAIN JRST RDSKWH RDOBM2: PUSHJ P,RDOBJM ;Get the object. TLNE T,4 ;Was this proceeded by a .? TLNN T,1000 ; And splicing? POPJ P, ; NO JRST RDSMCK ;Yes, do error checking and return RDOBJM: TLO T,20000 ;*** MACRO CHARACTER *** NWTNE B,RS.ALT ;SPLICING? TLO T,1000 ;SPLICING MACRO PUSH P,T PUSH FXP,BFPRDP NW% CALLF 0,(B) ;MACRO CHARACTER HAS LINK IN RH OF IFN NEWRD,[ LDB D, [001100,,B] PUSHJ P, GETMAC HRRZ A, (A) CALLF 0, (A) ] ;END OF IFN NEWRD POP FXP,BFPRDP JSP T,RDIBGT ;RE-CACHE THE IBASE DATA JSP T,RSXST ;RE-CACHE THE READTABLE DATA POP P,T JRST RDLSX1 RDSMCK: JUMPE A,CPOPJ ;NIL is always OK PUSH FXP,T ;Temp MOVEI T,(A) ;Copy LSH T,-SEGLOG ;Get the type bits SKIPL ST(T) ;Can it be CARCDRed? JRST RDSME1 ; No, barf about it (ILLEGAL RETURN VALUE FROM ...) POP FXP,T HRRZ B,(A) ;CDR the frob JUMPN B,RDSMER ; Error if more than one POPJ P, RDALPH: TLO T,20 ;*** PNAME ATOM *** SETOM LPNF RDA0: JSP TT,IRDA1 RDA1: IDPB B,C RDA3: JSP TT,RDCHAR SOJG D,RDA1 MOVEM B,AR2A PUSHJ FXP,RDA4 MOVE B,AR2A JRST RDA0 RDA4: PUSHJ P,PNCONS ;ADDS ANOTHER SEGMENT TO A LONG PNAME LIST AOSN LPNF PUSH P,R70 MOVE B,(P) EXCH A,B PUSHJ P,.NCONC MOVEM A,(P) POPJ FXP, RLAST: JUMPE A,(AR1) RLAST1: HRRZ TT,(A) JUMPE TT,(AR1) LSH TT,-SEGLOG SKIPL ST(TT) JRST RMCER HRRZ A,(A) JRST RLAST1 RDCHO1: MOVE AR1,B NWTNN B,RS.PNT JRST RDCHO3 JSP TT,RDCHAR ;. AS SCO ALSO HAS DECIMAL PT. SYNTAX NWTNE B,RS.DIG JRST RDOBJ5 ;WILL TAKE AS FLOTING PT. NUM NWTN N,B,WTH ;SKIP IF WORTHY CHAR JRST RDCHO3 ;CAN TOSS OUT NEXT UNWORTHY CHAR RDCHO4: PUSH FXP,B ;OTHERWISE, SAVE NEXT CHAR AS IF IT WERE IMPORTANT BREAK CHAR SKIPA C,[RDCHO2] RDCHO3: MOVEI C,RDLSX1 MOVE B,AR1 PUSH P,C RDCHO: JSP TT,IRDA ;*** SINGLE CHARA OBJECT *** SETZM PNBUF IDPB B,C JRST RINTERN RDCHO2: POP FXP,B ;AFTER MAKING UP . AS SCO, MOVEM B,RDBKC ;MAKE NEXT CHAR LOOK LIKE TLO T,20 ;IMPORTANT BREAK CHAR POPJ P, IFN BIGNUM,[ RD10OV: TLO T,40000 JSP A,RDRGSV PUSHJ P,C1CONS MOVE AR1,A JRST RDBG1A RDIBOV: TLO T,100000 JSP A,RDRGSV PUSHJ P,C1CONS MOVE AR2A,A JRST RDBGIA RDBG10: TLNE T,3000 JRST RDNUMD ;GETTING EXPONENT MODIFIER JSP A,RDRGSV RDBG1A: MOVE T,AR1 MOVEI D,-"0(B) NW$ ANDI D,177 MOVEI TT,10. PUSHJ P,.TM.PL MOVE T,TSAVE TLNE T,100000 JRST RDBGIA JSP A,RDRGRS JRST RDNUMB RDBGIB: TLNE T,3000 JRST RDNUMB ;GETTING EXPONENT MODIFIER JSP A,RDRGSV RDBGIA: MOVE T,AR2A MOVE TT,RDIBS MOVEI D,-"0(B) NW$ ANDI D,177 PUSHJ P,.TM.PL JSP A,RDRGRS JRST RDNUM1 .RDMULP: SKIPA T,A .TIMER: MOVEI D,0 ;T IS LIST OF DIGITS, TT IS MULTIPLIER, .TM.PL: HLRZ A,(T) ;D IS CARRY. MOVE R,(A) MUL R,TT ADD R+1,D TLZE R+1,400000 AOS R MOVEM R+1,(A) MOVE D,R HRRZ A,(T) JUMPN A,.RDMULP JUMPE D,CPOPJ MOVE TT,D PUSHJ P,C1CONS HRRM A,(T) POPJ P, ;;; IFN BIGNUM RDRGSV: MOVEM T,TSAVE MOVEM D,DSAVE MOVEM R,RSAVE MOVEM F,FSAVE JRST (A) RDRGRS: MOVE T,TSAVE MOVE D,DSAVE MOVE R,RSAVE MOVE F,FSAVE JRST (A) RDEXOF: TLO T,100000 PUSH FXP,TT+1 PUSHJ P,C1CONS MOVE B,A POP FXP,TT PUSHJ P,C1CONS HRRM B,(A) TLNE T,400 TLO A,-1 JRST RX1 RDEX3: PUSH P,A MOVEM T,TSAVE MOVE T,A MOVE TT,RDIBS PUSHJ P,.TIMER MOVE T,TSAVE POP P,A JRST RX1 RDBIGN: TLNE T,3000 JRST RDBGEX HRLI A,0 ;CREATE BIGNUM SIGN TLNE T,400 TLO A,-1 TLNE T,100000 TLNE T,300 JRST RDCBG HRR A,AR2A RDBIGM: PUSHJ P,BNTRSZ MOVE TT,[400000,,0] JRST RDFX1 PUSHJ P,BNCONS MOVE B,RDBKC POPJ P, ;;; IFN BIGNUM RDBGEX: TLNE T,200 JRST RDBXFL MOVEI D,1 TLNE T,2000 JRST RDBFSH JUMPLE TT,RDBGXM IMUL D,RDIBS ;^(TT) SOJG TT,.-1 RDBGXM: MOVE TT,D MOVEM T,TSAVE HRRZ T,AR2A PUSHJ P,.TIMER MOVE A,AR2A MOVE T,TSAVE JRST RDBIGM RDBFSH: LSH D,(TT) ;_(TT) JRST RDBGXM RDBXFL: ADD TT,RDDSV SUBI TT,BYTSWD*LPNBUF MOVE A,AR2A JRST RDCBG1 RDCBG: TLNN T,300 JRST RDNM2B HRR A,AR1 TLNN T,200 JRST RDBIGM HRREI TT,-BYTSWD*LPNBUF-1(D) RDCBG1: PUSH FXP,TT ;THIS IS THE POWER-OF-TEN EXPONENT MOVE TT,A PUSHJ P,FLBIGZ POP FXP,R JFCL 8.,RDNMER JUMPGE A,RDFL3A DFN TT,TT+1 JRST RDFL3A RDNM2B: TLZ T,140000 ;A BIGNUMBER BASE 10. WAS REALLY A REGNUM JRST RDNM2A ;BASE IBASE, BUT BIG ENOUGH TO OVFLO BASE 10. CALC ] ;END OF IFN BIGNUM SUBTTL READER SINGLE-CHARACTER FILTER ;;; ***** READ ONE CHARACTER (FOR READ) ***** RDCHAR: PUSHJ P,@RDINCH MOVE B,@RSXTB RDCH1: NW% JUMPGE B,(TT) NW$ NWTNE B,RS%BRK NW$ JRST (TT) NWTN E,B,[] JRST RDBK ;BREAKING CHAR FOUND NWTN N,B,WTH JRST RDCHAR ;WORTHLESS CHAR TLNN B,RS%SLS JRST (TT) ;ALPHABETIC CHAR WITH BREAK BIT SOMEHOW SET PUSHJ P,@RDINCH ;/ NW% HRR B,A ;PUT EXTENDED ALPHABETIC SYNTAX ON THIS CHAR NW% HRLI B,2 NW$ MOVEI B,RS.XLT(A) JRST (TT) RDBK: MOVEM B,RDBKC TLNN T,60 JRST (TT) TLNN T,20 ;From here down, we're reading literal token JRST RDNUM4 PUSHJ FXP,RDAEND ;Symbol IFN USELESS, SKIPE RDROMP IFN USELESS, PUSHJ P,RDROM PUSHJ P,RINTERN RDNMX: MOVE B,RDBKC POPJ P, RDNUM4: TLNN T,300 TLNN B,200 JRST RDNM4A PUSHJ P,@RDINCH ;. FOUND MOVE B,@RSXTB NWTN N,B,SEE JRST .-3 ;CONTROL-CHARS ARE IGNORED MOVEI D,BYTSWD*LPNBUF+1 NWTNE B,RS.DIG TLOA T,200 TLO T,100 JRST RDCH1 RDNM4A: TLNE B,RS.SGN TLNN T,3000 JRST RDNMF ;TERMINATES A NUMBER TOKEN, UNLESS A SIGN IS JRST (TT) ;FOLLOWING AN EXPONENTIATOR IFN USELESS,[ RDROM: SKIPGE LPNF SKIPN PNBUF POPJ P, MOVEI D,(C) CAIL D,PNBUF+LPNBUF-1 ;TOO BIG TO DO ANOTHER ILDB ? POPJ P, PUSH FXP,C SETZB TT,D IDPB D,C MOVE C,[440700,,PNBUF] RDROM1: ILDB F,C JUMPN F,RDROM2 PUSH FXP,T JSP T,FXCONS POP FXP,T SUB FXP,R70+1 JRST POPJ1 RDROM2: SETZ R, IRP X,,[M,D,C,L,X,V,I]N,,[1000.,500.,100.,50.,10.,5,1] CAIN F,"X MOVEI R,N TERMIN JUMPE R,RDROM7 ADDI TT,(R) CAIG R,(D) JRST RDROM3 REPEAT 2, SUBI TT,(D) RDROM3: MOVEI D,(R) JRST RDROM1 RDROM7: POP FXP,C POPJ P, ] ;END OF IFN USELESS RDAEND: LSHC B,6 DPB B,[360600,,C] SETZM B LSHC B,-6 DPB B,C SKIPGE LPNF POPJ FXP, PUSHJ P,PNCONS ;DESTROYS TT POP P,B EXCH A,B PUSHJ P,.NCONC POPJ FXP, IRDA: SETOM LPNF ;INITIALIZE FOR READING PNAME-TYPE ATOM IRDA1: MOVE C,PNBP MOVEI D,BYTSWD*LPNBUF JRST (TT) RDIN: PUSHJ FXP,SAV5M1 PUSHJ P,SAVX5 PUSHJ P,@TYIMAN MOVEI A,(TT) ;***** GRUMBLE ***** PUSHJ FXP,RST5M1 JRST RSTX5 ;;;; ERROR MSGS ETC ER2: LERR RDRM4 ;CONTEXT ERROR WITH DOT NOTATION -READ ER3: LERR RDRM7 ;BLAST? RDNMER: LERR RDRM8 ;NUMERIC OVERFLOW RDSME2: LER3 RDRM9 ;MULTIPLE SPLICING MACROS RETURNED NON-NIL AFTER "." RDSME1: POP FXP,T RDSMER: LER3 RDRM11 ;ILLEGAL RETURN VALUE FROM SPLICING MACR SUBTTL BUILT-IN MACRO CHARACTER PROCESSORS ;;; SINGLE QUOTE PROCESSOR: ;;; 'FOO => (QUOTE FOO) RDQTE: MOVEI T,0 PUSHJ P,OREAD ;FOR THE WHITE SINGLE-QUOTE HAC PUSHJ P,NCONS MOVEI B,QQUOTE JRST XCONS ;;; SEMICOLON COMMENT PROCESSOR: (SPLICING) ;;; ; -- ANYTHING -- => NIL, HENCE IGNORED RDSEMI: PUSHJ P,RDSMI0 JUMPE A,CPOPJ ;OK, FOUND CR JRST RDLNER RDSMI0: PUSH P,[,,-1] MOVNI T,1 JSP D,INCALL QRDSEMI ;THIS SHOULD NEVER [!!] BE USED RDSMI1: PUSHJ P,TYI SA$ CAIE A,%TXCTL+"M SA$ CAIN A,%TXCTL+"m SA$ JRST FALSE ;YET ANOTHER GODDAM SAIL CHARACTER SET SCREWUP CAIE A,15 ;CR JRST RDSMI1 JRST FALSE ;;; VERTICAL BAR PROCESSOR: ;;; |ANYTHING| => /A/N/Y/T/H/I/N/G ;;; I.E. IT IS A SUPER SYMBOL QUOTER (ALMOST LIKE ""'S) RDVBAR: SKIPA T,["|] RDDBLQ: MOVEI T,"" PUSH FXP,T PUSH FXP,R70 ;WATCH OUT - THESE SLOTS USED BY RDVB2 PUSHJ P,RDVB0 SUB FXP,R70+1 POP FXP,T CAIN A,-1 JRST EOFER CAIN T,"| JRST RINTERN PUSHJ P,PNGNK1 ;FOR " MOVE AR1,A JSP T,.SET ;HAPPILY, THE RESULT IS ALSO IN A RDVB5: MOVEI C,Q%ISM MOVEI B,TRUTH PUSHJ P,PUTPROP MOVE A,AR1 POPJ P, RDVB0: PUSH P,[,,-1] MOVNI T,1 JSP D,INCALL QRDVBAR ;THIS SHOULD NEVER [!!] BE USED JSP T,GTRDTB MOVEI T,RDVB3 PUSHJ FXP,MKNR6C POPJ P, RDVB2: SETOM -1(FXP) RDVB3: PUSH FXP,D PUSHJ P,TYI POP FXP,D CAIN TT,203 ;RARE CASE WHEN | IS CALLED FROM WITHIN JRST RDVB3 ; A READLIST - MAY SEE A PSEUDO-SPACE. SA$ CAIE TT,%TXCTL+"M SA$ CAIN TT,%TXCTL+"m SA$ MOVEI TT,15 CAIN TT,^J SKIPN -1(FXP) JRST RDVB4 SETZM -1(FXP) JRST RDVB3 RDVB4: SETZM -1(FXP) CAMN TT,-2(FXP) POPJ P, SKIPGE T,@TTSAR(AR2A) TLNN T,2000 JRST POPJ1 PUSH FXP,D PUSHJ P,TYI POP FXP,D CAIN TT,^M SETOM -1(FXP) JRST POPJ1 IFN ITS+SAIL,[ ;;; SPLICING MACRO CHARACTER FUNCTIONS FOR ^Q AND ^S. CTRLQ: MOVEI A,TRUTH MOVEM A,TAPRED JRST FALSE CTRLS: SETZM TTYOFF JRST TERPRI ] ;END OF IFN ITS+SAIL SUBTTL NEWIO TTY PRESCAN, RUBOUT HANDLER, AND READLINE ;;; INITIAL TTY CHARACTER BUFFERING ROUTINE. ;;; BUFFERS UP A LIST OF CHARACTERS FOR TTY INPUT. ;;; HANDLES ALL APPROPRIATE RUBOUT PROCESSING. ;;; ARGUMENTS ARE A TTY INPUT FILE ARRAY IN A, ;;; THE FUNCTION TO BUFFER FOR IN B (E.G. QOREAD), ;;; AND THE COUNT OF UNMATCHED LEFT PARENS IN C. ;;; RUBOUT ECHOING IS PERFORMED ON THE ASSOCIATED OUTPUT ;;; TTY, IF ANY. HAIRY ERASING RUBOUT IS DONE FOR DISPLAYS. ;;; NO RUBOUT HACKING IS DONE IF THERE IS NO ECHO FILE. ;;; THESE ARE COMPATIBLE WITH THE ITS DEFINITIONS: %TXMTA==:400 ;META BIT %TXCTL==:200 ;CONTROL BIT %TXASC==:177 ;ASCII CODE TTYBUF: IFN SFA,[ JSP TT,AFOSP JFCL JRST .+2 JRST [ CALLF 3,QLIST HRRZ C,(A) HLRZ A,(A) MOVEI B,QTTYBUF JRST ISTCSH ] ] ;END OF IFN SFA JSP T,SPECBIND VECHOFILES 0 A,VINFILE CAIN A,TRUTH HRRZ A,V%TYI PUSH FXP,(C) CAIE C,QOREAD SETZM (FXP) JSP T,GTRDTB ;GET READTABLE;AR2A 4.9 = USEFULP CAIN B,Q%READLINE ;AR2A 4.9 => USEFULP TLO AR2A,200000 ;AR2A 4.8 => READLINE MOVEI TT,LRCT-2 ;AR2A 4.7 => (STATUS TTYREAD) = T HLRZ C,@TTSAR(AR2A) SKIPE C TLO AR2A,100000 MOVE C,A MOVEI TT,FT.CNS ;GET ASSOCIATED OUTPUT TTY SKIPE C,@TTSAR(A) ; (THE SIGN BIT TELLS TYO6 THIS IS ONE FILE) PUSHJ P,TTYBRC ;MAYBE GET CURCOR POSITION IN D PUSH FXP,D PUSH FXP,-1(FXP) ;PARENS COUNT MOVEI TT,F.MODE MOVE R,@TTSAR(A) ;GET INPUT FILE MODE BITS PUSH FXP,R PUSH FXP,XC-1 ;PUSH -1 (NOT IN STRING YET) SETZ B, ;B HOLDS LIST OF CHARACTERS HRRZS BFPRDP ;WE WANT NO CLEVERNESS FROM $DEVICE ;STATE OF THE WORLD: ; B HAS LIST OF BUFFERED CHARS (IN REVERSE ORDER) ; C HAS TTY OUTPUT FILE ARRAY ; AR2A HAS READTABLE ; 4.9 => USEFUL CHAR SEEN ; 4.8 => READLINE INSTEAD OF READ ; 4.7 => (STATUS TTYREAD) = T ; VINFILE HAS TTY INPUT FILE ARRAY ; FXP: STRING TERMINATOR CHAR (-1 IF NOT IN STRING) ; MODE BITS FOR INPUT FILE ; PARENTHESIS COUNT ; SAVED CURSOR POSITION ; ORIGINAL PARENS COUNT TTYB1: PUSHJ P,TTYBCH ;GET A CHARACTER MOVE D,@TTSAR(AR2A) ;GET READTABLE SYNTAX MOVE R,-1(FXP) ;GET MODE BITS IFN SAIL,[ CAIE TT,%TXCTL+"M CAIN TT,%TXCTL+"m JRST TTYB1E ] ;END IFN SAIL CAIE TT,^M JRST TTYB7 TTYB1E: TLNE AR2A,200000 ;CR TERMINATES READLINE JRST TTYB9 TLNN R,FBT ;SKIP IF LINE MODE JRST TTYB2 MOVEI TT,203 ;PSEUDO-SPACE TLNN AR2A,200000 ;SKIP IF HACKING A STRING JSP R,TTYPSH ;ELSE PUSH CHAR ONTO BUFFER SA% MOVEI TT,^M SA$ MOVEI TT,%TXCTL+"M JRST TTYB9 ;ALL DONE TTYB7: IFN SAIL,[ CAIE TT,%TXCTL+"K CAIN TT,%TXCTL+"k ;LOWER CASE K JRST TTYB7E ; TLNN R,FBT ] ;END OF IFN SAIL 20$ CAIE TT,^R ;FOR A ^R (ON TWENEX) WE RETYPE THE BUFFER CAIN TT,^K ;FOR A ^K, WE TERPRI AND RETYPE THE BUFFER JRST TTYB7E TTYB7F: IFN SAIL,[ CAIE TT,%TXCTL+"L CAIN TT,%TXCTL+"l ;LOWER CASE L JRST TTYB7E ; TLNN R,FBT ] ;END OF IFN SAIL CAIE TT,^L ;RPUSH FXP FOR ^L, WE CLEAR THE SCREEN, JRST TTYB2 ; THEN RETYPE THE BUFFER SKIPN AR1,C JRST TTYB1 MOVEI TT,F.MODE MOVE R,@TTSAR(AR1) TLNN R,FBT ;IF WE CAN'T CLEAR THE SCREEN, JRST TTYB7G ; WE JUST MAKE LIKE ^K PUSHJ P,CLRSRN TTYB7N: PUSHJ P,TTYBRC ;READ THE TTY CURSOR POSITION MOVEM D,-3(FXP) PUSHJ P,TTYBLT ;ZAP OUT TTY BUFFER JRST TTYB1 TTYB7E: SKIPN AR1,C JRST TTYB1 TTYB7G: PUSHJ P,ITERPRI JRST TTYB7N CLRSRN: ;CLEAR THE "SCREEN" IFN ITS\D20,[ MOVEI D,"C JRST CNPCOD ] ;END OF IFN ITS\D20 IFN D10,[ PUSH P,A ;SAVE A OVER TYO MOVEI A,14 ;^L PUSHJ P,$TYO ;AT THIS POINT, THE FILE MUST BE A TTY JRST POPAJ ];END IFN D10 IFE ITS\D20\D10, WARN [SAY, YOU WILL LOSE WITH ITS\D20\D10 = 0] TTYB2: TLNN AR2A,200000 ;READLINE IGNORES SLASHES TLNN D,2000 .SEE SYNTAX ;SLASH JRST TTYB4 JSP R,TTYPSH PUSHJ P,TTYBCH TLO TT,400000 ;SLASHIFIED CHAR TTYB3: TLO AR2A,400000 ;USEFUL FROB SEEN TTYB3A: JSP R,TTYPSH JRST TTYB1 TTYB4: TLNE D,1000 .SEE SYNTAX ;RUBOUT TLNE D,40 .SEE SYNTAX ;NOT SECOND CHOICE JRST TTYB5 JUMPN B,TTYB4C HRRZ T,BFPRDP JUMPE T,TTYB9J ;RETURN TO CALLER FOR EOF SKIPE AR1,C ;OOPS! INSIDE READ ALREADY! PUSHJ P,ITERPRI ; WE MUST SIMPLY TERPRI JRST TTYB1 ; (IF POSSIBLE) AND TRY IT AGAIN TTYB4C: PUSHJ P,RUB1CH ;RUB OUT CHAR SKIPL TT,(A) ;SKIP IF CHAR WAS SLASHIFIED JRST TTYB4G PUSHJ P,RUB1CH ;RUB OUT SLASH TOO JRST TTYB1 RUB1CH: HLRZ A,(B) ;DELETE CHAR FROM BUFFERED LIST HRRZ B,(B) JUMPE C,CPOPJ ;THAT'S IT IF NO ECHO FILE PUSH P,A HRRZ A,(A) ;GET CHARACTER IN A MOVEI AR1,(C) PUSHJ P,RUB1C1 JRST POPAJ ;NORMAL RETURN: DONE IT 20$ JRST RUB2CH ;SINGLE SKIP: RETYPE ON "DUMB" OPERATING SYSTEM 20% JFCL ;CAN'T GET HERE ON ITS IFN ITS\D20, PUSHJ P,RSTCUR ;MUST RETYPE WHOLE STRING IN PLACE PUSHJ P,TTYBLT IFN ITS\D20, PUSHJ P,CNPL JRST POPAJ IFN D20,[ RUB2CH: PUSHJ P,TTYBLT ;RETYPE INPUT JRST POPAJ ] ;END IFN D20 TTYB4G: SKIPL (FXP) ;SKIP UNLESS IN STRING JRST TTYB4J TLNE TT,100000 JRST TTYB4M MOVE D,@TTSAR(AR2A) ;GET CHARACTER SYNTAX TLNE D,40000 .SEE SYNTAX ;OPEN PAREN SOS -2(FXP) TLNN D,10000 .SEE SYNTAX ;CLOSE PAREN JRST TTYB1 SKIPLE -2(FXP) AOS -2(FXP) JRST TTYB1 TTYB4J: TLNE TT,200000 ;RUBBED OUT BACK OUT OF STRING SETOM (FXP) JRST TTYB1 TTYB4M: HRRZM TT,(FXP) ;RUBBED OUT BACK INTO A STRING JRST TTYB1 TTYB5: TLNE AR2A,200000 ;GO BACK AROUND IF READLINE JRST TTYB3A SKIPGE R,(FXP) ;SKIP IF IN STRING JRST TTYB5H CAIE R,(TT) JRST TTYB3A TLO TT,100000 ;MARK AS STRING END SETOM (FXP) JRST TTYB3A TTYB5H: TLNE D,1000 .SEE SYNTAX ;FORCE FEED TLNN D,40 .SEE SYNTAX ;SECOND CHOICE JRST TTYB5K JSP R,TTYPSH JRST TTYB9A TTYB5K: TLNN D,100000 .SEE SYNTAX ;SPACE JRST TTYB6 TTYB5M: JSP T,TTYATM JRST TTYB3A TTYB6: TLNN D,200000 .SEE SYNTAX ;SINGLE CHAR OBJECT JRST TTYB6C TLO AR2A,400000 ;USEFUL THING SEEN JRST TTYB5M TTYB6C: TLNN D,4000 JRST TTYB6J ;NOT A MACRO CHAR HRRZ R,VTSCSR ; ((#/; . #\CR) (#/| . #/|) (#/" . #/")) MOVS F,(R) MOVS T,(F) CAMN TT,(T) JRST .+4 HLRZ R,F JUMPN R,.-5 JRST TTYB6J ;NOT A STRING-LIKE MACRO CHAR MOVSS T MOVE F,(T) TLO AR2A,400000 ;USEFUL FROB SEEN TLO TT,200000 ;STRING BEGIN MOVEM F,(FXP) JRST TTYB3 TTYB6J: TLNN D,40000 .SEE SYNTAX ;OPEN PAREN JRST TTYB6Q AOS -2(FXP) JRST TTYB3 TTYB6Q: TLNN D,10000 .SEE SYNTAX ;CLOSE PAREN JRST TTYB8 JSP T,TTYATM SOSLE T,-2(FXP) JRST TTYB3 JUMPE T,TTYB9 ;AHA, PARENS BALANCE TLNE AR2A,400000 ;IF NOTHING USEFUL HAS COME IN SO FAR, THEN JRST TTYB9 SETZM -2(FXP) ;THROW AWAY A STRAY TOP-LEVEL RIGHT PARENS JRST TTYB3A TTYB9: JSP R,TTYPSH TLNN AR2A,100000 JRST TTYB1 ;ONLY FORCE-FEED ENDS TTYSCAN TTYB9A: JUMPE C,TTYB9B PUSHJ P,TTYBRC MOVEI TT,AT.LNN ;UPDATE LINENUM AND CHARPOS HLRZM D,@TTSAR(C) ; OF ASSOCIATED OUTPUT FILE MOVEI TT,AT.CHS HRRZM D,@TTSAR(C) TTYB9B: MOVEI A,(B) PUSHJ P,NREVERSE MOVEI B,(A) MOVEI C,(A) TTYB9D: JUMPE C,TTYB9J HLRZ A,(C) MOVE TT,(A) TLZE TT,-1 JSP T,FXCONS HRLM A,(C) HRRZ C,(C) JRST TTYB9D TTYB9J: POPI FXP,5 MOVEI A,(B) JRST UNBIND TTYB8: TLNE D,277237 .SEE SYNTAX ;SKIP IF NOT WORTHY CHAR JRST TTYB3 JRST TTYB3A TTYBRC: HRROS AR1,C TTYBR1: MOVE TT,TTSAR(AR1) ;GET CURSOR POSITION OF FILE FROM (AR1) INTO D PUSHJ P,IFORCE IFE ITS\D20, JRST TTYBR2 ;? WHAT TO DO? IFN ITS\D20,[ MOVEI TT,F.MODE MOVE F,@TTSAR(AR1) ;C HAS OUTPUT FILE FOR ECHOING PUSHJ FLP,RCPOS TLNE F,FBT MOVE D,R ;MAYBE NEED ECHO AREA CURSOR POPJ P, ] ;END OF IFN ITS\D20 TTYBR2: SETZ D, POPJ P, TTYPSH: IFN 0,[ ANDI TT,%TXCTL+%TXASC ;? FOLD CHARACTER DOWN TO 7 BITS TRZN TT,%TXCTL JRST TTYPS1 CAIE TT,177 TRZ TT,140 TTYPS1: ] ;END OF IFN 0 JSP T,FXCONS ;PUSH CHAR IN TT ON FRONT PUSHJ P,CONS ; OF LIST OF BUFFERED CHARS MOVEI B,(A) JRST (R) TTYATM: JUMPGE AR2A,(T) ;DECIDE WHETHER WE MAY HAVE MOVE R,-1(FXP) ; TERMINATED A TOP LEVEL ATOM, SKIPG -2(FXP) ; AND IF SO GO TO TTYB9 AND OUT TLNE R,FBT ;WE HAVE *NOT* TERMINATED IF: JRST (T) ; NO USEFUL CHARS SEEN YET TLNN AR2A,100000 ; (STATUS TTYREAD) = NIL JRST (T) ; OPEN PARENS ARE HANGING JRST TTYB9 ; TTY INPUT IS IN LINE MODE TTYBCH: PUSHJ P,$DEVICE ;GOBBLE A CHARACTER IFN ITS,[ ANDI TT,%TXCTL+%TXASC ;FOLD CHARACTER TO 7 BITS TRZN TT,%TXCTL POPJ P, CAIE TT,177 TRZ TT,140 MOVEI D,(TT) ;ATTEMPT TO FLUSH INTERRUPT CHARS ROT TT,-1 ADDI TT,FB.BUF ;REALLY SHOULD BE MORE CLEVER HRRZ AR1,VINFILE HLRZ R,@TTSAR(AR1) SKIPGE TT HRRZ R,@TTSAR(AR1) JUMPN R,TTYBCH MOVEI TT,(D) ] ;END OF IFN ITS POPJ P, TTYBLT: SKIPN AR1,C POPJ P, MOVEI A,(B) ;TYPE OUT ALL BUFFERED CHARS PUSHJ P,NREVERSE ; ONTO THE ECHO OUTPUT FILE MOVEI B,(A) SKIPG -4(FXP) ;IF WE ENTERED WITH HANGING JRST TTYBL1 ; PARENS, PRINT THEM PUSH FXP,-4(FXP) TTYBL4: MOVEI TT,"( PUSHJ P,TYOFIL SOSLE (FXP) JRST TTYBL4 SUB FXP,R70+1 MOVEI TT,40 PUSHJ P,TYOFIL TTYBL1: JUMPE B,TTYBL2 ;ECHO ALL CHARS TO ECHO TTY HLRZ C,(B) HRRZ TT,(C) PUSHJ P,TYOFIL HRRZ B,(B) JRST TTYBL1 TTYBL2: PUSHJ P,NREVERSE MOVEI B,(A) ;RESTORE BACKWARDS LIST OF CHARS MOVE C,AR1 ;RESTORE C (NREVERSE CLOBBERED) POPJ P, RUBOUT: MOVEI D,QRUBOUT ;LSUBR (1 . 2) CAMGE T,XC-2 JRST WNALOSE ;MORE THAN 2 ARGS JUMPE T,WNALOSE ; 0 ARGS CAME T,XC-2 SKIPA AR1,V%TYO POP P,AR1 POP P,A JSP F,TYOARG IFN SFA,[ JSP TT,XFOSP JRST RUBOU1 JRST RUBOU1 MOVEI T,SO.RUB MOVEI TT,SR.WOM TDNN T,@TTSAR(AR1) ;CAN IT DO THE RUBOUT OPERATION? JRST FALSE ; NO, SO JUST RETURN () MOVE C,A JRST ISTCAL RUBOU1:] ;END IFN SFA MOVE A,(A) ;RE-FETCH NUMERICAL ASCII VALUE PUSHJ P,TOFLOK PUSHJ P,RUB1C1 JRST UNLKTRUE JFCL ;DOUBLE SKIP LIKE SINGLE SKIP HERE SETZ A, UNLKPOPJ ;;; ROUTINE WHICH ATTEMPTS TO RUB OUT A CHARACTER ON A TTY. ;;; SKIPS ON *FAILURE* TO RUB IT OUT. ;;; OUTPUT TTY FILE ARRAY MUST BE IN AR1. RUB1C1: MOVEI TT,F.MODE MOVE F,@TTSAR(AR1) TLNE F,FBT ;IF CAN'T SELECTIVELY ERASE TLNN F,FBT ; AND MOVE CURSOR AROUND FREELY, 20% JRST TYOFA ; MERELY ECHO RUBBED-OUT CHAR 20$ JRST RUB1C2 IFE ITS\D20, HALT IFN ITS\D20,[ CAIN A,177 ;RUBOUT DOESN'T PRINT, HENCE NEEDN'T KILL POPJ P, MOVEI T,1 CAILE A,^_ ;CHARS FROM 40 TO 176 ARE ONE JRST RUB1C3 ; POSITION WIDE, SO BACK UP AND ERASE CAIN A,^I ;TABS ARE VARIABLE - MUST RETYPE JRST RUB1C4 CAIN A,^J ;LINE FEED IS DOWNWARD MOTION - JRST CNPU ; ERASE BY MOVING UP CAIN A,^H ;BACKSPACE IS ERASED BY JRST CNPF ; MOVING FORWARD CAIE A,^M ;FOR CR, DON'T KNOW LENGTH OF PREVIOUS LINE CAIN A,^_ ;FOR ^_, MAY OR MAY NOT HAVE BEEN DOUBLED JRST RUB1C4 CAIE A,33 ;ALTMODE IS ALWAYS 1 WIDE TLNE F,FBT ;OTHER CONTROLS ONE WIDE IF IN SAIL MODE JRST RUB1C3 MOVEI T,2 ;OTHERWISE CONTROL CHARS ARE TWO WIDE RUB1C3: ;; PUSHJ FLP,RCPOS ;; TLNE F,FBT ;; MOVE D,R MOVEI R,(T) ;; CAILE T,(D) ;CLAIM IS, AS OF 1980, THAT THAT ^PB AND ^PX ;; PUSHJ P,CNPU ; KNOW ENOUGH TO DO THIS ALREADY CAIE R,2 JRST CNPBL JRST CNPBBL RUB1C4: AOS (P) ;DOUBLE SKIP RETURN, RETYPE ON SMART TTY AOS (P) POPJ P, ] ;END OF IFN ITS\D20 IFN D20,[ RUB1C2: SKIPN TENEXP ;ONLY TENICIES HAVE DELCH JSYS JRST TYOFA ;SO ON TOPS-20 CAN ONLY REECHO CHARACTER MOVE TT,A ;SAVE RUBBED OUT CHARACTER LOCKI ;LOCK OVER SYSTEM CALL MOVE T,TTSAR(AR1) HRRZ A,F.JFN(T) RUB1C8: DELCH JRST RUB1C5 ;NOT TTY?? JUST PRINT CHARACTER JRST RUB1C6 ;AT BEGINNING OF LINE, RETYPE INPUT JRST RUB1C7 ;DID IT, JUST RETURN ;;; HERE IF NON-DISPLAY, NOT TTY, OR IF DELCH GOT AN ILLEGAL INSTRUCTION TRAP .SEE INTILO RUB1C5: UNLOCKI ;RELEASE LOCK MOVE A,TT ;PUT SOMETHING SAFE IN A JRST TYOFIL ;THEN OUTPUT CHARACTER FROM TT RUB1C6: AOS (P) ;SKIP RETURN MEANS REECHO UNLKPOPJ RUB1C7: CAIL TT,^H ;PROBABLY ^ FORMAT JRST RUB1C9 RUB1CA: MOVEI TT,"^ ;TURN CHARACTER UNTO AN UPARROW JRST RUB1C8 ;THEN GET RID OF IT TOO RUB1C9: CAIG TT,^M ;OUT OF MAGIC CHARACTER RANGE? JRST RUB1CC ;NOPE, PROBABLY BE BETTER TO RETYPE THEN CAIN TT,33 ;ESCAPE IS MAGIC, AS IT PRINTS AS ONLY ONE CHAR UNLKPOPJ CAIGE TT,40 ;SOME OTHER CONTROL CHAR? JRST RUB1CA ;YES, GET RID OF THE PRECEEDING UPARROW MOVE A,TT UNLKPOPJ ;ELSE JUST RETURN, THE WORK IS DONE RUB1CC: UNLOCKI AOS (P) ;SETUP FOR SKIP (RETYPE) RETURN MOVEI A,15 ;BUT FIRST GET TO A NEW LINE JRST TYOFA ] ;END IFN D20 ;;; READLINE TAKES STANDARD FILE/EOF INPUT ARGUMENTS AND READS ;;; ONE LINE FROM A FILE. IT INVOKES PRE-SCANNING FOR TTY'S. ;;; THE RESULT IS RETURNED AS AN ATOMIC SYMBOL, EXCLUDING THE ;;; CARRIAGE RETURN WHICH TERMINATES THE LINE. LINE FEEDS ;;; ARE IGNORED (NECESSARY FOR SUCCESSIVE READLINE'S). %READLINE: JSP D,INCALL SFA% Q%READLINE SFA$ [SO.RDL,,],,Q%READLINE MOVEI A,Q%READLINE HRLZM A,BFPRDP ;PERMIT TTY PRE-SCAN MOVEI T,%RDLN5 PUSHJ FXP,MKNR6C ;PART OF MAKNAM JRST PNGNK1 ;CREATE NON-INTERNED SYMBOL %RDLN5: PUSH FXP,D %RDLN6: PUSHJ P,@TYIMAN IFN SAIL,[ ANDI TT,%TXCTL+%TXASC ;FOLD CHARACTER DOWN TO 7 BITS TRZN TT,%TXCTL JRST %RDLNZ CAIE TT,177 TRZ TT,140 %RDLNZ: ] ;END IFN SAIL CAIN TT,^J ;IGNORE LINE FEEDS JRST %RDLN6 POP FXP,D CAIN TT,^M ;CR TERMINATES POPJ P, MOVEI A,(TT) JRST POPJ1 PGTOP RDR,[HIRSUTE READER, MAKNAM, ETC.]