;;; -*-MIDAS-*- ;;; ************************************************************** ;;; ***** MACLISP ****** NEW MULTIPLE FILE I/O FUNCTIONS ********* ;;; ************************************************************** ;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY ** ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) ******* ;;; ************************************************************** PGBOT [QIO] SUBTTL I/O CHANNEL ALLOCATOR ;;; ALCHAN ALLOCATES AN I/O CHANNEL FOR USE. ;;; THE "CHANNEL NUMBER" IS AN INDEX INTO THE CHANNEL TABLE. .SEE CHNTB ;;; FOR ITS AND DEC10, THIS IS ALSO THE CHANNEL NUMBER USED TO ;;; COMMUNICATE WITH THE TIMESHARING SYSTEM. (FOR DEC20, A ;;; SEPARATE JFN MUST BE ALLOCATED WITH THE GTJFN JSYS.) ;;; ALCHAN EXPECTS THE SAR FOR THE FILE ARRAY TO BE IN A, ;;; AND RETURNS THE CHANNEL NUMBER IN F, SKIPPING IF SUCCESSFUL. ;;; THE FILE ARRAY MUST HAVE ITS TTS.CL BIT SET. ;;; THE CHANNEL NUMBER IS INSTALLED IN THE FILE'S F.CHAN SLOT. ;;; USER INTERRUPTS TURNED OFF, PLEASE. CLOBBERS R. ;;; MAY INVOKE A GARBAGE COLLECTION TO FREE UP CHANNELS. ALCHAN: HRRZS (P) ALCHN0: MOVNI F,LCHNTB-2 ;SCAN CHANNEL TABLE ALCHN1: SKIPN R,CHNTB+LCHNTB-1(F) JRST ALCHN3 ;FOUND A FREE CHANNEL JUMPL R,ALCH1A ;NEGATIVE, RESERVED MOVE R,TTSAR(R) TLNE R,TTS JRST ALCHN2 ;SEMI-FREE ALCH1A: AOJLE F,ALCHN1 ;DON'T CHECK CHANNEL 0 (NEVER FREE) SKIPGE (P) ;SKIP IF FIRST TIME POPJ P, ;LOSEY LOSEY HRROS (P) ;SET SWITCH PUSH P,[555555,,ALCHN0] JRST AGC ;HOPE GC WILL RECLAIM A FILE ARRAY ALCHN2: MOVEI F,LCHNTB-1(F) IT$ .CALL ALCHN9 ;CLOSE CHANNEL TO BE SURE IT$ .LOSE 1400 IFN D10,[ MOVEI R,(F) LSH R,27 IOR R,[RELEASE 0,0] ;RELEASE CHANNEL TO BE SURE XCT R ] ;END OF IFN D10 SKIPA ALCHN3: MOVEI F,LCHNTB-1(F) MOVE R,TTSAR(A) ;INSTALL CHANNEL NUMBER MOVEM F,F.CHAN(R) MOVEM A,CHNTB(F) ;RESERVE CHANNEL JRST POPJ1 ;WIN WIN - SKIP RETURN IFN ITS,[ ALCHN9: SETZ SIXBIT \CLOSE\ ;CLOSE I/O CHANNEL 400000,,F ;CHANNEL # ] ;END OF IFN ITS ;;; ALFILE CREATES A MINIMAL FILE ARRAY (OF LENGTH LOPOFA), ;;; AND ALLOCATES A CHANNEL FOR IT. IT EXPECTS A DEVICE NAME ;;; IN TT (FOR DEC20, TT AND D) WHICH IS INSTALLED IN THE ;;; F.DEV AND F.RDEV SLOTS OF THE FILE ARRAY. ;;; THIS IS USEFUL FOR ROUTINES WHICH WANT TO HACK ON A ;;; RANDOM CHANNEL BUT DON'T NEED A FULL-BLOWN FILE ARRAY. ;;; A FILE ARRAY IS NEEDED FOR THE SAKE OF THE CHANNEL TABLE .SEE CHNTB ;;; AND FOR THE GARBAGE COLLECTOR; IF THE FILE ARRAY IS ;;; GARBAGE COLLECTED, SO IS THE ASSOCIATED CHANNEL. ;;; THE FILE ARRAY ALSO MUST CONTAIN AT LEAST A DEVICE ;;; NAME SO PRIN1 CAN WIN. .SEE PRNFL ;;; CLOBBERS PRACTICALLY ALL ACS. ;;; THE ARRAY GC POINTER IS SET TO PROTECT THE FIRST SLOT ONLY. ;;; RETURNS FILE ARRAY IN A, CHANNEL NUMBER IN F. ;;; SKIPS ON SUCCESS; FAILS IF ALCHAN CAN'T GET A CHANNEL. ALFILE: LOCKI PUSH FXP,TT MOVEI TT,LOPOFA ;LENGTH OF PLAIN OLD FILE ARRAY MOVSI A,-1 ;GET ONLY A SAR PUSHJ P,MKLSAR MOVSI TT,TTS ;SET CLOSED BIT IORB TT,TTSAR(A) MOVSI T,AS ;SET FILE ARRAY BIT (MUST DO IORB T,ASAR(A) ; IN THIS ORDER!) HRROS -1(T) ;GC SHOULD PROTECT ONLY ONE SLOT POP FXP,T MOVEM T,F.DEV(TT) ;INSTALL DEVICE NAME 20% MOVEM T,F.RDEV(TT) MOVSI T,FBT.CM ;PREVENT GC FROM TRYING TO MOVEM T,F.MODE(TT) ; UPDATE NONEXISTENT POINTERS PUSHJ P,ALCHAN JRST UNLKPJ AOS (P) ;WE SKIP IFF ALCHAN DOES MOVSI TT,TTS ANDCAM TT,TTSAR(A) UNLKPJ: UNLKPOPJ SUBTTL FILE OBJECT CHECKING ROUTINES ;;; JSP TT,XFILEP ;;; SKIPS IFF THE OBJECT IN AR1 IS A FILE ARRAY. CLOBBERS R. ;;; MUST SAVE T .SEE FLFROB SFA% AFOSP: AFILEP: MOVEI AR1,(A) SFA% XFOSP: XFILEP: MOVEI R,(AR1) LSH R,-SEGLOG MOVE R,ST(R) TLNN R,SA JRST (TT) MOVE R,ASAR(AR1) ;MUST ALSO HAVE FILE BIT SET TLNN R,AS JRST (TT) JRST 1(TT) FILEP: JSP TT,AFILEP ;SUBR 1 JRST FALSE JRST TRUE IFN SFA,[ ; PARALLEL TOO AFILEP/XFILEP BUT SKIPS ONCE FOR FILE-OBJECT, AND TWICE ; FOR SFA-OBJECT AFOSP: MOVEI AR1,(A) XFOSP: MOVEI R,(AR1) LSH R,-SEGLOG MOVE R,ST(R) TLNN R,SA ;MUST BE A SAR JRST (TT) MOVE R,ASAR(AR1) ;DOES IT HAVE FILE BIT SET? TLNE R,AS JRST 1(TT) ;YES, SINGLE SKIP TLNE R,AS.SFA ;AN SFA? JRST 2(TT) ;YES, DOUBLE SKIP JRST (TT) ;ELSE ERROR RETURN ] ;END IFN SFA ;;; THESE ROUTINES ACCEPT A FILE ARRAY IN AR1 AND CHECK WHETHER ;;; IT IS OF THE DESIRED TYPE. IF NOT, A WTA ERROR OCCURS. ;;; LEAVES TTSAR IN TT AND USER INTS LOCKED IF SUCCESSFUL. ;;; CLOBBERS T, TT, AND R. SAVES D (SEE FILEPOS) AND F. OFILOK: JSP T,FILOK0 ;TYPICAL INVOCATION: TTS,,TTS ; DESIRED BITS,,MASK SIXBIT \NOT OUTPUT FILE!\ ; ERROR MSG IF FAIL IFILOK: JSP T,FILOK0 0,,TTS SIXBIT \NOT INPUT FILE!\ ATFLOK: JSP T,FILOK0 0,,TTS SIXBIT \NOT ASCII FILE!\ ATOFOK: JSP T,FILOK0 TTS,,TTS SIXBIT \NOT ASCII OUTPUT FILE!\ ATIFOK: JSP T,FILOK0 0,,TTS SIXBIT \NOT ASCII INPUT FILE!\ TFILOK: JSP T,FILOK0 TTS,,TTS SIXBIT \NOT TTY FILE!\ TIFLOK: JSP T,FILOK0 TTS,,TTS SIXBIT \NOT TTY INPUT FILE!\ TOFLOK: JSP T,FILOK0 TTS,,TTS SIXBIT \NOT TTY OUTPUT FILE!\ XIFLOK: JSP T,FILOK0 TTS,,TTS SIXBIT \NOT BINARY INPUT FILE!\ XOFLOK: JSP T,FILOK0 TTS,,TTS SIXBIT \NOT BINARY OUTPUT FILE!\ FILOK: JSP T,FILOK0 0,,0 NFILE: SIXBIT \NOT FILE!\ FILOK0: LOCKI CAIE AR1,TRUTH ;T => TTY FILE ARRAY JRST FILOK1 MOVSI TT,TTS TSNE TT,(T) ;IF DON'T CARE ABOUT I/O TDNE TT,(T) ; OR SPECIFICALLY WANT OUTPUT SKIPA AR1,V%TYO ; THEN USE TTY OUTPUT HRRZ AR1,V%TYI ;USE TTY INPUT ONLY IF NECESSARY FILOK1: JSP TT,XFILEP ;SO IS IT A FILE ARRAY? JRST FILNOK ;NOPE - LOSE MOVE TT,TTSAR(AR1) XOR TT,(T) HLL T,TT MOVE TT,TTSAR(AR1) ;WANT TO RETURN TTSAR IN TT TLNE T,@(T) JRST FILNOK TLNN TT,TTS POPJ P, ;YEP - WIN SKIPA TT,[[SIXBIT \FILE HAS BEEN CLOSED!\]] FILNOK: MOVEI TT,1(T) EXCH A,AR1 UNLOCKI %WTA (TT) EXCH A,AR1 JRST FILOK0 SUBTTL CONVERSION: NAMELIST => SIXBIT ;;; A NAMELIST IN A IS CONVERTED TO "SIXBIT" FORMAT ON THE FIXNUM PDL. ;;; "SIXBIT" FORMAT IS ACTUALLY SIXBIT FOR SOME OPERATING SYSTEMS, ;;; BUT MAY BE ANY ANY FORM WHATSOEVER AS LONG AS ALL ROUTINES WHICH ;;; CLAIM TO UNDERSTAND "SIXBIT" FORM AGREE ON WHAT THAT FORM IS. ;;; (SOME ROUTINES WHICH DO I/O DEPEND ON THIS FORMAT, FOR EXAMPLE ;;; ITS ROUTINES WHICH USE THE OPEN SYMBOLIC SYSTEM CALL.) ;;; "SIXBIT" FORMAT IS DEFINED AS FOLLOWS: ;;; ;;; FOR ITS: ;;; ;;; ;;; ;TOP OF STACK ;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO ;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE). ;;; ;;; FOR DEC10: ;;; ;;; ;;; ;TOP OF STACK ;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO ;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE), ;;; EXCEPT FOR THE PPN, FOR WHICH 777777 INDICATES AN OMITTED HALFWORD. ;;; ;;; FOR DEC20: ;;; ;;; ;;; ;;; ;TOP OF STACK ;;; THE ENTRIES HERE ARE NOT SINGLE WORDS, BUT ARE OF ;;; RESPECTIVE LENGTHS (IN WORDS) L.6DEV, L.6DIR, L.6FNM, ;;; L.6EXT, L.6VRS. ;;; ;;; NOTE THAT FOR ALL SIXBIT FORMATS THE TOTAL LENGTH OF THE ;;; SIXBIT FORMAT IS L.F6BT. THIS DIVIDES INTO TWO PARTS: ;;; THE DEVICE/DIRECTORY, OF LENGTH L.D6BT, AND THE FILE NAME ;;; PROPER, OF LENGTH L.N6BT. ;;; ;;; THERE ARE FOUR KINDS OF FILE NAME SPECIFICATIONS. ;;; ONE IS A FILE OBJECT, WHICH IMPLIES THE NAME USED TO OPEN IT. ;;; ONE IS AN ATOMIC SYMBOL, WHICH IS TREATED AS A NAMESTRING. ;;; THE OTHER TWO ARE NAMELISTS, UREAD-STYLE AND NEWIO-STYLE. ;;; NEWIO-STYLE NAMELISTS HAVE NON-ATOMIC CARS, WHILE UREAD-STYLE ;;; NAMELISTS HAVE ATOMIC CARS. UREAD-STYLE NAMELISTS ARE MOSTLY ;;; FOR COMPATIBILITY WITH OLDIO, AND FOR USER CONVENIENCE. ;;; AS OF 4/14/80, USER HUNKS, THAT IS "EXTENDS" ARE PERMITTED TO ;;; APPEAR AS "NAMELISTS", IN WHICH CASE THEY ARE SENT THE MESSAGE ;;; "NAMESTRING"; THEY ARE EXPECTED TO RETURN A SYMBOL, WHICH IS ;;; THEN TREATED AS IF IT WERE HANDED IN DIRECTLY. ;;; ;;; IN A NEWIO-STYLE NAMELIST, THE CAR IS A DEVICE/DIRECTORY ;;; SPECIFICATION, AND THE CDR A FILE NAME SPECIFICATION. ;;; IN PRINCIPLE EACH IS A LIST OF ARBITRARY LENGTH. ;;; IN PRACTICE, THERE IS A LIMIT FOR EACH OF THE PDP-10 ;;; IMPLEMENTATIONS. THE CANONICAL NAMELIST FORMAT FOR ;;; EACH SYSTEM IS AS FOLLOWS: ;;; ITS: (( ) ) ;;; TOPS10: (( ( )) ) ;;; SAIL: (( ( )) ) ;;; CMU: (( ) ) ;;; CMU ALSO ALLOWS TOPS10-STYLE NAMELISTS. ;;; TENEX: (( ) ) ;;; TOPS20: (( ) ) ;;; ;;; ALL COMPONENTS ARE NOMINALLY ATOMIC SYMBOLS, EXCEPT AND , ;;; WHICH ARE FIXNUMS. IF THE USER SUPPLIES A COMPONENT WHICH IS NOT ;;; A SYMBOL (AND IT CAN EVEN BE NON-ATOMIC IF THERE IS NO AMBIGUITY ;;; AS TO FORMAT), THEN IT IS EXPLODEC'D WITH BASE=10., PRINLEVEL=PRINLENGTH=NIL, ;;; AND *NOPOINT=T. A COMPONENT MAY BE "OMITTED" BY USING THE ATOMIC ;;; SYMBOL *. THIS DOES NOT MEAN A WILDCARD, BUT ONLY AN OMITTED COMPONENT. ;;; ;;; IF THE USER SUPPLIES A NAMELIST NOT IN CANONICAL FORM, THE CAR AND CDR ;;; ARE INDEPENDENTLY CANONICALIZED. THE CAR CAN BE ACANONICAL ONLY BY ;;; BEING A SINGLETON LIST; IN THIS CASE AN ATTEMPT IS MADE TO DECIDE ;;; WHETHER IT IS A DEVICE OR DIRECTORY SPECIFICATION. THIS IS DONE IN ;;; DIFFERENT WAYS ON DIFFERENT SYSTEMS. ON TOPS10, FOR EXAMPLE, AN ATOMIC ;;; SPECIFICATION IS NECESSARY A DEVICE AND NOT A PPN. ON THE OTHER HAND, ;;; ON ITS A LIST OF STANDARD DEVICE NAMES IS CHECKED. ;;; THE CDR CAN BE ACANONICAL BY BEING TOO SHORT, OR BY BEING A DOTTED LIST, ;;; OR BOTH. COMPONENTS ARE TAKEN IN ORDER UNTIL AN ATOMIC CDR IS REACHED. ;;; IF THIS CDR IS NIL, ALL REMAINING COMPONENTS ARE TAKEN TO BE *. ;;; OTHERWISE, ALL REMAINING COMPONENTS ARE * EXCEPT THE LAST, WHICH IS ;;; THAT ATOM IN THE CDR. ;;; ;;; A UREAD-STYLE NAMELIST IS NOMINALLY IN THE FORM (A B C D), WHERE ;;; A, AT LEAST, MUST BE ATOMIC. IT IS INTERPRETED AS IF IT WERE CONVERTED ;;; TO THE FORM ((C D) A B) [DEC20: ((C D) A * B)], AND THEN TREATING IT AS ;;; AN ORDINARY NAMELIST. (IF C AND D ARE MISSING, THEN (*) IS USED INSTEAD ;;; OF NIL AS THE CAR OF THE CONSTRUCTED NAMELIST. NML6BT: JSP T,QIOSAV ;SAVE REGISTERS NML6B5: PUSH P,A HLRZ A,(A) ;CHECK CAR OF NAMELIST JSP T,STENT JUMPGE TT,NML6B2 ;JUMP IF UREAD-STYLE NAMELIST PUSHJ P,NML6DV ;CONVERT DEVICE/DIRECTORY SPECIFICATION NML6B4: JRST NML6B0 ;SKIPS UNLESS CONVERSION FAILED HRRZ A,@(P) PUSHJ P,NML6FN ;CONVERT FILE NAMES (LEAVES TAIL IN A) JUMPE A,POP1J ;SUCCEED UNLESS TOO MANY FILE NAMES NML6BZ: POPI FXP,L.N6BT ;POP FILE NAME CRUD NML6B0: POPI FXP,L.D6BT ;POP DEVICE/DIRECTORY CRUD POP P,A ;POP ORIGINAL ARGUMENT WTA [INCORRECTLY FORMED NAMELIST!] JRST NML6B5 NML6B2: HRRZ A,(P) ;HERE FOR UREAD-STYLE NAMELIST PUSHJ P,NML6UF ;CONVERT FILE NAMES, BUT AT MOST TWO OF THEM PUSHJ P,NML6DV ;NOW CONVERT THE DEVICE/DIRECTORY JRST NML6BZ ;NOTE THAT POPI'S COMMUTE AT NML6BZ! ;AT THIS POINT THE WORDS ON FXP ARE IN THE WRONG ORDER, SO WE SHUFFLE THE STACK. IFN ITS+D10,[ POP FXP,TT ;DIRECTORY POP FXP,T ;DEVICE EXCH T,-1(FXP) ;EXCH DEVICE WITH FN1 EXCH TT,(FXP) ;EXCH DIR WITH FN2 PUSH FXP,T ;PUSH FN1 PUSH FXP,TT ;PUSH FN2 ] ;END OF IFN ITS+D10 IFN D20,[ MOVEI T,-L.F6BT+1(FXP) HRLI T,-L.N6BT PUSH FXP,(T) ;COPY THE FILE NAMES TO THE TOP AOBJN T,.-1 ; OF THE STACK MOVEI T,-L.F6BT-L.N6BT+1(FXP) HRLI T,-L.F6BT+1(FXP) BLT T,-L.N6BT(FXP) ;COPY ENTIRE "SIXBIT" SET DOWNWARD POPI FXP,L.N6BT ;POP OFF EXTRANEOUS CRUD ] ;END OF IFN D20 JRST POP1J ;;; CONVERT FILE NAME LIST IN A TO "SIXBIT" FORM ON FXP. ;;; RETURNS THE UNUSED TAIL OF THE LIST IN A. ;;; NML6UF IS LIKE NML6FN, BUT NEVER GOBBLES MORE THAN TWO NAMES. IFN D20,[ DFNWD: ASCII \*\ ;DEFAULT FILE-NAME WORD DFFNWD: ASCII \FASL\ NML6FN: TDZA T,T NML6UF: SETO T, ;UREAD-STYLE DISTINCTION ONLY MATTERS TO DEC20 HRLM T,(P) PUSHN FXP,L.6FNM+L.6EXT+L.6VRS ;PUSH APPROPRIATE NUMBER OF WORDS MOVE T,DFNWD ;INITIALIZE FIELDS TO '*' IF NOT SUPPLIED MOVEM T,-L.6VRS+1(FXP) ;VERSION NUMBER? MOVEM T,-L.6EXT-L.6VRS+1(FXP) ;EXTENSION MOVEM T,-L.6FNM-L.6EXT-L.6VRS+1(FXP) ;FILE NAME ] ;END OF IFN D20 IFE D20,[ DFNWD: SIXBIT \*\ ;DEFAULT FILE-NAME WORD DFFNWD: ;DEFAULT FASL-FILE-NAME WORD 10% SIXBIT \FASL\ 10$ SIXBIT \FAS\ NML6FN: NML6UF: REPEAT L.N6BT, PUSH FXP,DFNWD ;PUSH ROOM FOR THE FILE NAMES ] ;END OF IFE D20 JUMPE A,CPOPJ ;NULL LIST => ALL NAMES OMITTED PUSH P,A JSP T,STENT JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT HLRZ A,(A) 20% PUSHJ P,SIXMAK ;CONVERT FIRST COMPONENT TO SIXBIT, 20% MOVEM TT,-1(FXP) ; AND CALL IT FILE NAME 1 IFN D20,[ PUSHJ P,PNBFMK ;CONVERT FIRST COMPONENT TO ASCIZ, MOVEI T,-L.6FNM-L.6EXT-L.6VRS+1(FXP) ; AND CALL IT THE FILE NAME HRLI T,PNBUF BLT T,-L.6EXT-L.6VRS(FXP) MOVEI T,177_1 ;MASK FOR LAST BYTE IN AN ASCII WORD ANDCAM T,-L.6EXT-L.6VRS(FXP) ;MAKE SURE LAST BYTE IS NULL ] ;END OF IFN D20 HRRZ A,@(P) JUMPE A,POP1J ;EXIT IF ALL DONE MOVEM A,(P) IFN D20,[ JSP T,STENT JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT HLRZ A,(A) PUSHJ P,PNBFMK ;CONVERT NEXT COMPONENT TO ASCIZ, MOVEI T,-L.6EXT-L.6VRS+1(FXP) ; AND CALL IT THE EXTENSION HRLI T,PNBUF BLT T,-L.6VRS(FXP) MOVEI T,177_1 ;MASK FOR LAST BYTE IN AN ASCII WORD ANDCAM T,-L.6VRS(FXP) ;MAKE SURE LAST BYTE IS NULL HRRZ A,@(P) JUMPE A,POP1J ;EXIT IF ALL DONE HRRZ T,(A) ;IF 3 COMPONENTS REMAIN, THEN VERSION EXISTS HRRZ T,(T) SKIPN T SKIPL -1(P) ;FOR UREAD-STYLE NAMELISTS, READ AT MOST SKIPA ; TWO COMPONENTS JRST NML6F4 MOVEM A,(P) NML6F5: ] ;END OF IFN D20 JSP T,STENT JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT HLRZ A,(A) NML6F2: IFE D20,[ PUSHJ P,SIXMAK ;CONVERT LAST COMPONENT TO SIXBIT, 10$ TRZ TT,-1 ; TRUNCATING TO 3 CHARS FOR DEC10, MOVEM TT,(FXP) ; AND CALL IT FILE NAME 2 ] ;END OF IFN D20 IFN D20,[ PUSHJ P,PNBFMK ;CONVERT LAST COMPONENT TO ASCIZ, MOVEI T,-L.6VRS+1(FXP) ; AND CALL IT THE VERSION HRLI T,PNBUF BLT T,(FXP) MOVEI T,177_1 ;MASK FOR LAST BYTE IN AN ASCII WORD ANDCAM T,(FXP) ;MAKE SURE LAST BYTE IS NULL ] ;END OF IFN D20 NML6F4: HRRZ A,@(P) JRST POP1J NML6F3: SETZM (P) 20% JRST NML6F2 20$ JRST NML6F4 ;;; CONVERTS A DEVICE/DIRECTORY SPECIFICATION IN A TO "SIXBIT" FORM ON FXP. ;;; PERFORMS DEVICE/DIRECTORY DISAMBIGUATION. SKIPS ON SUCCESS. NML6DV: PUSH FXP,DFNWD ;PUSH ROOM FOR DEV NAME 20$ PUSHN FXP,L.6DEV-1 ;PUSH ROOM FOR THE DEVICE NAME 10$ PUSH FXP,[-1] ;FOR DIR NAME 10% PUSH FXP,DFNWD ;FOR DIR NAME 20$ PUSHN FXP,L.6DIR-1 ;PUSH ROOM FOR THE DIRECTORY NAME NML6D0: JUMPE A,POPJ1 ;NULL SPEC => DEFAULTS HRRZ B,(A) HLRZ A,(A) PUSH P,B NML6PP: 10$ JSP T,SPATOM ;FOR DEC-10, A NON-ATOMIC ITEM MUST BE A PPN 10$ JRST NML6D7 20$ PUSHJ P,PNBFMK ;GET THE "SIXBIT" FORM OF DEVICE IFE D20,[ PUSH P,A PUSH P,B PUSHJ P,SIXMAK POP P,B POP P,A ] ;END IFE D20 SKIPE (P) ;FOR MORE THAN ONE ITEM IN LIST, THEN THE JRST NML6D1 ; FIRST MUST BE A DEVICE PUSHJ P,IDND ;DISAMBIGUATE THIS MESS - SKIP IF DEVICE JRST NML6D8 ;NO SKIP MEANS NO INFO - MAYBE DIRECTORY NAME? JRST NML6D1 ;SKIP ONE MEANS DEFINITELY A DEVICE NAME POP P,B JRST NML6D0 ;SKIP TWO MEANS PPN/DIRECTORY TRANSLATION NML6D1: ;IT'S DEFINITELY A DEVICE NAME 20% MOVEM TT,-L.D6BT+1(FXP) IFN D20,[ NML6D3: MOVEI T,-L.6DEV-L.6DIR+1(FXP) HRLI T,PNBUF BLT T,-L.6DIR+1(FXP) MOVEI T,177_1 ;MASK FOR LAST BYTE IN AN ASCII WORD ANDCAM T,-L.6DIR(FXP) ;MAKE SURE LAST BYTE IS NULL ] ;END OF IFN D20 SKIPN (P) JRST POP1J1 ;SUCCESS IF NO DIRECTORY SPEC HLRZ A,@(P) IFN D10,[ PUSHJ P,PPNGET ;TRY PPN PROPERTY SKIPN A ;USE IT IF IT EXISTS HLRZ A,@(P) ;ELSE USE THE USER SPECIFIED FROB ] ;END IFN D10 HRRZ B,@(P) MOVEM B,(P) ;HERE IS WHERE IT HITS THE FAN - NO TWO SYSTEMS HAVE THE SAME DIRECTORY SPEC FORMAT! IFN ITS, PUSHJ P,SIXMAK ;FOR ITS IT IS A PLAIN SIXBIT NAME IFN D20, PUSHJ P,PNBFMK ;FOR D20 IT IS ASCII IFN D10,[ NML6D8: SETO TT, CAIN A,Q. ;* AS A PPN STRING IS TAKEN TO MEAN (* *) JRST NML6D4 JSP T,SPATOM JRST NML6D7 ;NON-ATOMIC => TOPS10-STYLE SA% SKIPN CMUP JRST POP1J ;AN ATOMIC DIRECTORY IS ILLEGAL FOR TOPS10/SAIL IFE SAIL,[ PUSHJ P,PNBFMK MOVEI TT,PNBUF ;0,,ADDRESS OF CMU PPN STRING CMUDEC TT, ;CMUDEC WILL CONVERT A STRING TO A PPN WORD JRST POP1J ;FAIL IF NOT A VALID CMU PPN JRST NML6D4 ] ;END OF IFE SAIL NML6D7: HLRZ B,(A) ;B GETS PROJECT HRRZ C,(A) HLRZ A,(C) ;A GETS PROGRAMMER HRRZ C,(C) JUMPN C,POP1J ;FAIL IF THREE ITEMS IN THE PPN SPEC IFE SAIL,[ CAIN B,Q. ;* MEANS AN OMITTED COMPONENT SKIPA D,[,,-1] JSP T,FXNV2 ;OTHERWISE EXPECT A FIXNUM CAIN A,Q. SKIPA TT,[,,-1] JSP T,FXNV1 TLNN TT,-1 TLNE D,-1 JRST POP1J ;NUMBERS MUST FIT INTO HALFWORDS HRLI TT,(D) ] ;END OF IFE SAIL IFN SAIL,[ PUSH P,B CAIN A,Q. ;* MEANS AN OMITTED COMPONENT SKIPA TT,[0,,-1] PUSHJ P,SIXMAK ;OTHERWISE GET SIXBIT PUSHJ P,SARGHT ;RIGHT JUSTIFY IT PUSH FXP,TT POP P,A CAIN A,Q. ;* MEANS AN OMITTED COMPONENT SKIPA TT,[0,,-1] PUSHJ P,SIXMAK ;OTHERWISE GET SIXBIT PUSHJ P,SARGHT ;RIGHT JUSTIFY IT POP FXP,D TLNN TT,-1 TLNE D,-1 JRST POP1J ;NO MORE THAN 3 CHARS APIECE MOVSS TT HRRI TT,(D) ] ;END OF IFN SAIL ] ;END OF IFN D10 ;NOW WE HAVE THE SNAME/PPN IN TT FOR ITS/D10, OR DIRECTORY IN PNBUF FOR D20 10% NML6D8: NML6D4: 20% MOVEM TT,(FXP) IFN D20,[ MOVEI T,-L.6DIR+1(FXP) HRLI T,PNBUF BLT T,(FXP) MOVEI T,177_1 ;MASK FOR LAST BYTE IN AN ASCII WORD ANDCAM T,(FXP) ] ;END OF IFN D20 SKIPN (P) ;WE WIN IFF THERE ARE NO MORE ITEMS TO PARSE AOS -1(P) JRST POP1J IFN SAIL,[ ;RIGHT JUSTIFY SIXBIT WORD IN TT SARGHT: SKIPE TT ;IF NOTHING THERE WE DON'T WANT TO LOOP TRNE TT,77 ;ANYTHING IN HIGH SIXBIT BYTE? POPJ P, ;YUP, IT IS THEREFORE LEFT-JUSTIFIED LSH TT,-6 ;ELSE GET RID OF THE LEADING BLANK JRST SARGHT ;AND PROCEED WITH TEST ] ;END IFN SAIL ;;; INSUFFERABLE DEVICE NAME DISTINGUISHER - SKIP.RETURN IF ARG IS DEVICE ;;; A NAME IS IN TT IN SIXBIT (ITS/CMU) OR IN PNBUF IN ASCII (D20). ;;; ACC A HOLDS POINTER TO THE SYMBOL FROM WHICH "NAME" WAS TRANSLATED. ;;; TRIES TO DECIDE WHETHER A NAME IS A DEVICE NAME OR A DIRECTORY NAME. ;;; FOR ITS, IT IS A DEVICE NAME IFF, AFTER STRIPPING OFF TRAILING DIGITS, ;;; IT IS IN THE TABLE OF KNOWN DEVICE NAMES. ;;; FOR CMU, WE USE THE DEVCHR UUO TO TEST EXISTENCE. ;;; FOR D20, WE USE THE STDEV JSYS TO TEST EXISTENCE. ;;; SKIPS IF A DEVICE NAME. MUST PRESERVE A AND TT. IFN ITS,[ ;;; BEWARE! THIS TABLE IS SORTED ALPHABETICALLY, AND THAT IS REQUIRED BY ;;; THE SUPER-HAIRY BINARY SORT HACK ABOVE. TABLE MUST BE AN EXACT POWER OF ;;; TWO IN LENGTH SO WE CAN USE SUPER-WINNING BINARY SEARCH METHOD. IDNTB: IRP X,,[AI,AIAR,AIDIR,AR,ARC,BOJ,CLA,CLI,CLO,CLU,COM,COR DIR,DK,DM,DMAR,DMDIR,DSK,ERR,JOB,LPT,MC,MCAR,MCDIR,ML,MLAR,MLDIR MT,NUL,OJB,P,PK,PTP,PTR,S,SPY,ST,STY,SYS,T,TPL,TTY,TY,USR,UT] SIXBIT \X\ TERMIN LIDNTB==:.-IDNTB HAOLNG LOG2IDNTB,<.-IDNTB-1> REPEAT <1_LOG2IDNTB>-LIDNTB,[-1 ] ;END OF REPEAT <1_LOG2IDNTB>-LIDNTB, IDNDLS: REPEAT 6,[ROTC TT-1,<.RPCNT+1>*6 ] ;END OF REPEAT 6, POPJ P, ;STANDARD EXIT IF TOO MANY SHIFTS ] ;END OF IFN ITS PPNGET: PUSH P,B ;Don't go around clobbering stuff PUSH FXP,TT ;CHECK TO SEE IF SYMBOL HAS PPN PROPERTY JSP T,SPATOM ; AND USE `(DSK ,(proj prog)) IF FOUND MOVE A,CIN0 ;A LISP "0", IN ORDER TO CONFUSE "GET" MOVEI B,QPPN PUSHJ P,$GET POP P,B ;B may still contain the directory name. JRST RSTX1 IDND: PUSH P,A PUSHJ P,PPNGET JUMPE A,IDNDA HRRZM A,(P) ;AHA! A PPN TRANSLATION! AOS -1(P) ;SKIP 2 FOR PPN TRANSLATION AOS -1(P) JRST POPAJ IDNDA: IFN D20,[ LOCKI ;LOCK OUT INTERRUPTS AROUND THE JSYS HRROI A,PNBUF STDEV ;CONVERT DEVICE STRING TO DEVICE DESIGNATOR SKIPA ;ERROR - NO SUCH DEVICE - NO SKIP ON FAILURE ] ;END OF IFN D20 IFN D10,[ MOVE F,TT DEVCHR F, ;GET CHARACTERISTICS OF DEVICE SKIPE F ; ZERO WORD MEANS DEVICE DOESN'T EXIST ] ;END OF IFN D10 IFN ITS,[ IDNDA: MOVE F,TT ;SAVE TT IN F MOVNI R,6 IDND1: SETZ TT-1, ;WE WILL STRIP DIGITS AND NULLS FROM END ROTC TT-1,-6 ; BY ROTATING THEM INTO THE PREVIOUS AC ROT TT-1,6 JUMPE TT-1,IDND2 CAIL TT-1,'0 CAILE TT-1,'9 JRST IDND3 ;EXIT IF NEITHER DIGIT NOR NULL IDND2: AOJL R,IDND1 POPJ P, ;SHIFTED OUT ALL CHARACTERS? IDND3: ROT TT-1,-6 XCT IDNDLS+6(R) ;SHIFT BACK SETZB R,T REPEAT LOG2IDNTB,[ CAML TT,IDNTB+<1_>(R) ADDI R,1_ ] ;END OF REPEAT LOG2IDNTB EXCH TT,F ;RESTORE TT CAMN F,IDNTB(R) ;FALL THRU IF RECOGNIZED DEVICE ] ;END OF IFN ITS ;;; FALL THRU TO HERE IF IT IS A DEVICE IDNDS: AOS -1(P) ;AND IF DEVICE, THEN SKIP ONE ON RETURN IDNDX: ; BUT IF NOT, THEN NO SKIP 20% JRST POPAJ 20$ POP P,A 20$ UNLKPOPJ SUBTTL CONVERSION: SIXBIT => NAMELIST ;;; THIS ROUTINE TAKES "SIXBIT" FORMAT ON FXP AND, ;;; POPPING THEM, RETURNS THE EQUIVALENT CANONICAL NAMELIST. ;;; OMITTED COMPONENTS BECOME *'S. ;;; THE NAMELIST FUNCTION MERELY CONVERTS ARG TO SIXBIT, ;;; THEN BACK TO (CANONICAL) NAMELIST FORM. NAMELIST: PUSHJ P,FIL6BT ;SUBR 1 6BTNML: JSP T,QIOSAV ;MUST ALSO PRESERVE F PUSHN P,1 ;FOR D20, POP THE VERSION (TENEX)/GENERATION (TOPS20) AND CONS IT UP IFN D20,[ REPEAT L.6VRS, POP FXP,PNBUF+L.6VRS-.RPCNT-1 PUSHJ P,6BTNL3 ] ;END OF IFN D20 ;POP THE FILE NAME 2 (ITS)/EXTENSION (D10, TENEX)/TYPE (TOPS20) AND CONS UP IFN ITS+D10, POP FXP,TT IFN D10, TRZ TT,-1 ;D10 EXTENSION IS AT MOST 3 CHARACTERS IFN D20,[ MOVEI T,PNBUF HRLI T,-L.6EXT+1(FXP) BLT T,PNBUF+L.6EXT-1 POPI FXP,L.6EXT ] ;END OF IFN D20 PUSHJ P,6BTNL3 ;POP THE FILE NAME 1 (ITS)/FILE NAME (D10, D20) AND CONS UP IFN ITS+D10, POP FXP,TT IFN D20,[ MOVEI T,PNBUF HRLI T,-L.6FNM+1(FXP) BLT T,PNBUF+L.6FNM-1 POPI FXP,L.6FNM ] ;END OF IFN D20 PUSHJ P,6BTNL3 ;NOW FOR THE DEVICE/DIRECTORY PORTION PUSHN P,1 ;FIRST THE DIRECTORY (WHAT A MESS!) IFN ITS,[ POP FXP,TT PUSHJ P,6BTNL3 ] ;END OF IFN ITS IFN D10,[ POP FXP,TT PUSHJ P,PPNATM PUSHJ P,6BTNL4 ] ;END OF IFN D10 IFN D20,[ MOVEI T,PNBUF HRLI T,-L.6DIR+1(FXP) BLT T,PNBUF+L.6DIR-1 POPI FXP,L.6DIR PUSHJ P,6BTNL3 ] ;END OF IFN D20 ;FINALLY, THE DEVICE NAME 20% POP FXP,TT IFN D20,[ MOVEI T,PNBUF HRLI T,-L.6DEV+1(FXP) BLT T,PNBUF+L.6DEV-1 POPI FXP,L.6DEV ] ;END OF IFN D20 PUSHJ P,6BTNL3 POP P,A POP P,B JRST CONS SA$ 6BTNL9: SKIPA A,[Q.] 6BTNL3: 20% PUSHJ P,SIXATM 20$ PUSHJ P,PNBFAT 6BTNL4: MOVE B,-1(P) PUSHJ P,CONS MOVEM A,-1(P) POPJ P, SUBTTL CONVERSION: SIXBIT => NAMESTRING ;;; THIS ROUTINE TAKES A "SIXBIT" FORMAT FILE SPEC ON FXP ;;; AND GENERATES AN UNINTERNED ATOMIC SYMBOL WHOSE ;;; PRINT NAME IS THE EXTERNAL FORM OF FILE SPECIFICATION. ;;; OMITTED NAMES ARE EITHER NOT INCLUDED IN THE NAMESTRING ;;; OR REPRESENTED AS "*". ;;; THE NAMESTRING AND SHORTNAMESTRING MERELY CONVERT THEIR ;;; ARGUMENTS TO SIXBIT AND THEN INTO NAMESTRING FORM. SHORTNAMESTRING: ;SUBR 1 TDZA TT,TT NAMESTRING: ;SUBR 1 SETO TT, HRLM TT,(P) PUSHJ P,FIL6BT 6BTNMS: MOVEI TT,PNGNK2 HLL TT,(P) ;TO MAKE A NAMESTRING, GET IT INTO PNBUF PUSH P,TT JRST 6BTNS ; AND THEN PNGNK2 WILL MAKE A SYMBOL IFN D20,[ 6BTTLS: PUSHJ P,6BTTLN JRST 6BTNSL X6BTNSL: MOVEI T,L.F6BT ;MAKES STRING IN PNBUF, BUT NO POPPING PUSH FXP,-L.F6BT+1(FXP) ; THE FILE NAMES (WE COPY THEM FIRST) SOJG T,.-1 ] ;END OF IFN D20 6BTNSL: SETO TT, ;IF RETURN ADDRESS SLOT ON THE PDL IS HRLM TT,(P) ; POSITIVE, THEN DO "SHORTNAMESTRING" 6BTNS: JSP T,QIOSAV ;CONVERT "SIXBIT" TO A STRING IN PNBUF ; (BETTER BE BIG ENOUGH!) SETOM LPNF ;SET FLAG SAYING IT FITS IN PNBUF 20% MOVEI R,^Q ;R CONTAINS THE CHARACTER FOR QUOTING 20$ MOVEI R,^V ; PECULIAR CHARACTERS IN COMPONENTS MOVE C,PNBP SKIPL -LQIOSV(P) ;SKIP UNLESS SHORTNAMESTRING JRST 6BTNS0 ;DEVICE NAME (NOT FOR SHORTNAMESTRING, THOUGH) MOVEI TT,-L.D6BT-L.N6BT+1(FXP) SKIPE T,(TT) CAMN T,DFNWD JRST 6BNS0A ;JUMP IF DEVICE NAME OMITTED PUSHJ P,6BTNS1 MOVEI T,": ;9 OUT OF 10 OPERATING SYSTEMS AGREE: IDPB T,C ; ":" MEANS A DEVICE NAME. 6BNS0A: ;FOR ITS AND D20, DIRECTORY NAME COMES NEXT IFN ITS+D20,[ MOVEI TT,-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP) SKIPE T,-L.6DIR-L.N6BT+1(FXP) CAMN T,DFNWD JRST 6BTNS0 ;DIRECTORY NAME OMITTED 20$ MOVEI T,"< ;D20 DIRECTORY NAME APPEARS IN <> 20$ IDPB T,C PUSHJ P,6BTNS1 20$ MOVEI T,"> 20% MOVEI T,"; ;";" MEANS DIRECTORY NAME TO ITS IDPB T,C ] ;END OF IFN ITS+D20 6BTNS0: MOVEI TT,-L.N6BT+1(FXP) ;NOW WE ATTACK THE FILE NAME PUSHJ P,6BTNS1 ;NOW THE FILE NAME 2/EXTENSION/TYPE IFN ITS, MOVEI T,40 IFN D10+D20, MOVEI T,". 10$ PUSH FXP,(FXP) ;EXTRA SLOT FOR D10, IN ORDER 10$ HLLZS (FXP) ; ZERO OUT HALF A WORD MOVEI TT,-L.N6BT+L.6FNM+1(FXP) 10$ SKIPE (TT) IDPB T,C IT% SKIPE (TT) PUSHJ P,6BTNS1 10$ POPI FXP,1 ;FLUSH THE "EXTRA" SLOT IFN D20,[ ;FOR D20, THE VERSION/GENERATION COMES LAST MOVEI TT,-L.6VRS+1(FXP) SKIPE T,(TT) CAMN T,DFNWD JRST 6BTNS8 MOVEI T,". SKIPE TENEXP MOVEI T,"; IDPB T,C PUSHJ P,6BTNS1 ] ;END OF IFN D20 IFN D10,[ ;FOR D10, THE DIRECTORY COMES LAST MOVEI TT,-L.F6BT+L.6DEV+1(FXP) MOVE T,(TT) CAME T,XC-1 ;FORGET IT IF BOTH HALVES OMITTED SKIPL -LQIOSV(P) ;NO DIRECTORY FOR SHORTNAMESTRING JRST 6BTNS8 MOVEI T,91. ;A LEFT BRACKET IDPB T,C IFE SAIL,[ SKIPN CMUP JRST 6BTNS4 HLRZ T,(TT) CAIG T,10 ;ONLY PROJECTS ABOVE 10 ARE IN CMU FORMAT JRST 6BTNS4 PUSHN FXP,2 ;THERE IS A BUG IN DECCMU, BUT PUSHING ZERO WORDS MOVEI T,-1(FXP) ; GETS US AROUND IT HRL T,TT DECCMU T, JRST 6BTNS4 ;ON FAILURE, JUST USE DEC FORMAT MOVEI TT,-1(FXP) TLOA TT,440700 IDPB T,C ;COPY CHARACTERS INTO PNBUF ILDB T,TT JUMPN T,.-2 POPI FXP,2 JRST 6BTNS5 ] ;END OF IFE SAIL 6BTNS4: HLLZ TT,-L.F6BT+L.6DEV+1(FXP) PUSHJ P,6BTNS6 ;OUTPUT PROJECT MOVEI T,", ;COMMA SEPARATES HALVES IDPB T,C HRLZ TT,-L.F6BT+L.6DEV+1(FXP) PUSHJ P,6BTNS6 ;OUTPUT PROGRAMMER 6BTNS5: MOVEI T,93. ;A RIGHT BRACKET IDPB T,C ] ;END OF IFN D10 6BTNS8: PUSHJ FXP,RDAEND ;FINISH OFF THE LAST WORD OF THE STRING SETZM 1(C) POPI FXP,L.F6BT ;POP CRUD OFF STACK MOVEM C,-LQIOSV+2(P) ;CROCK DUE TO SAVED AC C POPJ P, ;;; COME HERE TO ADD A COMPONENT TO THE GROWING NAMESTRING IN PNBUF. ;;; FOR ITS AND D10, THE SIXBIT IS IN TT, AND MUST BE CONVERTED. ;;; FOR DEC20, TT HAS A POINTER TO THE ASCIZ STRING TO ADD. 6BTNS1: IFN ITS+D10,[ SKIPN TT,(TT) ;A ZERO WORD GETS OUTPUT AS "*" MOVE TT,DFNWD 6BTNS2: SETZ T, LSHC T,6 JUMPE T,6BTNS3 10$ CAIE T,133-40 ;FOR DEC-10, BRACKETS MUST 10$ CAIN T,135-40 ; BE QUOTED 10$ JRST 6BTNS3 CAIE T,': 10% CAIN T,'; 10$ CAIN T,'. 6BTNS3: IDPB R,C ;^Q TO QUOTE FUNNY CHARS ADDI T,40 IDPB T,C JUMPN TT,6BTNS2 POPJ P, ] ;END OF IFN ITS+D10 IFN D20,[ SKIPN (TT) MOVEI TT,DFNWD SETZ D, HRLI TT,440700 6BTNS2: ILDB T,TT JUMPE T,CPOPJ TRZE D,1 ;D IS THE PRECEDING-CHAR-WAS-^V FLAG JRST 6BTNS3 IRPC X,,[:;<>=_*@ ,] ;EVEN NUMBER OF GOODIES! IFE .IRPCNT&1, CAIE T,"X .ELSE,[ CAIN T,"X IDPB R,C ;QUOTE FUNNY CHARACTER ] ;END OF .ELSE TERMIN SKIPE TENEXP JRST 6BNS3A ;TOPS-20 Requires more characters to be quoted IRPC X,,[(){}/!"#%&'\|`^~] IFE .IRPCNT&1, CAIE T,"X .ELSE,[ CAIN T,"X IDPB R,C ;QUOTE FUNNY CHARACTER ] ;END OF .ELSE TERMIN CAIE T,91. ;LEFT-SQUARE-BRACKET CAIN T,93. ;RIGHT-SQUARE-BRACKET IDPB R,C 6BNS3A: CAIN T,(R) ;REMEMBER A ^V TRO D,1 6BTNS3: IDPB T,C JRST 6BTNS2 ] ;END OF IFN D20 IFN D10,[ ;;; CONVERT ONE HALF OF A PPN, PUTTING ASCII CHARS IN PNBUF 6BTNS6: JUMPE TT,6BNS6A CAME TT,[-1,,] AOJA TT,6BTNS7 ;ADDING ONE PRODUCES A FLAG BIT 6BNS6A: MOVEI TT,"* ;AN OMITTED HALF IS OUTPUT AS "*" IDPB TT,C POPJ P, 6BNS7A: LSH TT,3+3*SAIL ;ZERO-SUPPRESS OCTAL (TOPS10/CMU), LEFT-JUSTIFY CHARS (SAIL) 6BTNS7: TLNN TT,770000_<3*<1-SAIL>> JRST 6BNS7A ;NOTE THAT THE FLAG BIT GETS SHIFTED TOO 6BNS7B: SETZ T, LSHC T,3+3*SAIL SA% ADDI T,"0 SA$ ADDI T,40 IDPB T,C TRNE TT,-1 ;WE'RE DONE WHEN THE FLAG BIT LEAVES THE RIGHT HALF JRST 6BNS7B POPJ P, ] ;END OF IFN D10 SUBTTL CONVERSION: NAMESTRING => SIXBIT ;;; THIS ONE IS PRETTY HAIRY. IT CONVERTS AN ATOMIC ;;; SYMBOL IN A, REPRESENTING A FILE SPECIFICATION, ;;; INTO "SIXBIT" FORMAT ON FXP. THIS INVOLVES ;;; PARSING A FILE NAME IN STANDARD ASCII STRING FORMAT ;;; AS DEFINED BY THE HOST OPERATING SYSTEM. ;;; FOR D20, THE OPERATING SYSTEM GIVES US SOME HELP. ;;; FOR ITS AND D10, WE ARE ON OUR OWN. IFN ITS+D10,[ ;;; THE GENERAL STRATEGY HERE IS TO CALL PRINTA TO EXPLODEC THE NAMESTRING. ;;; A PARSING COROUTINE TAKES THE SUCCESSIVE CHARACTERS AND INTERPRETS THEM. ;;; EACH COMPONENT IS ASSEMBLED IN SIXBIT FORM, AND WHEN IT IS TERMINATED ;;; BY A BREAK CHARACTER, IT IS PUT INTO ONE OF FOUR SLOTS RESERVED ON FXP. ;;; FOR CMU, WE ALSO ASSEMBLE THE CHARACTERS INTO PNBUF IN ASCII FORM, ;;; SO THAT WE CAN USE THE CMUDEC UUO TO CONVERT A CMU-STYLE PPN. ;;; AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME. ;;; AR2A HOLDS MANY FLAGS DESCRIBING THE STATE OF THE PARSE: NMS==:1,,525252 ;FOR BIT-TYPEOUT MODE NMS.CQ==:1 ;CONTROL-Q SEEN NMS.CA==:2 ;CONTROL-A SEEN IFN D10,[ NMS.DV==:10 ;DEVICE SEEN (AND TERMINATING :) NMS.FN==:20 ;FILE NAME SEEN NMS.DT==:40 ;. SEEN NMS.XT==:100 ;EXTENSION SEEN NMS.LB==:200 ;LEFT BRACKET SEEN NMS.CM==:400 ;COMMA SEEN NMS.RB==:1000 ;RIGHT BRACKET SEEN NMS.ND==:10000 ;NON-OCTAL-DIGIT SEEN NMS.ST==:20000 ;* SEEN ] ;END OF IFN D10 ;;; CONTROL-A IS THE SAIL CONVENTION FOR QUOTING MANY CHARACTERS, BUT WE ;;; ADOPT IT FOR ALL ITS AND D10 SYSTEMS. NMS6BF: POP P,A POPI FXP,L.F6BT+1+1 NMS6B0: WTA [BAD NAMESTRING!] NMS6BT: MOVEI TT,(A) ;DON'T ALLOW FIXNUMS AS NAMESTRINGS LSH TT,-SEGLOG MOVSI R,FX TDNE R,ST(TT) ;A FIXNUM? JRST NMS6B0 ;YES, ILLEGAL AS A NAMESTRING PUSH P,A PUSHN FXP,L.F6BT+1 ;FOUR WORDS FOR FINISHED NAMES, ONE FOR ACCUMULATION MOVEI AR1,(FXP) ;AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME HRLI AR1,440600 PUSH FXP,PNBP ;PARSE THE PPN INTO PNBUF SETZM PNBUF+LPNBUF-1 SETZ AR2A, ;ALL FLAGS INITIALLY OFF HRROI R,NMS6B1 .SEE PR.PRC PUSHJ P,PRINTA ;PRINTA WILL CALL NMS6B1 WITH SUCCESSIVE CHARS IN A TLNE AR2A,NMS.CA+NMS.CQ JRST NMS6BF ;ILLEGAL FOR A QUOTE TO BE HANGING MOVEI A,40 PUSHJ P,(R) ;FORCE A SPACE THROUGH TO TERMINATE LAST COMPONENT IFN D10,[ TLNE AR2A,NMS.LB TLNE AR2A,NMS.RB CAIA JRST NMS6BF ;LOSE IF LEFT BRACKET SEEN BUT NO RIGHT BRACKET ] ;END OF IFN D10 JUMPE AR1,NMS6BF ;AR1 IS ZEROED IF THE PARSING CORUTINE DETECTS AN ERROR POP P,A POPI FXP,2 MOVE T,DFNWD ;CHANGE ANY ZERO COMPONENTS TO "*" SKIPN -3(FXP) MOVEM T,-3(FXP) ;DEVICE NAME IT$ SKIPN -2(FXP) IT$ MOVEM T,-2(FXP) ;SNAME IFN D10,[ MOVE TT,-2(FXP) ;TREAT HALVES OF PPN SEPARATELY TLNN TT,-1 ;A ZERO HALF BECOMES -1 TLO TT,-1 TRNN TT,-1 TRO TT,-1 MOVEM TT,-2(FXP) ] ;END OF IFN D10 SKIPN -1(FXP) MOVEM T,-1(FXP) ;FILE NAME 1 SA$ MOVSI T,(SIXBIT \___\) SKIPN (FXP) MOVEM T,(FXP) ;FILE NAME 2/EXTENSION POPJ P, ;;; THIS IS THE NAMESTRING PARSING COROUTINE NMS6B1: JUMPE AR1,CPOPJ ;ERROR HAS BEEN DETECTED, FORGET THIS CHARACTER CAIN A,^A JRST NMS6BQ CAIN A,^Q TLCE AR2A,NMS.CQ ;FOR A CONTROL-Q, SET THE CONTROL-Q BIT CAIA ;IF IT WAS ALREADY SET, IT'S A QUOTED ^Q POPJ P, ;OTHERWISE EXIT CAIN A,40 ;SPACE? TLZN AR2A,NMS.CQ ;YES, QUOTED? SKIPA ;NO TO EITHER TEST JRST NMS6B9 ;YES TO BOTH, IS QUOTED SPACE CAILE A,40 ;SKIP OF CONTROL CHARACTER OR SPACE JRST NMS6B7 ;WE HAVE ENCOUNTERED A BREAK CHARACTER - DECIDE WHAT TO DO WITH COMPONENT NMS6B8: SKIPN D,(AR1) POPJ P, ;NO CHARACTERS ASSEMBLED YET IT$ SKIPN -2(AR1) ;IF WE HAVE A FILE NAME 1, THIS MUST BE FN2 10$ TLNN AR2A,NMS.DT ;WE HAVE SEEN A DOT, THIS MUST BE THE EXTENSION JRST NMS6B5 ;OTHERWISE THIS IS FILE NAME 1 IT$ SKIPE -1(AR1) ;LOSE IF WE ALREADY HAVE A FILE NAME 2 10$ TLNE AR2A,NMS.XT+NMS.LB+NMS.CM+NMS.RB JRST NMS6BL ;LOSE IF EXTENSION AFTER BRACKETS OR OTHER ONE IT$ MOVEM D,-1(AR1) 10$ HLLZM D,-1(AR1) 10$ TLO AR2A,NMS.XT ;SET FLAG: WE'VE SEEN THE EXTENSION ;COME HERE TO RESTORE THE BYTE POINTER FOR THE NEXT COMPONENT NMS6B6: JUMPE AR1,CPOPJ ;IF AN ERROR HAS BEEN DETECTED, EXIT HRLI AR1,440600 MOVE D,PNBP ;RESET THE PNBUF BYTE POINTER ALSO MOVEM D,1(AR1) 10$ TLZ AR2A,NMS.ND+NMS.ST ;RESET NON-OCTAL-DIGIT AND STAR SEEN FLAGS SETZM (AR1) ;CLEAR ACCUMULATION WORD POPJ P, ;COME HERE FOR FILE NAME 1 NMS6B5: 10$ TLNE AR2A,NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB 10$ JRST NMS6BL ;LOSE IF TOO LATE FOR A FILE NAME MOVEM D,-2(AR1) ;SAVE FILE NAME 1 JRST NMS6B6 ;HERE WITH A NON-CONTROL NON-SPACE CHARACTER NMS6B7: TLZN AR2A,NMS.CQ TLNE AR1,NMS.CA JRST NMS6B9 ;IF CHARACTER QUOTED (FOR ^Q, FLAG IS RESET) CAIN A,": JRST NMS6DV ;: SIGNALS A DEVICE NAME IT$ CAIN A,"; IT$ JRST NMS6SN ;; MEANS AN SNAME IFN D10,[ CAIN A,". JRST NMS6PD ;PERIOD MEANS TERMINATION OF FILE NAME CAIN A,133 JRST NMS6LB ;LEFT BRACKET CAIN A,", JRST NMS6CM ;COMMA CAIN A,135 JRST NMS6RB ;RIGHT BRACKET CAIN A,"* JRST NMS6ST ;STAR ] ;END OF IFN D10 ;HERE TO DUMP A CHARACTER INTO THE ACCUMULATING COMPONENT NMS6B9: IFN D10,[ IFE SAIL,[ SKIPN CMUP JRST .+4 SKIPE PNBUF+LPNBUF-1 TDZA AR1,AR1 ;ASSUME A COMPONENT THAT FILLS PNBUF IS A LOSER IDPB A,1(AR1) ;STICK ASCII CHARACTER IN PNBUF ] ;END OF IFE SAIIL CAIL A,"0 CAILE A,"7 TLO AR2A,NMS.ND ;SET FLAG IF NON-OCTAL-DIGIT NMS6B4: ] ;END OF IFN D10 CAIGE A,140 ;CONVERT LOWER CASE TO UPPER, SUBI A,40 ; AND ASCII TO SIXBIT TLNE AR1,770000 IDPB A,AR1 ;DUMP CHARACTER INTO ACCUMULATING NAME POPJ P, NMS6BQ: TLCA AR2A,NMS.CA ;COMPLEMENT CONTROL-A FLAG NMS6BL: SETZ AR1, ;ZEROING AR1 INDICATES A PARSE ERROR POPJ P, NMS6DV: SKIPE D,(AR1) ;ERROR IF : SEEN WITH NO PRECEDING COMPONENT 10$ ;ERROR AFTER OTHER CRUD 10$ TLNE AR2A,NMS.DV+NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB 10% SKIPE -4(AR1) ;ERROR IF DEVICE NAME ALREADY SEEN JRST NMS6BL MOVEM D,-4(AR1) 10$ TLO AR2A,NMS.DV JRST NMS6B6 ;RESET BYTE POINTER IFN ITS,[ NMS6SN: SKIPE D,(AR1) ;ERROR IF ; SEEN WITHOUT PRECEDING COMPONENT SKIPE -3(AR1) ;ERROR IF WE ALREADY HAVE AN SNAME JRST NMS6BL MOVEM D,-3(AR1) JRST NMS6B6 ;RESET BYTE POINTER ] ;END OF IFN ITS IFN D10,[ NMS6PD: TLNE AR2A,NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB JRST NMS6BL PUSHJ P,NMS6B8 ;DOT SEEN - SEE IF IT TERMINATED THE FILE NAME TLO AR2A,NMS.DT ;SET PERIOD (DOT) FLAG POPJ P, NMS6LB: TLNE AR2A,NMS.LB+NMS.CM+NMS.RB JRST NMS6BL ;LEFT BRACKET ERROR IF ALREADY A BRACKET PUSHJ P,NMS6B8 ;DID WE TERMINATE THE FILE NAME OR EXTENSION? TLO AR2A,NMS.LB ;SET LEFT BRACKET FLAG NMS6L1: SA% HRLI AR1,440300 SA$ HRLI AR1,440600 POPJ P, NMS6CM: LDB D,[360600,,AR1] CAIE D,44 ;ERROR IF NO CHARACTERS AFTER LEFT BRACKET TLNN AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET! JRST NMS6BL SA% TLNE AR2A,NMS.ND+NMS.CM+NMS.RB SA$ TLNE AR2A,NMS.CM+NMS.RB JRST NMS6BL ;ERROR IF NON-OCTAL-DIG, COMMA, OR RGT BRACKET PUSHJ P,NMS6PP ;HACK HALF A PPN JUMPE AR1,CPOPJ HRLM D,-3(AR1) TLO AR2A,NMS.CM ;SET COMMA FLAG SETZM (AR1) ;CLEAR COLLECTING WORD JRST NMS6L1 ;RESET BYTE POINTER NMS6RB: LDB D,[360600,,AR1] SA% SKIPN CMUP TLNE AR2A,NMS.CM ;MUST HAVE COMMA BEFORE RB IN NON-CMU CAIN D,44 ;ERROR IF NO CHARS SINCE COMMA/LEFT BRACKET JRST NMS6BL TLNE AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET TLNE AR2A,NMS.RB ;ERROR IF RIGHT BRACKET ALREADY SEEN JRST NMS6BL IFE SAIL,[ SKIPN CMUP JRST .+3 TLNN AR2A,NMS.CM ;FOR CMU, NO COMMA MEANS A CMU-STYLE PPN JRST NMS6R1 ] ;END OF IFE SAIL PUSHJ P,NMS6PP ;FIGURE OUT HALF A PPN JUMPE AR1,CPOPJ HRRM D,-3(AR1) NMS6R2: TLO AR2A,NMS.RB ;SET RIGHT BRACKET FLAG JRST NMS6B6 ;RESET THE WORLD IFE SAIL,[ NMS6R1: MOVEI D,PNBUF CMUDEC D, ;CONVERT CMU-STYLE PPN TO A WORD JRST NMS6BL ;LOSE LOSE MOVEM D,-3(AR1) ;WIN - SAVE IT AWAY JRST NMS6R2 ] ;END OF IFE SAIL NMS6ST: TLOE AR2A,NMS.ST ;SET STAR FLAG, SKIP IF NOT ALREADY SET TLO AR2A,NMS.ND ;TWO STARS = A NON-DIGIT FOR PPN PURPOSES JRST NMS6B4 NMS6PP: SA% TLNE AR2A,NMS.ND SA% SETZ AR1, ;NON-DIGIT IN PPN IS AN ERROR HRRZI D,-1 TLNE AR2A,NMS.ST ;STAR => 777777 POPJ P, LDB TT,[360600,,AR1] CAIGE TT,22 SETZ AR1, ;MORE THAN SIX DIGITS LOSES MOVNS TT MOVE D,(AR1) LSH D,(TT) ;RIGHT-JUSTIFY THE DIGITS POPJ P, ] ;END OF IFN D10 ] ;END OF IFN ITS+D10 IFN D20,[ ;; Formerly, NMS6BT used to call JFN6BT ;NMS6BA: MOVE A,AR1 NMS6B0: %WTA (T) NMS6BT: MOVEI T,NMSERR MOVEI TT,(A) ;DON'T ALLOW FIXNUMS AS NAMESTRINGS LSH TT,-SEGLOG MOVSI R,FX TDNE R,ST(TT) ;A FIXNUM? JRST NMS6B0 ;YES, ILLEGAL AS A NAMESTRING PUSHJ P,PNBFMK ;STRING OUT CHARACTERS INTO PNBUF MOVEI T,[SIXBIT \NAMESTRING TOO LONG!\] JUMPE AR2A,NMS6B0 ;LOSE IF DIDN'T FIT IN PNBUF SETZ B, IDPB B,AR1 ;TERMINATE STRING WITH A NULL (ZERO) BYTE MOVE AR1,A ;SAVE ORIGINAL ARG IN CASE OF ERROR ;;; THE STRATEGY FOR TENEX IS TO JUST PARSE THE STRING BY HAND, SINCE ;;; PARSE-ONLY GTJFN DOESN'T WORK NMSTNX: PUSHN FXP,L.F6BT ;PUSH APPROPRIATE NUMBER OF WORDS FOR ASCIZ MOVE T,DFNWD ;INITIALIZE FIELDS TO '*' IF NOT SUPPLIED MOVEM T,-L.F6BT+1(FXP) ;DEVICE MOVEM T,-L.F6BT+L.6DEV+1(FXP) ;DIRECTORY MOVEM T,-L.F6BT+L.6DEV+L.6DIR+1(FXP) ;FILE NAME MOVEM T,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+1(FXP) ;EXTENSION MOVEM T,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+L.6EXT+1(FXP) ;VERSION NUMBER? MOVE TT,PNBP ;BYTE POINTER INTO STRING TO BE PARSED LDB A,[350700,,PNBUF] ;GET FIRST BYTE SKIPE TENEXP CAIE A,"; ;CHECK FOR ILLEGAL START OF NAMESTRING CAIN A,". JRST NMSTX2 CAIN A,": JRST NMSTX2 CAIN A,"< ;START OF DIRECTORY FIELD? JRST NMSTX1 ;YES, DEFAULT DEVICE AND GO ON MOVE T,TT ;LOOK FOR FIRST DELIMETER NMSTX6: ILDB A,T ;GET NEXT CHARACTER CAIE A,^V ;QUOTING CHARACTER JRST NMSTX5 IBP T ;NEXT CHARACTER IS NOT DELIMITER JRST NMSTX6 NMSTX5: JUMPE A,NMSTX4 ;TREAT UNDELIMITED STRING AS A NAME ONLY SKIPE TENEXP CAIE A,"; ; CAIN A,". ;FILENAME? JRST NMSTX4 ;YES, COPY FILENAME CAIE A,": ;DEVICE? JRST NMSTX6 ;NOPE, NOT A DELIMITER, TRY NEXT CHARACTER MOVEI R,-L.F6BT+1(FXP) ;POINTER TO DEVICE NAME HRLI R,440700 NMSTX8: ILDB A,TT ;GET NEXT BYTE CAMN T,TT ;DEVICE COPY DONE WHEN WE PICKED UP DELIMETER JRST NMSTX7 ;TRY FOR NEXT FIELD IDPB A,R JRST NMSTX8 NMSTX1: IBP TT ;SKIP OVER DIRECTORY START MOVEI R,-L.F6BT+L.6DEV+1(FXP) HRLI R,440700 ;BYTE POINTER TO DIRECTORY NMSTXE: ILDB A,TT ;GET NEXT BYTE JUMPE A,NMSTX2 CAIN A,"> ;END OF DIRECTORY? JRST NMSTX4 ;YES, MUST HAVE FILENAME THEN IDPB A,R CAIE A,^V ;QUOTING NEXT CHAR? JRST NMSTXE ;NOPE ILDB A,TT IDPB A,R JRST NMSTXE NMSTX7: MOVE A,TT ;COPY BYTE POINTER ILDB A,A ;GET NEXT BYTE OF PATHNAME CAIN A,"< ;DIRECTORY? JRST NMSTX1 ;YES, COPY IT SKIPE TENEXP CAIE A,"; ;AN ILLEGAL DELIMETER? CAIN A,". JRST NMSTX2 ;;; HERE FOR A FILENAME NMSTX4: MOVEI R,-L.F6BT+L.6DEV+L.6DIR+1(FXP) HRLI R,440700 ;BYTE POINTER TO FILENAME FIELD NMSTXC: ILDB A,TT ;GET NEXT SOURCE BYTE JUMPE A,NMSTX9 ;DONE WITH STRING, DEFAULT AND RETURN CAIN A,". JRST NMSTXA ;START ON EXTENSION SKIPN TENEXP JRST .+3 CAIN A,"; JRST NMSTXB ;START ON VERSION IDPB A,R ;ELSE STORE CHARACTER CAIE A,^V ;QUOTING CHARACTER? JRST NMSTXC ;NOPE, LOOP FOR MORE ILDB A,TT ;UNCONDITIONALLY SNARF NEXT CHARACTER IDPB A,R JRST NMSTXC NMSTXA: MOVEI R,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+1(FXP) HRLI R,440700 ;BYTE POINTER TO EXTENSION NMSTXD: ILDB A,TT JUMPE A,NMSTX9 ;DONE, DEFAULT AND RETURN CAIE A,". ;VERSION NUMBER LEADIN? CAIN A,"; JRST NMSTXB ;YES, HACK THE VERSION IDPB A,R ;ELSE STORE THE CHARACTER OF THE EXTENSION CAIE A,^V JRST NMSTXD ILDB A,TT IDPB A,R JRST NMSTXD NMSTXB: MOVEI R,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+L.6EXT+1(FXP) HRLI R,440700 ;BYTE POINTER TO VERSION NUMBER SETZM (R) NMSTXF: ILDB A,TT ;GET NEXT BYTE CAIG A,"9 ;IF NOT A LEGAL NUMBER, THEN FINISH UP CAIGE A,"0 JRST NMSTX9 IDPB A,R JRST NMSTXF NMSTX9: POPJ P, NMSERR: SIXBIT \CAN'T PARSE AS FILE NAMESTRING!\ NMSTX2: POPI FXP,L.F6BT ;Invalid string for TENEX namestring parsing MOVEI T,NMSERR ; so pop off filename and merge into error JRST NMS6B0 ;; 6BT Translate Logical Name ;; if "sixbit" format is on FXP, then translate it for logical names ;; Should preserve AR1 -- see DELETEF 6BTTLN: SKIPE TENEXP POPJ P, HRROI 2,-L.F6BT+1(FXP) MOVSI 3,(ASCII /PS/) CAMN 3,(2) POPJ P, LOCKI ;LOCK OUT INTERRUPTS (BECAUSE OF JSYS'S) MOVEI 1,.LNSJB ;WHAT IF "DEVICE" IS REALLY A LOGICAL NAME? BG$ HRROI 3,VETBL0 ;We need a "waste basket", so why not use BG% MOVEI 3,.NULIO ; the bignum temporaries? LNMST JRST .+2 JRST 6BTLN1 MOVEI 1,.LNSSY HRROI 2,-L.F6BT+1-1(FXP) BG$ HRROI 3,VETBL0 ;We need a "waste basket", so why not use BG% MOVEI 3,.NULIO ; the bignum temporaries? LNMST JRST NMS6XUNLK ; WELL, IT ISN'T A LOGICAL NAME! 6BTLN1: SETZM -L.F6BT+1-1+L.6DEV(FXP) ;; but if it is a logical name, we flush the directory-name component! NMS6XUNLK: ;A "WRAP UP", WHICH MIGHT NEED TO CLEAR OUT JSYS STUFF SETZB 1,2 ; FROM ACC 1 AND 2. JRST UNLKPJ ;; This used to be the entry to JFN6BT from NMS6BT ; MOVEI T,[SIXBIT \GTJFN FAILED IN NAMESTRING!\] ; MOVSI A,(GJ%ACC+GJ%FLG+GJ%OLD+GJ%SHT) ; MOVE 2,PNBP ; GTJFN ;GET A JFN FOR PARSED NAMESTRING ; JRST NMS6XUNLK ; PRESUMABLY, THE COMPONENTS CANT BE "TOO LONG" ; POP FXP,F ; POPI FXP,L.F6BT ;THROW AWAY STUFF CALCULATED BY NMSTNX. ; TDZA R,R ;CONVERT JFN IN 1 TO "SIXBIT" ON FXP ; PUSH FXP,F JFN6BT: ;COME IN LOCKED, EXIT UNLOCKED. ON SUCCESS, HAS STACKED UP ON FXP THE GOODIES ;Formerly, NMS6BT used to call JFN6BT, and R=0 => NMS6BT ; MOVEI R,1 ; SKIP ON FAILURE POP FXP,F ;LOCKI WORD IS NOW IN F MOVE D,FXP .SEE TRUENAME MOVE 2,1 ;"INDEXABLE FILE HANDLE" RETURNED BY GTJFN SETZM PNBUF MOVE T,[PNBUF,,PNBUF+1] BLT T,PNBUF+LPNBUF-1 PUSHJ P,JFN6BB ;INITIALIZE PNBUF AN AC 1 .SEE JS%DEV JS%DIR JS%NAM JS%TYP JS%GEN JS%OUT==:<.JSAOF*111111111111> MOVSI 3,(JS%DEV&JS%OUT) JFNS ERJMP JFN6BY ;IF ERROR THEN TRY DEVST MOVNI T,L.6DEV ;STACK UP DEVICE FIELD ON FXP, AND PUSHJ P,JFN6BA ;ZERO PNBUF, SETUP 1 IRP LEN,,[L.6DIR,L.6FNM,L.6EXT]FLD,,[DIR,NAM,TYP] MOVSI 3,(JS%!FLD&JS%OUT) JFNS ;GET ASCIZ STRING FOR NEXT COMPONENT MOVNI T,LEN ;STACK UP ONE FIELD ON FXP, AND PUSHJ P,JFN6BA ;ZERO PNBUF, SETUP 1 TERMIN MOVSI 3,(JS%GEN&JS%OUT) JFNS ;GET ASCIZ STRING FOR VERSION NUMBER SKIPN T,PNBUF JRST JFN6BC CAME 1,[010700,,PNBUF] JRST .+2 SETZ T, JFN6BC: SKIPN T MOVE T,DFNWD PUSH FXP,T ;STACK UP THE FEW WORDS OF "VERSION" REPEAT L.6VRS-1, PUSH FXP,PNBUF+1+.RPCNT JFN6BX: PUSH FXP,F ;PUSH LOCKI WORD BACK JRST UNLKPJ ; and exit without skip, to signal WIN ;;This used to be the exiting for NMS6BT ;JFN6BX: PUSH FXP,F ;PUSH LOCKI WORD BACKn ; JUMPN R,JFN6BU ;NON-ZERO ==> ENTRY FROM TRUENAME ETC ; MOVEI 1,(2) ; RLJFN ;RELEASE THE JFN FOR NMS6BT ; JSP T,RLJLUZ ;JFN6BU: UNLKPOPJ JFN6BY: MOVEI T,[SIXBIT \DEVICE FAILURE IN NAMESTRING!\] CAIE 2,.PRIIN ;PRIMARY INPUT? CAIN 2,.PRIOU ;OR PRIMARY OUTPUT SKIPA ;YES JRST [ MOVE FXP,D ;NOPE, FAIL; SO FLUSH FXPDL CRUD PUSH FXP,F ; AND PUSH LOCKI WORD BACK ;;FOR NMS6BT, GO GIVE WTA ERROR ; JUMPE R,[ SETZB 1,2 ;ERROR ENCOUNTERED WHILE JSYS'S ARE ; UNLOCKI ; TRYING TO PARSE TOPS-20 NAMESTRING ; JRST NMS6BA ] AOS (P) ;FOR JFN6BT, SKIP ON FAILURE UNLKPOPJ ] PUSH FXP,[ASCII/PRIMA/] PUSH FXP,[ASCIZ/RY/] PUSHN FXP,L.F6BT-2 ;\<+L.6DIR+L.6FNM+L.6EXT+L.6VRS> JRST JFN6BX RLJLUZ: LERR [SIXBIT \A "RLJFN" HAS LOST SOMEWHERE!\] ;;; SUBROUTINE TO "ADD" ONE ITEM OF INFORMATION TO THE FORMING SIXBIT JFN6BA: HRLS T HRRI T,PNBUF PUSH FXP,(T) ;STACK UP PNBUF, TO LIMIT GIVEN IN T AOBJN T,.-1 JFN6BB: MOVE 1,PNBP ;STRING PTR FOR NEXT CALL TO JNFS MOVNI T,LPNBUF SKIPN PNBUF+LPNBUF(T) POPJ P, SETZM PNBUF+LPNBUF(T) ;CLEAR OUT PNBUF AOJL T,.-3 POPJ P, ] ;END OF IFN D20 SUBTTL CONVERSION: ANY FILE SPEC => SIXBIT ;;; TAKE ARGUMENT IN A (MAY BE FILE ARRAY, NAMELIST, ;;; OR NAMESTRING), FIGURE IT OUT AND SOMEHOW RETURN ;;; "SIXBIT" FORMAT ON FXP. ;;; IFL6BT SAYS THAT T MEANS TTY INPUT, NOT TTY OUTPUT. ;;; SAVES C AR1 AR2A IFL6BT: CAIN A,TRUTH HRRZ A,V%TYI JRST FIL6B0 IFN SFA,[ FILSFA: MOVEI B,QNAMELIST ;EXTRACT THE "FILENAME" FROM THE SFA SETZ C, ;NO ARGS PUSHJ P,ISTCSH ;SHORT CALL, THEN USE RESULT AS NEW NAME ] ;END IFN SFA FIL6BT: CAIN A,TRUTH ;SHOULD PRESERVE AR1 -- SEE DELETEF HRRZ A,V%TYO FIL6B0: SKIPN A ;NIL => USE "DEFAULTF" FIL6DF: HRRZ A,VDEFAULTF ;USE "DEFAULTF" FIL6B1: MOVEI T,[SIXBIT \INCOMPREHENSIBLE FILE NAME!\] MOVEI R,(A) LSH R,-SEGLOG SKIPGE R,ST(R) ;LIST => NAMELIST JRST NMH6BT ; OR POSSIBLY "NAMESTRING" AS A USER HUNK TLNN R,SA JRST FIL6B2 ;NOT ARRAY => NAMESTRING MOVE R,ASAR(A) SFA$ TLNE R,AS.SFA ;AN SFA? SFA$ JRST FILSFA ;YES, EXTRACT NAME FROM IT AND TRY AGAIN TLNN R,AS JRST NMS6B0 ;INCOMPREHENSIBLE NAMESTRING LOCKI ;FOR FILE, GOBBLE NAMES OUT OF FILE OBJECT POP FXP,D ;POP LOCKI WORD MOVE TT,TTSAR(A) ADDI TT,F.DEV HRLI TT,-L.F6BT PUSH FXP,(TT) ;PUSH ALL WORDS OF FILE SPEC AOBJN TT,.-1 PUSH FXP,D ;PUSH BACK LOCKI WORD UNLKPOPJ ;UNLOCK AND EXIT FIL6B2: JUMPE A,NML6BT ;FOO () IS ALWAYS A SPECIAL CASE! TLNN R,SY JRST NMS6B0 JSP T,QIOSAV ;A SYMBOL IS A NAMESTRING. JRST NMS6BT NMH6BT: TLNN R,ST.HNK JRST NML6BT JSP T,QIOSAV PUSHJ P,USRHNP ;find out if this is a user's hunk JUMPE T,NMS6B0 ;LOSE IF HUNK, BUT NOT "EXTEND" PUSH P,[NMS6BT] PUSH P,A PUSH P,[QNAMESTRING] MOVNI T,2 XCT SENDI QIOSAV: SOVE B C AR1 AR2A PUSHJ P,(T) RSTR AR2A AR1 C B POPJ P, LQIOSV==5 ; 5 THINGS - 4 AC'S AND ONE RET ADDR .SEE 6BTNS8 ;RELIES ON AC C BEING SAVED IN CERTAIN SPOT SUBTTL MERGEF, TRUENAME, PROBEF AND MERGING ROUTINES ;;; MERGEF TAKES TWO FILE SPECS OF ANY KIND, MERGES THEM, ;;; AND RETURNS A NAMELIST OF THE RESULTING SPECS. ;;; AS A CROCK, (MERGEF X '*) SIMPLY MAKES THE SECOND FILE NAME BE *. ;;; (FOR D20, THE VERSION BECOMES NULL) MERGEF: PUSH P,B PUSHJ P,FIL6BT POP P,A CAIE A,Q. JRST MRGF1 20% MOVE T,DFNWD 20% MOVEM T,(FXP) 20$ REPEAT L.6VRS, SETZM -.RPCNT(FXP) JRST 6BTNML MRGF1: PUSHJ P,FIL6BT PUSHJ P,IMRGF JRST 6BTNML ;;; IMRGF MERGES TWO SETS OF SPECS ON THE FIXNUM PDL. ;;; DMRGF MERGES A SET WITH THE DEFAULT FILE NAMES. ;;; DEC-10 PPN'S MERGE HALVES OF THE PPN SEPARATELY; ;;; AN UNSPECIFIED HALF IS -1 OR 0, *NOT* (SIXBIT \*\)!! ;;; SAVES F (SEE LOAD). DMRGF: ;SHOULD PRESERVE AR1 -- SEE DELETEF ;FIRST SEE WHETHER WE REALLY NEED TO CONVERT THE DEFAULTS TO "SIXBIT" IFN ITS+D10,[ MOVE TT,DFNWD REPEAT L.F6BT,[ IFN ITS\<.RPCNT-1>,[ CAME TT,.RPCNT-3(FXP) ;MUST MERGE IF FILE NAME IS ZERO OR * SKIPN .RPCNT-3(FXP) JRST DMRGF5 ] ;END OF IFN ITS\<.RPCNT-1> .ELSE,[ MOVE T,.RPCNT-3(FXP) AOJE T,DMRGF7 SOJE T,DMRGF7 TRNE T,-1 TRNN T,-1 JRST DMRGF5 SKIPA DMRGF7: SETZM .RPCNT-3(FXP) ] ;END OF .ELSE ] ;END OF REPEAT L.F6BT ] ;END OF IFN ITS+D10 IFN D20,[ MOVE TT,DFNWD ZZZ==0 IRP FOO,,[L.6VRS,L.6EXT,L.6FNM,L.6DIR,L.6DEV] ZZZ==ZZZ+FOO CAME TT,-ZZZ+1(FXP) SKIPN -ZZZ+1(FXP) JRST DMRGF5 TERMIN EXPUNGE ZZZ ] ;END OF IFN D20 POPJ P, ;MERGE WOULDN'T DO ANYTHING - FORGET IT DMRGF5: PUSH FLP,F ;MERGE WITH DEFAULT FILE NAMES HRRZ A,VDEFAULTF PUSHJ P,FIL6BT POP FLP,F 20% ;JRST IMRGF IFN D20,[ PUSHJ P,IMRGF SKIPE TT,-L.F6BT+L.6DEV+1(FXP) CAMN TT,DFNWD JRST .+2 POPJ P, PUSH P,A JSP T,TNXUDI MOVEI D,-L.F6BT+L.6DEV+1(FXP) HRLI D,-L.6DIR MOVNI T,1 ;Initialize pointer into PNBUF DMRGF6: AOJ T, ;Loop copying default directory onto FXP MOVE R,PNBUF(T) MOVEM R,(D) JUMPE R,POPAJ ;Terminate loop when no end of string AOBJN D,DMRGF6 ; or when no more room JRST POPAJ ;;; CODE TO GET THE CONNECTED DIRECTORY NAME INTO THE PNBUF TNXUDI: MOVE TT,[PNBUF,,PNBUF+1] SETZM PNBUF ;CLEAR PNBUF BLT TT,PNBUF+LPNBUF-1 LOCKI GJINF ;GET JOB INFORMATION MOVE 1,PNBP ;POINTER INTO PNBUF DIRST ;GET EQUIVALENT ASCII STRING JRST TNXU9D ;HMM... MOVE 1,PNBP TNXUD0: ILDB D,1 ;SCAN DEVICE-NAME PART CAIN D,0 JRST TNXUD2 ;WIN! NOT PUNCTUATION ANYWAY! CAIE D,^V CAIE D,": JRST TNXUD0 ILDB D,1 CAIE D,"< JRST TNXU9P MOVE 2,PNBP TNXUD3: ILDB D,1 ;TRANSFER DIRECTORY-NAME PART CAIN D,0 JRST TNXU9P CAIE D,^V JRST TNXUD5 IDPB D,2 ILDB D,1 TNXUD6: IDPB D,2 JRST TNXUD3 TNXUD5: CAIE D,"> JRST TNXUD6 MOVEI D,0 MOVEI A,9 IDPB D,2 ;PAD LIKE ASCIZ WITH AN EXTRA WORD OF 0'S SOJG A,.-1 TNXUD2: SETZB 1,2 UNLOCKI JRST (T) TNXU9P: MOVE 1,[440700,,[ASCIZ \Punctuated string in PNBUF loses in TNXUDI\]] JRST TNXDIE TNXU9D: SKIPA 1,[440700,,[ASCIZ \DIRST loses in TNXUDI\]] TNXST9: MOVE 1,[440700,,[ASCIZ \GETTAB loses in TNXSET\]] TNXDIE: PSOUT HALTF ] ;END OF IFN D20 IMRGF: MOVE TT,DFNWD ;MERGE TWO SETS OF NAMES ON FXP, ; "POPPING" THE TOP ONE OFF IFN ITS+D10,[ MOVEI T,L.F6BT MRGF2: 10$ MOVE R,D POP FXP,D 10$ CAIE T,2 ;PPN IS PENULTIMATE FROB - DON'T COMPARE TO * CAME TT,-3(FXP) SKIPN -3(FXP) MOVEM D,-3(FXP) SOJG T,MRGF2 IFN D10,[ MOVE D,-2(FXP) ;R HAS PPN 2 - GET PPN 1 IN D AOJE D,MRGF3 SOJE D,MRGF3 TLNN D,-1 HLLM R,-2(FXP) TRNN D,-1 HRRM R,-2(FXP) SKIPA MRGF3: MOVEM R, -2(FXP) ;USED TO SETZM, BUT SEEMS WRONG - RPG ] ;END OF IFN D10 ] ;END OF IFN ITS+D10 IFN D20,[ IRP FOO,,[VRS,EXT,FNM,DIR,DEV] CAME TT,-L.6!FOO-L.F6BT+1(FXP) SKIPN -L.6!FOO-L.F6BT+1(FXP) JRST IM!FOO!1 POPI FXP,L.6!FOO JRST IM!FOO!2 IM!FOO!1: IFLE L.6!FOO-3, REPEAT L.6!FOO, POP FXP,-L.F6BT(FXP) .ELSE,[ MOVEI T,L.6!FOO POP FXP,-L.F6BT(FXP) SOJG T,.-1 ] ;END OF .ELSE IM!FOO!2: TERMIN ] ;END OF IFN D20 C6BTNML: POPJ P,6BTNML ;;; (TRUENAME ) RETURNS THE RESULT OF .RCHST ON ITS, ;;; I.E. THE REAL FILE NAMES AFTER TRANSLATIONS, LINKS, ETC. ;;; THE RESULT IS A NAMELIST. TRUNM9: EXCH A,AR1 %WTA NFILE ;SUBR 1 TRUENAME: ;MUST SAVE AR1 - SEE PRNF6-PRNJ2 IFN SFA,[ CAIN A,TRUTH ;T? HRRZ A,V%TYO ; Use TYO EXCH AR1,A JSP TT,XFOSP ;FILE OR SFA OR NOT? JRST TRUNM9 ;NOT JRST TRUNMZ ;FILE EXCH A,AR1 JSP T,QIOSAV MOVEI B,QTRUENAME SETZ C, ;NO THIRD ARG JRST ISTCSH ;SHORTY INTERNAL STREAM CALL TRUNMZ: EXCH A,AR1 ] ;END IFN SFA PUSH P,C6BTNML TRU6BT: CAIN A,TRUTH HRRZ A,V%TYO TRUNM2: EXCH AR1,A LOCKI JSP TT,XFILEP JRST TRUNM8 EXCH A,AR1 HRRZ TT,TTSAR(A) IFN ITS+D10,[ POP FXP,T ;POP THE LOCKI WORD HRLI TT,-L.F6BT PUSH FXP,F.RDEV(TT) AOBJN TT,.-1 PUSH FXP,T ;PUSH LOCKI WORD BACK UNLKPOPJ ] ;END OF ITS+D10 IFN D20,[ PUSH P,1 MOVE 1,F.JFN(TT) PUSHJ P,JFN6BT ;GET "SIXBIT" ON FXP, AND UNLOCKI JRST POPAJ ; ON SUCCESS, LEAVES "SIXBIT" FORMS ON FXPDL POP P,1 JRST TRUNM0 ] ;END OF IFN D20 TRUNM8: UNLOCKI EXCH AR1,A TRUNM0: %WTA NFILE ;NOT FILE SFA$ MOVE T,C6BTNML ;IF NOT CALLED AS A SUBR, ONLY ACCEPT A FILE SFA$ CAME T,(P) JRST TRUNM2 SFA$ POPI P,1 SFA$ JRST TRUENAME ;;; (STATUS UREAD) SUREAD: SKIPN A,VUREAD POPJ P, PUSHJ P,TRUENAME HLRZ B,(A) HRRZ A,(A) HRRZ C,(A) 20$ HRRZ C,(C) 20$ HRRM C,(A) HRRM B,(C) POPJ P, ;;; (STATUS UWRITE) SUWRITE: SKIPE A,VUWRITE PUSHJ P,TRUENAME JRST $CAR ;(CAR NIL) => NIL ;;; ROUTINE TO SET UP ARGS FOR TWO-ARGUMENT FILE FUNCTION. ;;; PUT TWO SETS OF FILE NAMES ON FXP. IF THE ARGS ARE ;;; X AND Y, THEN THE NAMES ON FXP ARE (MERGEF X NIL) AND ;;; (MERGEF Y (MERGEF X NIL)). THE FIRST ARG IS LEFT IN AR1. 2MERGE: PUSH P,A PUSH P,B PUSHJ P,FIL6BT PUSHJ P,DMRGF POP P,A PUSHJ P,FIL6BT MOVEI T,L.F6BT PUSH FXP,-2*L.F6BT+1(FXP) SOJG T,.-1 PUSHJ P,IMRGF ;NOW WE HAVE THE MERGED FILE SPECS POP P,AR1 ;FIRST ARG POPJ P, ;;; (PROBEF X) TRIES TO DECIDE WHETHER FILE X EXISTS. ;;; ON ITS AND D10 THIS IS DONE BY TRYING TO OPEN THE FILE. ;;; ON D20 WE USE THE GTJFN JSYS. ;;; RETURNS REAL FILE NAMES ON SUCCESS, NIL ON FAILURE. PROBEF: ;SUBR 1 JSP T,QIOSAV IFN SFA,[ JSP TT,AFOSP ;DO WE HAVE AN SFA? JRST PROBEZ ;NOPE JRST PROBEZ ;NOPE MOVEI B,QPROBEF ;PROBEF OPERATION SETZ C, ;NO ARGS JRST ISTCSH ;SHORT CALL, RETURN RESULTS PROBEZ: ] ;END IFN SFA PUSHJ P,FIL6BT PROBF0: PUSHJ P,DMRGF IFN ITS,[ LOCKI SETZ TT, ;ASSUME NO CONTROL ARG MOVSI T,'USR ;CHECK FOR USR DEVICE CAMN T,-3-1(FXP) ;MATCH? TRO TT,10 ;SET BIT 1.4 (INSIST ON EXISTING JOB) .CALL PROBF8 JRST PROBF6 .CALL PROBF9 .LOSE 1400 .CLOSE TMPC, UNLOCKI ] ;END OF IFN ITS IFN D10,[ LOCKI MOVEI T,.IODMP ;I/O MODE (DUMP MODE) MOVE TT,-3-1(FXP) ;DEVICE NAME SETZ D, OPEN TMPC,T JRST PROBF6 ;NO SUCH FILE IF NO SUCH DEVICE! IFE SAIL,[ MOVEI T,3 ;ONLY NEED 3 ARGS OF EXTENDED LOOKUP MOVE D,-1-1(FXP) ;FILE NAME HLLZ R,0-1(FXP) ;EXTENSION MOVE TT,-2-1(FXP) ;PPN ] ;END IFE SAIL IFN SAIL,[ MOVE T,-1-1(FXP) ;FILE NAME HLLZ TT,0-1(FXP) ;EXTENSION CAMN TT,[SIXBIT \___\] SETZ TT, SETZ D, ;UNUSED MOVE R,-2-1(FXP) ;PPN ] ;END IFN SAIL LOOKUP TMPC,T JRST PROBF5 ;FILE DOESN'T EXIST PUSHJ P,D10RFN ;READ BACK FILE NAMES RELEASE TMPC, ;RELEASE TEMP CHANNEL UNLOCKI JRST 6BTNML ;FORM NAMELIST ON SUCCESS D10RFN: MOVEI F,TMPC ;WE WILL GET DEVICE NAME FROM MONITOR SA% DEVNAM F, SA$ PNAME F, SKIPA ;NONE SO RETAIN OLD NAME MOVEM F,-3-1(FXP) ;ELSE STORE NEW DEVICE NAME IFE SAIL,[ MOVEM TT,-2-1(FXP) ;STORE DATA AS RETURNED FROM EXTENDED LOOKUP MOVEM D,-1-1(FXP) HLLZM R,0-1(FXP) ] ;END IFE SAIL IFN SAIL,[ MOVEM T,-1-1(FXP) ;SAIL HAS NO EXTENDED LOOKUP!!!!! HLLZM TT,0-1(FXP) ; SO, WE CAN'T STORE PPN; JUST ASSUME IT IS ; WHAT WE GAVE IT ] ;END IFN SAIL POPJ P, ] ;END OF IFN D10 IFN D20,[ PUSHJ P,6BTTLS ;TRANSLATE LOGICAL NAME, AND STRING INTO PNBUF LOCKI MOVSI 1,(GJ%OLD+GJ%SHT) .SEE .GJDEF MOVE 2,PNBP GTJFN ;GET A JFN (INSIST ON EXISTING FILE) JRST UNLKFALSE PUSH FLP,1 ;SAVE JFN OVER JFN6BT PUSHJ P,JFN6BT ;CONVERT JFN TO "SIXBIT" FORMAT ON FXP TDZA B,B MOVEI B,TRUTH ;JFN6BT SKIPS ON FAILURE POP FLP,1 RLJFN ;RELEASE THE JFN JSP T,RLJLUZ JUMPN B,FALSE ] ;END OF IFN D20 10% JRST 6BTNML IFN ITS+D10,[ 10$ PROBF5: RELEASE TMPC, PROBF6: UNLOCKI POPI FXP,L.F6BT ;POP "SIXBIT" CRUD FROM FXP JRST FALSE ;RETURN FALSE ON FAILURE ] ;END OF IFN ITS+D10 IFN ITS,[ PROBF8: SETZ SIXBIT \OPEN\ ;OPEN FILE (ASCII UNIT INPUT) 4000,,TT ;CONTROL ARG (DON'T CREATE BIT SET FOR USR) 1000,,TMPC ;CHANNEL # ,,-3-1(FXP) ;DEVICE NAME ,,-1-1(FXP) ;FILE NAME 1 ,,0-1(FXP) ;FILE NAME 2 400000,,-2-1(FXP) ;SNAME PROBF9: SETZ SIXBIT \RFNAME\ ;READ REAL FILE NAMES 1000,,TMPC ;CHANNEL # 2000,,-3-1(FXP) ;DEVICE NAME 2000,,-1-1(FXP) ;FILE NAME 1 2000,,0-1(FXP) ;FILE NAME 2 402000,,-2-1(FXP) ;SNAME ] ;END OF IFN ITS SUBTTL RENAMEF FUNCTION, CNAMEF FUNCTION ;;; (RENAMEF X Y) RENAMES (MERGEF X (NAMELIST NIL)) TO BE ;;; (MERGEF Y (MERGEF X (NAMELIST NIL))). ;;; IF X IS AN OUTPUT FILE ARRAY, IT IS RENAMED AND CLOSED. $RENAMEF: IFN SFA,[ JSP TT,AFOSP ;SKIP IF FILE OR SFA JRST $RENM0 JRST $RENM0 ;A FILE, NOT AN SFA MOVEI C,(B) ;FILENAME TO RENAME TO MOVEI B,Q$RENAME ;A RENAME OPERATION JRST ISTCSH ;FAST INTERNAL SFA-CALL $RENM0: ] ; END OF IFN SFA, PUSHJ P,2MERGE ;2MERGE LEAVES ARG 1 IN AR1 HLLOS NOQUIT 20$ PUSHJ P,6BTTLN ;TRANSLATE LOGICAL NAME in "new" name. MOVEI A,(AR1) JSP TT,XFILEP ;SKIP IF FILE ARRAY JRST RENAM2 MOVE TT,TTSAR(A) HLL AR1,TT TLNE TT,TTS.CL JRST RENM2A JRST RENAM3 RENAM2: MOVEI AR1,NIL ;FILE TO BE RENAMED IS SPECIFIED BY NAMELIST RENM2A: ; OR NAMESTRING, OR BY A CLOSED FILE ARRAY IFN ITS,[ .CALL RENAM8 ;ORDINARY RENAME IOJRST 0,RENAM6 JRST RENM1A ] ;END OF IFN ITS IFN D10,[ MOVEI T,.IODMP ;TO RENAME A FILE, WE OPEN A DUMP MODE CHANNEL MOVE TT,-7(FXP) ;GET DEVICE NAME SETZ D, OPEN TMPC,T ;OPEN CHANNEL JRST RENAM4 MOVE T,-5(FXP) ;FILE NAME HLLZ TT,-4(FXP) ;EXTENSION SA$ CAMN TT,[SIXBIT \___\] SA$ SETZ TT, SETZ D, MOVE R,-6(FXP) ;PPN LOOKUP TMPC,T ;LOOK UP FILE IOJRST 0,RENAM5 MOVE T,-1(FXP) ;NEW FILE NAME HLLZ TT,(FXP) ;NEW EXTENSION SETZ D, MOVE R,-2(FXP) ;NEW PPN RENAME TMPC,T ;RENAME FILE IOJRST 0,RENAM5 RELEASE TMPC, JUMPE AR1,RENM1A JRST RENAM1 ] ;END OF IFN D10 IFN D20,[ MOVEI T,L.F6BT PUSH FXP,-2*L.F6BT+1(FXP) ;COPY OLD FILE NAMES TO TOP OF FXP SOJG T,.-1 PUSHJ P,6BTTLS ;TRANSLATE LOGICAL NAME OF FILE TO BE RENAMED, PUSH P,A ; AND STRING INTO PNBUF MOVSI 1,(GJ%OLD+GJ%SHT) MOVE 2,PNBP GTJFN ;GET A JFN FOR OLD FILE NAMES IOJRST 0,RENAM6 EXCH 1,(P) ;PUSH JFN, AND RESTORE ACC A JRST RENAM0 ; AND JOIN GENERAL RENAME ] ;END OF IFN D20 RENAM3: ;First, de-allocate the channel number, and IFN D10+ITS,[ ; close out bits in the file array PUSHJ P,JCLOSE IFN ITS,[ .CALL RENAM7 ;ITS RENAME! - MUST RENAME WHILE OPEN IOJRST 0,RENAM6 ] ;END OF IFN ITS IFN D10,[ MOVE F,F.CHAN(TT) ;ttsar left in TT by JCLOSE MOVE T,-1(FXP) ;D10 RENAME! - will construct instruction HLLZ TT,(FXP) SA$ CAMN TT,[SIXBIT \___\] SA$ SETZ TT, SETZ D, MOVE R,-2(FXP) LSH F,27 IOR F,[RENAME 0,T] XCT F IOJRST 0,RENAM6 ] ;END OF IFN D10 RENAM1: MOVE TT,TTSAR(A) MOVE D,-1(FXP) ;UPDATE THE FILE NAMES OF ARRAY MOVEM D,F.FN1(TT) 10% MOVE R,(FXP) 10$ HLLZ R,(FXP) MOVEM R,F.FN2(TT) IFN D10,[ MOVEM D,F.RFN1(TT) ;TRUENAMES for D10, and CLOSE/RELEASE MOVEM F,F.RFN2(TT) MOVE R,-2(FXP) MOVEM R,F.PPN(TT) MOVEM R,F.RPPN(TT) SA$ XOR F,[#] SA$ XCT F SA$ XOR F,[#] SA% XOR F,[#] XCT F ] ;END OF IFN D10 IFN ITS,[ .CALL RFNAME ;TRUENAMES for ITS and CLOSE file .LOSE 1400 .CALL CLOSE9 .LOSE 1400 ] ;END OF IFN ITS ] ;END OF IFN D10+ITS IFN D20,[ PUSH P,F.JFN(TT) PUSHJ P,JCLOSE RENAM0: PUSHJ P,X6BTNSL POP P,T MOVSI 1,(GJ%FOU+GJ%NEW+GJ%SHT) MOVE 2,PNBP GTJFN IOJRST 0,RENAM5 MOVEI 2,(1) JUMPE AR1,RENM0A TLNE AR1,TTS.CL ;THE "CLOSED" BIT WAS TRANSFERRED JRST RENM0A MOVEI 1,(T) HRLI 1,(CO%NRJ) CLOSF IOJRST 0,RENAM4 RENM0A: MOVEI 1,(T) RNAMF IOJRST 0,RENAM4 MOVE 1,2 RLJFN ;? SHOULD GC DO THE RELEASE? JSP T,RLJLUZ JUMPE AR1,RENM0B MOVE TT,TTSAR(AR1) MOVEI T,F.DEV(TT) HRLI T,-L.F6BT+1(FXP) BLT T,F.DEV+L.F6BT-1(TT) RENM0B: JUMPE AR1,RENM1A ] ;END OF IFN D20 POPI FXP,L.F6BT ;WHEN 1ST ARG IS FILE ARRAY, THEN RETURN THAT SKIPA A,AR1 RENM1A: PUSHJ P,6BTNML ;OTHERWISE, RET VAL IS THE (NEW) NAMELIST POPI FXP,L.F6BT JRST CZECHI IFN ITS,[ RENAM7: SETZ SIXBIT \RENMWO\ ;RENAME WHILE OPEN ,,F.CHAN(TT) ;CHANNEL # ,,-1(FXP) ;NEW FILE NAME 1 400000,,(FXP) ;NEW FILE NAME 2 RENAM8: SETZ SIXBIT \RENAME\ ;RENAME ,,-7(FXP) ;DEVICE NAME ,,-5(FXP) ;OLD FILE NAME 1 ,,-4(FXP) ;OLD FILE NAME 2 ,,-6(FXP) ;SNAME ,,-1(FXP) ;NEW FILE NAME 1 400000,,(FXP) ;NEW FILE NAME 2 ] ;END OF IFN ITS IFN D20,[ RENAM4: MOVE 1,2 RLJFN JSP T,RLJLUZ RENAM5: JUMPE AR1,RNAM5A TLNE AR1,TTS.CL ;THE "CLOSED" BIT WAS TRANSFERRED JRST RNAM5A MOVEI 1,(T) HRLI 1,(CO%NRJ) CLOSF ;Close the file. But DON'T barf, it may have been JFCL ; closed already (get here by RNAMF at RENM0A+2). RNAM5A: MOVE 1,T RLJFN JSP T,RLJLUZ ] ;END OF IFN D20 IFN D10,[ RENAM4: SKIPA C,[NSDERR] RENAM5: RELEASE TMPC, ] ;END OF IFN D10 RENAM6: PUSHJ P,CZECHI RENAM9: PUSHJ P,6BTNML ;ERROR MESSAGE IS IN C PUSHJ P,NCONS PUSH P,A PUSHJ P,6BTNML POP P,B PUSHJ P,CONS MOVEI B,Q$RENAMEF XCIOL: PUSHJ P,XCONS ;XCONS, THEN IOL %IOL (C) 10$ NSDERR: SIXBIT \NO SUCH DEVICE!\ IFN ITS,[ RFNAME: SETZ SIXBIT \RFNAME\ ;READ FILE NAMES ,,F.CHAN(TT) ;CHANNEL # 2000,,F.RDEV(TT) ;DEVICE NAME 2000,,F.RFN1(TT) ;FILE NAME 1 2000,,F.RFN2(TT) ;FILE NAME 2 402000,,F.RSNM(TT) ;SNAME ] ;END OF IFN ITS CNAMEF: PUSHJ P,2MERGE ;LEAVES FIRST ARG IN AR1 JSP TT,XFILEP JRST CNAME1 MOVE TT,TTSAR(AR1) TLNN TT,TTS.CL ;FILE-ARRAY MUST BE CLOSED JRST CNAME2 ADDI TT,L.F6BT MOVEI F,L.F6BT ;COUNTER TO TRANSFER WORDS CNAME3: MOVE T,(FXP) MOVEM T,F.DEV-1(TT) 20$ POPI FXP,1 20% POP FXP,F.RDEV-1(TT) SUBI TT,1 SOJG F,CNAME3 POPI FXP,L.F6BT MOVEI A,(AR1) POPJ P, CNAME2: SKIPA C,[CNAER2] CNAME1: MOVEI C,CNAER1 CNAMER: PUSHJ P,6BTNML ;ERROR MESSAGE IS IN C PUSHJ P,NCONS PUSH P,A PUSHJ P,6BTNML POP P,B PUSHJ P,CONS MOVEI B,QCNAMEF PUSHJ P,XCONS ;XCONS, THEN IOL %IOL (C) CNAER1: SIXBIT/NOT FILE ARRAY!/ CNAER2: SIXBIT/FILE ARRAY NOT CLOSED!/ SUBTTL DELETEF FUNCTION ;;; (DELETEF X) DELETES THE FILE X. (THAT SOUNDS LOGICAL...) $DELETEF: ;SUBR 1 JSP TT,AFOSP ;SKIP IF FILE OR SFA. LEAVES ARG IN AR1 JRST $DEL3 IFN SFA,[ JRST $DELNS ;A FILE, NOT AN SFA MOVEI B,Q$DELETE ;DELETE OPERATION SETZ C, ;NO OP SPECIFIC ARG JRST ISTCSH ;FAST INTERNAL SFA CALL $DELNS: ] ;END IFN SFA MOVE TT,TTSAR(A) TLNE TT,TTS.CL ;SKIP IF OPEN JRST $DEL3 HLLOS NOQUIT IFN ITS,[ .CALL $DEL6 ;USE DELEWO FOR AN OPEN FILE IOJRST 0,$DEL9A PUSHJ P,JCLOSE MOVE T,F.CHAN(TT) ;CHANNEL INTO T FOR CLOSE9 .CALL CLOSE9 ;ACTUALLY PERFORM THE CLOSE .LOSE 1400 ] ;END OF IFN ITS IFN D10,[ MOVE F,F.CHAN(TT) MOVE R,F.RPPN(TT) LSH F,27 IOR F,[RENAME 0,T] SETZB T,TT XCT F IOJRST 0,$DEL9A PUSHJ P,JCLOSE XOR F,[#] XCT F ;40 BIT MEANS AVOID SUPERSEDING A FILE XOR F,[#] XCT F ] ;END OF IFN D10 IFN D20,[ PUSHJ P,JCLOSE HRRZ 1,F.JFN(TT) HRLI 1,(CZ%ABT+CO%NRJ) ;ABORTING, BUT DON'T RELEASE JFN CLOSF IOJRST 0,$DEL9A TLZ 1,-1 DELF IOJRST 0,$DEL9A MOVE A,AR1 ;ORIGINAL ARG ] ;END OF IFN D20 JRST CZECHI IFN ITS,[ $DEL6: SETZ SIXBIT \DELEWO\ ;DELETE WHILE OPEN 400000,,F.CHAN(TT) ;CHANNEL # ] ;END OF IFN ITS $DEL3: PUSHJ P,FIL6BT ;REMEMBER, ORIGINAL ARG IS SAVED IN AR1 PUSHJ P,DMRGF ;MERGE ARG WITH DEFAULTS HLLOS NOQUIT IFN ITS,[ .CALL $DEL7 IOJRST 0,$DEL9 ] ;END OF IFN ITS IFN D10,[ MOVEI T,.IODMP MOVE TT,-3(FXP) ;GET DEVICE NAME SETZ D, OPEN TMPC,T ;OPEN TEMP DUMP MODE CHANNEL JRST [ MOVEI C,NSDERR JRST $DEL9 ] MOVE T,-1(FXP) ;FILE NAME HLLZ TT,(FXP) ;EXTENSION SA$ CAMN TT,[SIXBIT \___\] SA$ SETZ TT, SETZ D, MOVE R,-2(FXP) ;PPN LOOKUP TMPC,T IOJRST 0,$DEL5 SETZB T,TT ;ZERO FILE NAMES MEANS DELETE MOVE R,-2(FXP) ;MUST SPECIFY CORRECT PPN RENAME TMPC,T ;DELETE THE FILE IOJRST 0,$DEL5 RELEASE TMPC, ;RELEASE TEMP CHANNEL ] ;END OF IFN D10 IFN D20,[ PUSHJ P,6BTTLS ;TRANSLATE LOGICAL NAME OF NEW FILE NAME, AND ; STRING INTO PNBUF MOVE 1,[GJ%OLD+GJ%SHT+.GJLEG] MOVE 2,PNBP GTJFN ;GET A JFN FOR THE FILE IOJRST 0,$DEL9 TLZ 1,-1 PUSH FLP,1 LOCKI PUSHJ P,JFN6BT ;CONVERT JFN TO "SIXBIT" FORMAT ON FXP JRST .+3 ; SKIP ON FAILURE MOVEI C,EMS26 ;"FILE NOT FOUND" ERROR WHAT ELSE TO DO????? JRST $DEL5 MOVE 1,(FLP) DELF ;DELETE FILE, and release JFN IOJRST 0,$DEL5 ; POPI FLP,1 ] ;END OF IFN D20 PUSHJ P,CZECHI JRST 6BTNML IFN ITS,[ $DEL7: SETZ SIXBIT \DELETE\ ;DELETE FILE ,,-3(FXP) ;DEVICE NAME ,,-1(FXP) ;FILE NAME 1 ,,0(FXP) ;FILE NAME 2 400000,,-2(FXP) ;SNAME ] ;END OF IFN ITS IFN D20,[ $DEL5: POP FLP,1 ;RESTORE JFN TO 1 RLJFN ;RELEASE THE TEMP JFN JSP T,RLJLUZ ] ;END OF IFN D20 IFN D10,[ $DEL5: RELEASE TMPC, ;RELEASE THE TEMP CHANNEL ] ;END OF IFN D10 $DEL9: MOVE A,AR1 ;ORIGINAL ARG 20% POPI FXP,L.F6BT $DEL9A: PUSHJ P,CZECHI PUSHJ P,ACONS MOVEI B,Q$DELETEF JRST XCIOL SUBTTL CLOSE FUNCTION ;;; (CLOSE X) CLOSES THE FILE ARRAY X. THE ARRAY ITSELF ;;; IS *NOT* FLUSHED - MAY WANT TO RE-OPEN IT. CLOSE0: %WTA NAFOS $CLOSE: JSP TT,AFOSP ;LEAVES OBJECT IN A JRST CLOSE0 ;NOT A FILE IFN SFA,[ JRST ICLOSE ;A FILE-ARRAY, DO INTERNAL STUFF MOVEI B,Q$CLOSE ;CLOSE OPERATION SETZ C, ;NO THIRD ARG JRST ISTCSH ;SHORT INTERNAL SFA CALL ] ;END IFN SFA ICLOSE: HLLOS NOQUIT MOVE TT,TTSAR(A) TLNE TT,TTS.CL JRST ICLOS6 PUSHJ P,JCLOSE IFN ITS,[ .CALL CLOSE9 ;CLOSE FILE .LOSE 1400 ] ;END OF IFN ITS IFN D10,[ LSH T,27 SA$ IOR T,[CLOSE 0,0] SA$ XCT T SA$ XOR T,[#] SA% IOR T,[RELEASE 0,0] XCT T ] ;END OF IFN D10 IFN D20,[ HRRZ 1,F.JFN(TT) CLOSF ;DOES AN IMPLICIT RLJFN JFCL ] ;END OF IFN D20 SKIPA A,[TRUTH] ;RETURN T IF DID SOMETHING, ELSE NIL ICLOS6: MOVEI A,NIL JRST CZECHI CLOSE9: SETZ SIXBIT \CLOSE\ ;CLOSE CHANNEL 400000,,F.CHAN(TT) ;CHANNEL # ;;; FILE PRE-CLOSE CLEANUP - de-allocates channel and returns it in T, ;;; also returns TTSAR in TT JCLOSE: MOVE TT,TTSAR(A) ;SHOULD PRESERVE AR1 -- SEE DELETEF TLNE TT,TTS.CL ;SKIP UNLESS ALREADY CLOSED .LOSE TLNE TT,TTS.IO ;SKIP UNLESS OUTPUT FILE ARRAY PUSHJ P,IFORCE ;FORCE OUTPUT BUFFER MOVE TT,TTSAR(A) TLNE TT,TTS.TY SKIPN T,FT.CNS(TT) JRST CLOSE4 SETZM FT.CNS(TT) ;UNLINK TWO TTY'S WHICH MOVE T,TTSAR(T) ; WERE TTYCONS'D TOGETHER SETZM FT.CNS(T) ; IF ONE IS CLOSED CLOSE4: HRRZ T,F.CHAN(TT) MOVSI D,TTS.CL ;TURN ON "FILE CLOSED" IORM D,TTSAR(A) ; BIT IN ARRAY SAR SETZM CHNTB(T) ;CLEAR CHANNEL TABLE ENTRY POPJ P, SUBTTL FORCE-OUTPUT ;;; (FORCE-OUTPUT X) FORCES THE OUTPUT BUFFER OF OUTPUT FILE ARRAY X. FORCE: IFN SFA,[ EXCH AR1,A JSP TT,XFOSP ;AN SFA? JRST FORSF1 JRST FORSF1 EXCH AR1,A JSP T,QIOSAV MOVEI B,QFORCE SETZ C, JRST ISTCSH FORSF1: EXCH AR1,A ] ;END IFN SFA PUSH P,AR1 MOVEI AR1,(A) PUSHJ P,FORCE1 POP P,AR1 POPJ P, FORCE1: PUSHJ P,OFILOK ;DOES A LOCKI PUSHJ P,IFORCE IFN ITS,[ .CALL FORCE9 CAIN D,%EBDDV ;"WRONG TYPE DEVICE" ERROR IS OKAY CAIA .VALUE ;ANY OTHER ERROR LOSES ] ;END OF IFN ITS JRST UNLKTRUE IFN ITS,[ FORCE9: SETZ SIXBIT \FORCE\ ;FORCE OUTPUT BUFFER TO DEVICE ,,F.CHAN(TT) ;CHANNEL # 403000,,D ;ERROR # ] ;END OF IFN ITS ;;; INTERNAL OUTPUT BUFFER FORCE ROUTINE. EXPECTS USER ;;; INTERRUPTS OFF, AND FILE ARRAY TTSAR IN TT. ;;; CLOBBERS T, TT, D, AND F. IFORCE: TLNE TT,TTS.CL LERR [SIXBIT \CAN'T FORCE OUTPUT ON CLOSED FILE!\] SKIPGE F,F.MODE(TT) .SEE FBT.CM ;CAN'T FORCE A CHARMODE FILE POPJ P, MOVE F,FB.BFL(TT) IFN ITS,[ SUB F,FB.CNT(TT) JUMPE F,IFORC1 MOVE D,F ;NUMBER OF BYTES TO TRANSFER MOVE T,FB.IBP(TT) ;INITIAL BYTE POINTER .CALL SIOT ;OUTPUT THE (PARTIAL) BUFFER .LOSE 1400 IFORC1: ] ;END OF IFN ITS IFN D10,[ MOVE T,F.CHAN(TT) LSH T,27 IOR T,[OUT 0,0] XCT T ;OUTPUT THE CURRENT BUFFER CAIA HALT ;? OUTPUT ERROR ] ;END OF IFN D10 IFN D20,[ SUB F,FB.CNT(TT) JUMPE F,FORCE5 PUSHJ FXP,SAV3 ;PRESERVE ACS 1-3 MOVE 1,F.JFN(TT) MOVE 2,FB.IBP(TT) ;INITIAL BYTE POINTER MOVN 3,F ;NEGATIVE OF BYTE COUNT SOUT ;OUTPUT (PARTIAL) BUFFER ERJMP OIOERR PUSHJ FXP,RST3 ] ;END OF IFN D20 ADDM F,F.FPOS(TT) ;UPDATE FILE POSITION IFN ITS+D20, FORCE5: JSP D,FORCE6 ;INITIALIZE POINTER AND COUNT POPJ P, IFN ITS+D20,[ FORCE6: MOVE T,FB.BFL(TT) ;ROUTINE TO INITIALIZE BYTE POINTER AND COUNT MOVEM T,FB.CNT(TT) MOVE T,FB.IBP(TT) MOVEM T,FB.BP(TT) JRST (D) ];END IFN ITS+D20 IFN ITS,[ IOTTTT: SETZ SIXBIT \IOT\ ;I/O TRANSFER ,,F.CHAN(TT) ;CHANNEL # 400000,,T ;DATA POINTER (DATA?) SIOT: SETZ SIXBIT \SIOT\ ;STRING I/O TRANSFER ,,F.CHAN(TT) ;CHANNEL # ,,T ;BYTE POINTER 400000,,D ;BYTE COUNT ] ;END OF IFN ITS SUBTTL STATUS FILEMODE ;;; (STATUS FILEMODE ) RETURNS A LIST DESCRIBING ;;; THE FILE: NIL ==> FILE HAS BEEN CLOSED; OTHERWISE ;;; THE CAR OF THIS LIST IS A VALID OPTIONS ;;; LIST FOR THE OPEN FUNCTION. THE CDR OF THIS LIST ;;; CONTAINS INFORMATIVE ITEMS WHICH ARE NOT NECESSARILY ;;; USER-SETTABLE FEATURES ABOUT THE FILE. ;;; PRESENTLY SUCH GOODIES INCLUDE: ;;; RUBOUT AN OUTPUT TTY THAT CAN SELECTIVELY ERASE ;;; CURSORPOS AN OUTPUT TTY THAT CAN CURSORPOS WELL ;;; SAIL FOR AN OUTPUT TTY, HAS SAIL CHARACTER SET ;;; FILEPOS CAN FILEPOS CORRECTLY (RANDOM ACCESS) ;;; NON-FILE ARGUMENT CAUSES AN ERROR. SFMD0: %WTA NFILE SFILEMODE: JSP TT,AFOSP ;MUST BE A FILE OR SFA JRST SFMD0 IFN SFA,[ JRST SFMD0A ;IF FILE THEN HANDLE NORMALLY SETZ C, ;IF WE GO TO THE SFA, NO THIRD ARG MOVEI T,SO.MOD ;CAN THE SFA DO (STATUS FILEMODE)? MOVEI TT,SR.WOM TDNE T,@TTSAR(A) ;CAN IT DO THE OPERATION? JRST ISTCAL ;YES, CALL THE SFA AND RETURN MOVEI B,QWOP ;OTHERWISE, DO A WHICH-OPERATIONS PUSHJ P,ISTCSH PUSH P,A ;SAVE THE RESULTS MOVEI A,QSFA JSP T,%NCONS ;MAKE A LIST POP P,B JRST CONS ;RETURN ((SFA) {WHICH-OPERATIONS}) SFMD0A: ] ;END IFN SFA LOCKI MOVE TT,TTSAR(A) ;GET TTSAR BITS TLNE TT,TTS.CL ;RETURN NIL IF THE FILE IS CLOSED JRST UNLKFALSE MOVE R,F.FLEN(TT) ;IF LENGTH > 0 THEN BLOCK MODE, ELSE SINGLE MOVEI A,QBLOCK SKIPGE F,F.MODE(TT) .SEE FBT.CM MOVEI A,QSINGLE UNLOCKI PUSHJ P,NCONS MOVEI B,QDSK ;TWO MAJOR TYPES - TTY OR DSK TLNE TT,TTS.TY MOVEI B,QTTY PUSHJ P,XCONS MOVEI B,Q$ASCII ;ASCII, IMAGE, OR FIXNUM TLNE TT,TTS.IM MOVEI B,QIMAGE TLNN TT,TTS.IO TLNN TT,TTS.TY JRST SFMD1 TLNN F,FBT.FU ;INPUT TTY: FULL CHAR SET MEANS FIXNUM FILE SFMD1: TLNE TT,TTS MOVEI B,QFIXNUM PUSHJ P,XCONS MOVEI B,Q$IN ;INPUT, OUTPUT, OR APPEND MODE TLNE TT,TTS MOVEI B,Q$OUT TLNE F,FBT MOVEI B,QAPPEND PUSHJ P,XCONS MOVEI B,QECHO ;OTHER RANDOM MODE BITS - ECHO TLNE F,FBT.EC PUSHJ P,XCONS MOVEI B,QSCROLL ;SCROLL TLNE F,FBT.SC PUSHJ P,XCONS MOVEI C,(A) SETZ A, MOVEI B,QSAIL TLNE F,FBT.SA ;SAIL MODE PUSHJ P,XCONS MOVEI B,QRUBOUT TLNE F,FBT.SE ;RUBOUT-ABLE PUSHJ P,XCONS IFN USELESS*,[ MOVEI B,QCURSORPOS ;CURSORPOS-ABLE TLNE F,FBT.CP PUSHJ P,XCONS ] ;END OF IFN USELESS* MOVEI B,QFILEPOS ;FILEPOS-ABLE SKIPL R .SEE F.FLEN ;NEGATIVE => CAN'T FILEPOS PUSHJ P,XCONS MOVEI B,(C) JRST XCONS SUBTTL LOAD FUNCTION ;;; (LOAD FOO) LOADS THE FILE FOO. IT FIRST PROBEF'S TO ;;; ASCERTAIN THE EXISTENCE OF THE FILE, AND CHECKS THE FIRST ;;; WORD TO SEE WHETHER IT IS AN ASCII OR FASL FILE. ;;; IF NO SECOND FILE NAME IS GIVEN, "FASL" IS TRIED FIRST, ;;; AND THEN ">" IF NO FASL FILE EXISTS. ;;; IF A FASL FILE, IT GIVES THE FILE NAMES TO FASLOAD. ;;; IF AN ASCII FILE, IT IS OPENED, (INFILE ^Q, *, +, -, INSTACK) ;;; BOUND TO (, T, *, +, -, NIL), AND A READ-EVAL ;;; LOOP PERFORMED UNTIL END OF FILE OCCURS LEAVING INSTACK=NIL ;;; AND INFILE=T. LOAD: JUMPE A,CPOPJ ;IF GIVEN NIL AS ARG, RETURN NIL PUSHJ P,FIL6BT ;SUBR 1 MOVE F,-L.6EXT-L.6VRS+1(FXP) PUSHJ P,DMRGF ;DMRGF SAVES F 20$ PUSHJ P,6BTTLN LOCKI CAME F,DFNWD ;DEFAULT 2ND FILE NAME (OR EXTENSION) JUMPN F,LOAD3 ; TO "FASL" WHEN NOT SUPPLIED MOVE TT,DFFNWD MOVEM TT,<-L.6EXT-L.6VRS+1>-1(FXP) ;-1 for LOCKI word IFN D20,[ MOVE TT,[ASCII \0\] SKIPE <-L.6VRS+1>-1(FXP) ;VERSION NUMBER NULL? CAMN T,<-L.6VRS+1>-1(FXP) ; OR EQUAL TO *? IF EITHER CASE, MOVEM TT,<-L.6VRS+1>-1(FXP) ; THEN USE "0" ] ;END OF IFN D20 JSP T,FASLP1 JRST LOAD1 ;FILE NOT FOUND JRST LOAD2 ;FASL FILE LOAD5: UNLOCKI ;EXPR FILE FOUND HRRZ B,VIPLUS ;WE WANT +, -, * TO WORK AS FOR TOP LEVEL, HRRZ C,V. ; BUT NOT SCREW THE OUTSIDE WORLD HRRZ AR1,VIDIFFERENCE MOVEI AR2A,TRUTH JSP T,SPECBIND 0 A,VINFILE 0 B,VIPLUS 0 C,V. 0 AR1,VIDIFFERENCE 0 AR2A,TAPRED VINSTACK ;INSTACK temporarily gets NIL VFEXITFUNCTIONS MOVE AR2A,VFEXDEFAULT ;Default VFEXITFUNCTIONS MOVEM AR2A,VFEXITFUNCTIONS PUSHJ P,6BTNML PUSHJ P,[PUSH P,A MOVNI T,1 JRST $EOPEN ;Open as a file object ] LOAD6: MOVEM A,VINFILE ;Store this away PUSH P,A ;Save file that we haven't finished for ;exit handlers JSP TT,UNWINC ;Set up an unwind-protect form JRST LOAD7A ; Code to be protected EOFEV: ;(Get here with 7 PUSHs (5 AC's and 2 addrs) SKIPA A,VFEXITFUNCTIONS EOFEV1: HRRZ A,@VFEXITFUNCTIONS ;Next form MOVEM A,VFEXITFUNCTIONS JUMPE A,EOFEV2 ;until end of list HLRZ B,(A) MOVE A,-7(P) ;Get our call argument CALLF 1,(B) ;Call the user's function JRST EOFEV1 EOFEV2: MOVE A,-7(P) ;Get the file array we're hacking JSP TT,AFOSP ;Be sure it's still a file POPJ P, ; Not a file JRST $CLOSE ; SFA JRST $CLOSE ;Close it LOAD7: PUSHJ P,TLEVAL ;USE THE EVAL PART OF THE TOP LEVEL HRRZM A,V. LOAD7A: PUSHJ P,TLREAD ;USE THE READ PART OF THE TOP LEVEL JRST LOAD7 LOAD8: HRRZ B,VINFILE ;EOF TESTING SKIPN VINSTACK CAIE B,TRUTH JRST LOAD7A SETZM -LERSTP-1(P) ;Tell the cleanup that we finished the file JSP TT,UNWINE ;Perform our exit forms PUSHJ P,UNBIND POP P,A ;Our 'Did we finish?' flag should be on top JRST TRUE ;Return TRUTH LOAD1: IFN ITS+D10,[ IT$ MOVSI TT,(SIXBIT \>\) ;OTHERWISE TRY ">" SA$ MOVSI TT,(SIXBIT \___\) SA% 10$ MOVSI TT,(SIXBIT \LSP\) ;FOR D10, "LSP" MOVEM TT,-1(FXP) ;REMEMBER ADJUSTMENT FOR LOCKI WORD ] ;END OF IFN ITS+D10 IFN D20,[ MOVE TT,[ASCIZ \LSP\] ZZ==<-L.6EXT-L.6VRS+1>-1 ;REMEMBER: ADJUSTMENT FOR LOCKI WORD MOVEM TT,ZZ(FXP) SETZM ZZ+1(FXP) MOVEI T,ZZ+2(FXP) HRLI T,-1(T) BLT T,ZZ+L.6EXT-1(FXP) ;ZERO OUT REMAINING WORDS ] ;END OF IFN D20 LOAD3: MOVEI A,QLOAD JSP T,FASLP1 JRST LOAD4 ;LOSE COMPLETELY JRST LOAD2 ;FASL FILE JRST LOAD5 ;EXPR CODE LOAD2: UNLOCKI ;FASL FILE - GO FASLOAD IT PUSHJ P,6BTNML HRRZ B,VDEFAULTF JSP T,SPECBIND 0 B,VDEFAULTF ;DON'T LET FASLOAD CLOBBER DEFAULTF PUSHJ P,FASLOAD JRST UNBIND LOAD4: IOJRST 0,.+1 PUSH P,A UNLOCKI PUSHJ P,6BTNML ;LOSEY LOSEY PUSHJ P,NCONS POP P,B JRST XCIOL ;;; (FASLP ) TELLS WHETHER THE FILE IS A FASL FILE. ;;; ERROR IF FILE DOES NOT EXIST. $FASLP: PUSHJ P,FIL6BT PUSHJ P,DMRGF 20$ PUSHJ P,6BTTLN MOVEI A,Q$FASLP LOCKI JSP T,FASLP1 JRST LOAD4 SKIPA A,[TRUTH] MOVEI A,NIL UNLOCKI POPI FXP,L.F6BT ;POP CRUD OFF STACK POPJ P, ;;; ROUTINE TO TEST A FILE FOR FASL-NESS. ;;; WARNING! MUST SAVE "A" - SEE "LOAD:", "LOAD3:" AND "$FASLP:" ;;; JSP T,FASLP1 ;;; JRST NOTFOUND ;FILE NOT FOUND, OR OTHER ERROR ;;; JRST FASL ;FILE IS A FASL FILE ;;; ... ;FILE IS NOT A FASL FILE ;;; FXP MUST HOLD THE "SIXBIT" FILE NAMES, WITH A LOCKI WORD ABOVE THEM. ;;; USER INTERRUPTS MUST BE LOCKED OUT. FASLP1: IFN ITS,[ .CALL FASLP9 ;OPEN FILE ON TEMP CHANNEL JRST (T) .CALL FASLP8 ;RESTORE REFERENCE DATE JFCL ; (ONLY WORKS FOR DISK CHANNELS - IGNORE FAILURE) HRROI D,TT .IOT TMPC,D ;READ FIRST WORD .CLOSE TMPC, JUMPL D,2(T) ;NOT A FASL FILE IF ZERO-LENGTH TRZ TT,1 CAMN TT,[SIXBIT \*FASL*\] JRST 1(T) ;FASL FILE IF FIRST WORD CHECKS JRST 2(T) FASLP8: SETZ SIXBIT \RESRDT\ ;RESTORE REFERENCE DATE 401000,,TMPC ;CHANNEL # FASLP9: SETZ SIXBIT \OPEN\ ;OPEN FILE 5000,,6 ;IMAGE BLOCK INPUT 1000,,TMPC ;CHANNEL NUMBER ,,-4(FXP) ;DEVICE NAME ,,-2(FXP) ;FILE NAME 1 ,,-1(FXP) ;FILE NAME 2 400000,,-3(FXP) ;SNAME ] ;END OF IFN ITS IFN D10,[ PUSH P,T MOVEI T,.IODMP MOVE TT,-4(FXP) SETZ D, OPEN TMPC,T ;OPEN TEMP CHANNEL TO FILE POPJ P, MOVE T,-2(FXP) ;FILE NAME HLLZ TT,-1(FXP) ;EXTENSION SA$ CAMN TT,[SIXBIT \___\] SA$ SETZ TT, SETZ D, MOVE R,-3(FXP) ;PPN LOOKUP TMPC,T ;LOOK UP FILE NAMES JRST FASLP2 SETZB TT,R PUSH FXP,NIL ;USE A WORD ON FXP AS D10 CAN'T DO I/O TO AC'S HRROI D,-1(FXP) ;D AND R ARE THE DUMP MODE COMMAND LIST INPUT TMPC,D ;GET FIRST WORD OF FILE SA% CLOSE TMPC,CL.ACS ;DON'T UPDATE ACCESS DATE RELEASE TMPC, POP FXP,TT ;GET THE WORD READ FROM THE FILE POP P,R SA$ WARN [RESTORE REF DATE FOR SAIL PROBEF?] ;FALLS THROUGH ] ;END OF IFN D10 IFN D20,[ PUSH FLP,(FXP) ;SAVE THE LOCKI WORD, BUT OFF FXP POPI FXP,1 PUSH P,T PUSHJ P,X6BTNS ;GET NAMESTRING IN PNBUF PUSH FXP,(FLP) ;PUT LOCKI WORD BACK IN ITS PLACE POPI FLP,1 POP P,R PUSH P,A PUSH P,B MOVSI 1,(GJ%OLD+GJ%SHT) .SEE .GJDEF MOVE 2,PNBP GTJFN ;GET A JFN FOR THE FILE NAME JRST RSTR2 ;JUST EXITS THRU R, RESTORING A AND B MOVE 2,[440000,,OF%RD+OF%PDT] .SEE OF%BSZ OF%MOD SETZ TT, OPENF ;OPEN FILE, PRESERVING ACCESS DATE JRST FASLP2 BIN ;GET ONE 36.-BIT BYTE MOVE TT,2 CLOSF ;CLOSE THE FILE JFCL ;IGNORE ERROR RETURN SKIPA ;JFN HAS BEEN RELEASED BY THE CLOSE FASLP2: RLJFN ;RELEASE THE JFN JFCL POP P,B POP P,A ] ;END OF IFN D20 IFN D10+D20,[ TRZ TT,1 CAMN TT,[SIXBIT \*FASL*\] JRST 1(R) ;FASL FILE IF FIRST WORD CHECKS JRST 2(R) ] ;END OF IFN D10+D20 IFN D10,[ FASLP2: RELEASE TMPC, POPJ P, ] ;;; (DEFUN INCLUDE FEXPR (X) ;;; ((LAMBDA (F) ;;; (EOFFN F '+INTERNAL-INCLUDE-EOFFN) ;;; (INPUSH F)) ;;; (OPEN (CAR X)))) INCLUDE: HLRZ A,(A) ;FSUBR .INCLUD: ;SUBR JUMPE A,CPOPJ PUSHJ P,[PUSH P,A MOVNI T,1 JRST $EOPEN] INCLU1: MOVEI TT,FI.EOF MOVEI B,QINCEOF MOVEM B,@TTSAR(A) JRST INPUSH INCEOF==:FALSE ;INCLUDE'S EOF FUNCTION - SUBR 2 SUBTTL OPEN FUNCTION (INCLUDING SAIL EOPEN) ;;; (OPEN ) OPENS A FILE AND RETURNS A ;;; CORRESPONDING FILE OBJECT. IT IS ACTUALLY AN LSUBR ;;; OF ZERO TO TWO ARGUMENTS. THE DEFAULTS TO THE ;;; CURRENT DEFAULT FILE NAMES. THE DEFAULTS ;;; TO NIL. ;;; IF IS A NAMELIST OR NAMESTRING, A NEW FILE ARRAY ;;; IS CREATED. IF IS A FILE ARRAY ALREADY, IT IS ;;; CLOSED AND RE-OPENED IN THE SPECIFIED MODE; ITS FORMER ;;; MODES SERVE AS THE DEFAULTS FOR THE . ;;; THE DETERMINES A LARGE NUMBER OF ATTRIBUTES ;;; FOR OPENING THE FILE. FOR EACH ATTRIBUTE THERE ARE ;;; TWO OR MORE MUTUALLY EXCLUSIVE VALUES WHICH MAY BE ;;; SPECIFIED AS FOLLOWS. VALUES MARKED BY A * ARE THOSE ;;; USED AS DEFAULTS WHEN THE IS A NAMELIST OR ;;; NAMESTRING. IF THE IS AN ATOM, IT IS THE ;;; SAME AS SPECIFYING THE LIST OF THAT ONE ATOM. ;;; DIRECTION: ;;; * IN INPUT FILE ;;; * READ SAME AS "IN" ;;; OUT OUTPUT FILE ;;; PRINT SAME AS "OUT" ;;; APPEND OUTPUT, APPENDED TO EXISTING FILE ;;; DATA MODE: ;;; * ASCII FILE IS A STREAM OF ASCII CHARACTERS. ;;; SYSTEM-DEPENDENT TRANSFORMATIONS MAY ;;; OCCUR, SUCH AS SUPPLYING LF AFTER CR, ;;; OR BEING CAREFUL WITH OUTPUT OF ^P, ;;; OR MULTICS ESCAPE CONVENTIONS. ;;; FIXNUM FILE IS A STREAM OF FIXNUMS. THIS ;;; IS FOR DEALING WITH FILES THOUGHT OF ;;; AS "BINARY" RATHER THAN "CHARACTER". ;;; FOR TTY'S, THIS IS INTERPRETED AS ;;; "MORE-THAN-ASCII" OR "FULL CHARACTER ;;; SET" MODE, WHICH READS 9 BITS AT SAIL ;;; AND 12. ON ITS. ;;; IMAGE FILE IS A STREAM OF ASCII CHARACTERS. ;;; ABSOLUTELY NO TRANSFORMATIONS ARE MADE. ;;; DEVICE TYPE: ;;; * DSK STANDARD KIND OF FILE. ;;; CLA (ITS ONLY) LIKE DSK, BUT REQUIRES BLOCK MODE, ;;; AND GOBBLES THE FIRST TWO WORDS, INSTALLING ;;; THEM IN THE TRUENAME. USEFUL PRIMARILY FOR ;;; A CLI-MESSAGE INTERRUPT FUNCTION. ;;; TTY CONSOLE. IN PARTICULAR, ONLY TTY INPUT ;;; FILES HAVE INTERRUPT CHARACTER FUNCTIONS ;;; ASSOCIATED WITH THEM. ;;; BUFFERING MODE: ;;; * BLOCK DATA IS BUFFERED. ;;; SINGLE DATA IS UNBUFFERED. ;;; PRINTING AREA: ;;; ECHO (ITS ONLY) OPEN TTY IN ECHO AREA ;;; SOME OF THESE VALUES ARE OF COURSE SYSTEM-DEPENDENT. ;;; YOUR LOCAL LISP SYSTEM WILL ATTEMPT TO DO THE RIGHT THING, ;;; HOWEVER, IN ANY CASE. ;;; IF THE OPTIONS LIST IS INVALID IN ANY WAY, OPEN MAY EITHER ;;; GIVE A WRNG-TYPE-ARGS ERROR, OR BLITHELY ASSUME A CORRECTED ;;; VALUE FOR AN ATTRIBUTE. IN GENERAL, ERRORS SHOULD OCCUR ;;; ONLY FOR TRULY CONFLICTING SPECIFICATIONS. ON THE OTHER ;;; HAND, SPECIFYING BLOCK MODE FOR A DEVICE THAT THE SYSTEM ;;; WANTS TO HANDLE ONLY IN CHARACTER MODE WILL JUST GO AHEAD ;;; AND USE CHARACTER MODE. IN GENERAL, ONE SHOULD USE ;;; (STATUS FILEMODE) TO SEE HOW THE FILE WAS ACTUALLY OPENED. SA% $EOPEN: $OPEN: MOVEI D,Q$OPEN ;LSUBR (0 . 2) CAMGE T,XC-2 JRST WNALOSE SETZB A,B ;BOTH ARGUMENTS DEFAULT TO NIL CAMN T,XC-2 POP P,B SKIPE T POP P,A IFN SFA,[ JSP TT,AFOSP ;WERE WE HANDED AN SFA AS FIRST ARG? JFCL JRST $OPNNS ;NOPE, CONTINUE AS USUAL MOVEI C,(B) ;ARG TO SFA IS THE LIST GIVEN TO OPEN MOVEI B,Q$OPEN ;OPERATION JRST ISTCSH ;SHORT INTERNAL CALL $OPNNS: ] ;END IFN SFA ;THE TWO ARGUMENTS ARE NOW IN A AND B. ;WE NOW PARSE THE OPTIONS LIST. F WILL HOLD OPTION VALUES, ; AND D WILL INDICATE WHICH WERE SPECIFIED EXPLICITLY BY THE USER. OPEN0J: PUSH P,T ;SAVE NUMBER OF ARGS ON P (NOT FXP!) SETZB D,F JSP TT,AFILEP ;IS THE FIRST ARGUMENT A FILE OBJECT? JRST OPEN1A MOVEI TT,F.MODE MOVE F,@TTSAR(A) ;IF SO, USE ITS MODE AS THE DEFAULTS IFN ITS\D20,[ SKIPE B ;MAKE CHUCK RICH HAPPY - DON'T LET "ECHO" CARRY TLZ F,FBT.EC+FBT.CP+FBT.SC ; OVER IF A NON-NULL OPTIONS LIST WAS GIVEN ] ;END OF ITS\D20 OPEN1A: JUMPE B,OPEN1Y ;JUMP OUT IF NO OPTIONS SUPPLIED MOVEI C,(B) SKOTTN B,LS JRST OPEN1C MOVSI AR2A,(B) ;IF A SINGLE, ATOMIC OPTION WAS GIVEN, AR2A MOVEI C,AR2A ; IS A FAKE CONS CELL SO IT LOOKS LIKE A LIST OPEN1C: JUMPE C,OPEN1L ;JUMP OUT IF LAST OPTION PROCESSED HLRZ AR1,(C) OPN1F1: JUMPE AR1,OPEN1G ;IGNORE NIL AS A KEYWORD MOVSI TT,-LOPMDS OPEN1F: HRRZ R,OPMDS(TT) ;COMPARE GIVEN OPTION AGAINST VALID ONES CAIN AR1,(R) JRST OPEN1K ;JUMP ON MATCH AOBJN TT,OPEN1F EXCH A,AR1 ;ERRONEOUS KEYWORD INTO AR1 WTA [IS ILLEGAL KEYWORD - OPEN!] EXCH A,AR1 OPEN1G: HRRZ C,(C) ;CDR DOWN LIST UNTIL ALL DONE JRST OPEN1C OPEN1K: TDNN D,OPMDS(TT) ;SEE IF THERE IS A CONFLICT JRST OPEN1Z OPEN1H: EXCH A,B WTA [ILLEGAL OPTIONS LIST - OPEN!] EXCH A,B JRST OPEN0J OPEN1Z: HLRZ R,OPMDS(TT) TLO D,(R) TLZ F,(R) TRZ F,(R) IOR F,OPBITS(TT) JRST OPEN1G ;;; LEFT HALF IS SET OF MODE BITS WHICH THE OPTION IN THE RIGHT ;;; HALF WILL CONFLICT WITH IF ANY ONE ELSE SELECTS THEM. OPMDS: FBT.AP+1,,Q$IN FBT.AP+1,,QOREAD FBT.AP+1,,Q$OUT FBT.AP+1,,Q%PRINT FBT.AP+1,,QAPPEND 000014,,Q$ASCII 000014,,QFIXNUM 000014,,QIMAGE 000002,,QDSK IT$ FBT.CA+2,,QCLA 000002,,QTTY FBT.CM,,QBLOCK FBT.CM,,QSINGLE 0,,QNODEFAULT IT$ FBT.EC,,QECHO IT$ FBT.SC,,QSCROLL LOPMDS==.-OPMDS ;;; MODE BITS ACTUALLY TO BE SET FOR AN OPTION IN THE OPMDS TABLE. OPBITS: 0 ;IN 0 ;READ 1 ;OUT 1 ;PRINT FBT.AP,,1 ;APPEND 0 ;ASCII 4 ;FIXNUM 10 ;IMAGE 0 ;DSK IT$ FBT.CA,,0 ;CLA 2 ;TTY 0 ;BLOCK FBT.CM,, ;SINGLE FBT.ND,, ;NODEFAULT IT$ FBT.EC,, ;ECHO IT$ FBT.SC,, ;SCROLL TBLCHK OPBITS,LOPMDS ;STATE OF THE WORLD: ; FIRST ARG TO OPEN IN A ; SECOND ARG IN B ; D CONTAINS BITS FOR ACTUALLY SPECIFIED OPTIONS IN LEFT HALF ; F CONTAINS BITS FOR OPTIONS .SEE FBT.CM ;AND FRIENDS ; 1.4-1.3 0 => ASCII, 1 => FIXNUM, 2 => IMAGE ; 1.2 0 => DSK, 1 => TTY ; 1.1 0 => IN, 1 => OUT ; BITS 1.4-1.1 ARE USED TO INDEX VARIOUS TABLES LATER ; ACTUAL NUMBER OF ARGS ON P ;WE NOW EMBARK ON DEFAULTING AND MAKING CONSISTENT THE VARIOUS MODES OPEN1L: TLNE D,FBT.CM ;SKIP IF SINGLE VS. BLOCK WAS UNSPECIFIED JRST OPEN1Y TRNE F,2 ;SKIP UNLESS TTY TLO F,FBT.CM ;FOR TTY, DEFAULT TO SINGLE, NOT BLOCK, MODE OPEN1Y: IFN ITS\D20,[ TRC F,3 TRCE F,3 TLZ F,FBT.EC+FBT.SC ;ECHO AND SCROLL MEANINGFUL ONLY FOR TTY OUTPUT ] ;END OF ITS\D20 TRNN F,2 ;SKIP IF TTY JRST OPEN1S TLZ F,FBT.AP ;CAN'T APPEND TO A TTY TRNN F,1 TLO F,FBT.CM ;CAN'T DO BLOCK TTY INPUT TRNE F,4 ;FIXNUM TTY I/O USES FULL CHAR SET TLO F,FBT.FU ;NOW WORRY ABOUT FILE NAMES AND ALLOCATING A FILE OBJECT OPEN1S: PUSH P,A PUSH P,B PUSH FXP,F CAIE A,TRUTH ;T MEANS TTY FILE ARRAY... JRST OPEN1M TRNN F,1 SKIPA A,V%TYI ;TTY INPUT IF MODE BITS SAY INPUT HRRZ A,V%TYO ; AND OUTPUT OTHERWISE OPEN1M: PUSH P,A PUSHJ P,FIL6BT ;GET FILE NAME SPECS MOVE F,-L.F6BT(FXP) ;GET MODE BITS TLZN F,FBT.ND ;MERGE WITH DEFAULT NAMES? PUSHJ P,DMRGF ;MERGE IN DEFAULT NAMES (SAVES F) 20$ PUSHJ P,6BTTLN HRLZI F,FBT.ND ANDCAM F,-L.F6BT(FXP) ;TURN OFF FBT.ND BIT IN SAVED FLAGS MOVE A,(P) ;GET (POSSIBLY MUNGED FOR T) FIRST ARG JSP TT,AFILEP ;SKIP IF WE GOT A REAL LIVE SAR JRST OPEN1N PUSHJ P,ICLOSE ;CLOSE IT IF NECESSARY ;;; WARN [SHOULD WE RELEASE THE JFN AT THIS POINT?] MOVE A,(P) MOVE D,-3(P) ;IF ONLY ONE ARG TO OPEN, AND AOJE D,OPEN1Q ; THAT A SAR, RE-USE THE ARRAY MOVE F,-L.F6BT(FXP) MOVEI TT,F.MODE XOR F,@TTSAR(A) TDNE F,[FBT.CM,,17] JRST OPEN1P PUSHJ P,OPNCLR ;IF TWO ARGS, BUT SAME MODE, JRST OPEN1Q ; CLEAR ARRAY, THAN RE-USE ;WE MUST ALLOCATE A FRESH ARRAY OPEN1N: MOVSI A,-1 ;ARRANGE TO GET A FRESH SAR ;WE HAVE A SAR, BUT MUST ALLOCATE A NEW ARRAY BODY OPEN1P: MOVE F,-L.F6BT(FXP) ;GET MODE BITS AGAIN ;DETERMINE SIZE OF NEW ARRAY IFN ITS+D20,[ HLRZ TT,OPEN9A(F) ;FOR ITS AND D20, DESIRABLE SIZES ARE IN A TABLE SKIPGE F .SEE FBT.CM HRRZ TT,OPEN9A(F) ] ;END OF IFN ITS+D20 IFN D10,[ ;FOR D10, WE MUST ASK THE OPERATING SYSTEM FOR THE PROPER BUFFER SIZE MOVE TT,-3(FXP) ;GET DEVICE NAME CAMN TT,[SIXBIT \PTY\] JRST .+3 CAME TT,[SIXBIT \TTY\] TRZ F,2 ;? NOT A TTY UNLESS IT IS *THE* TTY TRNN F,2 TLZA F,FBT.CM ;ONLY THE TTY CAN BE SINGLE MODE, TLO F,FBT.CM ; AND THE TTY MUST BE SINGLE MODE! SA$ TRNE F,2 ;FOR SAIL, *THE* TTY SHOULD DEFAULT TO LINEMODE SA$ TLO F,FBT.LN MOVEM F,-4(FXP) ;SAVE BACK MODE BITS PUSHN FXP,1 ;PUSH A SLOT FOR BUFFER SIZE DATA JUMPL F,OPEN1R .SEE FBT.CM IFE SAIL,[ HLRZ T,OPEN9C(F) ;GET DESIRED I/O MODE MOVEI D,T DEVSIZ D, ;ON SUCCESS, GET SETO D, SKIPG D MOVE D,[2,,3+LIOBUF] ;ON FAILURE, USE 2 BUFFERS AT LIOBFS WORDS APIECE HLRZ TT,D CAIGE TT,NIOBFS ] ;END IFE SAIL IFN SAIL,[ MOVE D,TT ;DEVICE NAME IN D BUFLEN D, ;GET BUFFER SIZE SKIPN D ;NO WAY!! (BUT BETTER CHECK ANYWAY) MOVEI D,LIOBUF+1 ;DEFAULT ADDI D,2 ;WE NEED ACTUAL SIZE OF BUFFER, NOT SIZE-2 ] ;END IFN SAIL HRLI D,NIOBFS ;HOWEVER, WE MUST USE AT LEAST NIOBFS BUFFERS MOVEM D,(FXP) ;SAVE THIS DATA HLRZ TT,D IMULI D,(TT) ;GET TOTAL SPACE OCCUPIED BY BUFFERS HLRZ TT,OPEN9A(F) ADDI TT,(D) ;ADD TO SIZE OF REST OF FILE ARRAY CAIA OPEN1R: HRRZ TT,OPEN9A(F) ;FOR CHARACTER MODE, TABLE HAS TOTAL ARRAY SIZE ] ;END OF IFN D10 PUSHJ P,MKLSAR ;MAKE AN ARRAY - SIZE IN TT, SAR (IF ANY) IN A 10$ POP FXP,D OPEN1Q: LOCKI ;LOCK OUT USER INTERRUPTS ;FALLS THROUGH ;FALLS IN ;STATE OF THE WORLD: ; USER INTERRUPTS LOCKED OUT ; SAR FOR FILE ARRAY IN A ; FOR D10, BUFFER SIZE INFORMATION IN D ; P: FIRST ARGUMENT, OR TTY SAR IF ARGUMENT WAS T ; SECOND ARGUMENT ; FIRST ARGUMENT ; (NEGATIVE OF) ACTUAL NUMBER OF ARGS ; FXP: LOCKI WORD ; FILE NAMES IN "SIXBIT" FORMAT (L.F6BT WORDS) ; MODE BITS MOVSI TT,TTS.IM+TTS.BN+TTS.TY+TTS.IO ANDCAM TT,TTSAR(A) MOVE F,-1-L.F6BT(FXP) ;GET MODE BITS HLLZ TT,OPEN9B(F) IORB TT,TTSAR(A) ;SET CLOSED BIT AND FILE TYPE BITS IFN D10,[ JUMPL F,OPEN1T .SEE FBT.CM HLRZM D,FB.NBF(TT) ;STORE NUMBER OF BUFFERS SUBI D,3 HRRZM D,FB.BWS(TT) ;STORE BUFFER DATA SIZE IN WORDS OPEN1T: ] ;END OF IFN D10 MOVSI TT,AS.FIL IORB TT,ASAR(A) ;NOW CAN TURN ON FILE ARRAY BIT MOVEI T,-F.GC HRLM T,-1(TT) ;SET UP GC AOBJN POINTER MOVEM A,(P) ;SAVE THE FILE ARRAY SAR PUSHJ P,ALCHAN ;ALLOCATE A CHANNEL JRST OPNALZ ;LOSE IF NO FREE CHANNELS MOVE TT,TTSAR(A) HRRZM F,F.CHAN(TT) ;SAVE THE CHANNEL NUMBER IN THE FILE OBJECT POP FXP,T ;BEWARE THE LOCKI WORD! MOVEI D,F.DEV(TT) HRLI D,-L.F6BT+1(FXP) BLT D,F.DEV+L.F6BT-1(TT) ;COPY FILE NAMES INTO FILE OBJECT POPI FXP,L.F6BT ;FLUSH THEM FROM THE STACK EXCH T,(FXP) ;PUT LOCKI WORD ON STACK, PUSH FXP,T ;WITH MODE BITS ABOVE IT ;FALLS THROUGH ;FALLS IN ;STATE OF THE WORLD: ; USER INTERRUPTS LOCKED OUT ; TTSAR OF FILE ARRAY IN TT ; P: SAR FOR FILE ARRAY ; SECOND ARGUMENT TO OPEN ; FIRST ARGUMENT ; -<# OF ACTUAL ARGS> ; FXP: MODE BITS (THEY OFFICIALLY LIVE HERE, NOT IN T) ; LOCKI WORD ;PDLS MUST STAY THIS WAY FROM NOW ON FOR THE SAKE OF IOJRST'S. .SEE OPENLZ OPEN3: MOVE T,(FXP) ;GET MODE BITS ;NOW WE ACTUALLY TRY TO OPEN THE FILE IFN ITS,[ MOVE D,OPEN9C(T) TLNE T,FBT.AP ;APPEND MODE => TRO D,100000 ; ITS WRITE-OVER MODE TLNE T,FBT.EC ;MAYBE OPEN AN OUTPUT TTY TRO D,%TJPP2 ; IN THE ECHO AREA (PIECE OF PAPER #2) .CALL OPENUP IOJRST 4,OPNLZ0 .CALL RCHST ;READ BACK THE REAL AND TRUE NAMES .LOSE 1400 ] ;END OF IFN ITS IFN D10,[ JUMPL T,OPEN3M .SEE FBT.CM ;NEED NOT ALLOCATE A CHANNEL FOR *THE* TTY MOVE F,F.CHAN(TT) SA$ MOVEI R,(F) MOVEI D,(F) IMULI D,3 ADDI D,BFHD0 ;COMPUTE ADDRESS OF BUFFER HEADER MOVEM D,FB.HED(TT) ;REMEMBER BUFFER HEADER ADR SETZM (D) ;CLEAR BUFFER POINTER (TO FORCE NEW BUFFERS) SETZM 1(D) ;CLEAR OLD BYTE POINTER SETZM 2(D) ;CLEAR BYTE COUNT TRNE T,1 MOVSS D ;IF OUTPUT BUFFER, PUT ADDRESS IN LEFT HALF PUSH FXP,TT ;SAVE THE TTSAR MOVE T,OPEN9C(T) ;GET THE I/O MODE FROM THE TABLE MOVE TT,F.DEV(TT) LSH F,27 IOR F,[OPEN 0,T] XCT F ;OPEN THE FILE JRST OPNAND SA$ SHOWIT R, MOVE R,-1(FXP) ;GET MODE BITS XOR F,[#] TRNE R,1 XOR F,[#] MOVE TT,(FXP) ;GET BACK TTSAR HRR F,FB.NBF(TT) ;GET NUMBER OF BUFFERS IN RH OF UUO MOVEI TT,FB.BUF(TT) EXCH TT,.JBFF ;.JBFF IS THE ORIGIN FOR ALLOCATING BUFFERS XCT F ;TELL THE MONITOR TO ALLOCATE BUFFERS MOVEM TT,.JBFF ;RESTORE OLD VALUE OF .JBFF AND F,[0 17,] ;ISOLATE CHANNEL NUMBER AGAIN IOR F,[LOOKUP 0,T] MOVE TT,(FXP) ;GET TTSAR BACK IN TT TRNE R,1 ;WE NEED TO PERFORM A LOOKUP FOR SA$ TLNE R,FBT.AP ; EITHER "IN" OR "APPEND" MODE SA$ CAIA JRST OPEN3C MOVE T,F.FN1(TT) MOVE R,F.PPN(TT) HLLZ TT,F.FN2(TT) SA$ CAMN TT,[SIXBIT \___\] SA$ SETZ TT, SETZ D, XCT F ;PERFORM THE LOOKUP IOJRST 4,OPNLZ1 ;LOSEY LOSEY OPEN3C: MOVE D,-1(FXP) ;GET MODE BITS TRNN D,1 ;NEED TO PERFORM AN ENTER FOR JRST OPEN3D ; EITHER "OUT" OR "APPEND" MODE SA$ TLNN D,FBT.AP ;APPEND MODE MEANS READ-ALTER, DO LOOKUP FIRST XOR F,[#] MOVE TT,(FXP) ;GET TTSAR MOVE T,F.FN1(TT) MOVE R,F.PPN(TT) HLLZ TT,F.FN2(TT) SA$ CAMN TT,[SIXBIT \___\] SA$ SETZ TT, SETZ D, XCT F ;DO THE ENTER (OR POSSIBLY LOOKUP FOR SAIL) IOJRST 4,OPNLZ1 ;LOSEY LOSEY IFN SAIL,[ MOVE D,-1(FXP) ;GET THOSE MODE BITS ONCE MORE TLNN D,FBT.AP ;APPEND MODE MEANS READ-ALTER JRST SOPEN3C ;NORMAL CASE SO JUMP AHEAD XOR F,[#] ;MUMBLE MOVE TT,(FXP) ;GET TTSAR MOVE T,F.FN1(TT) PUSH FXP,R ;SAVE SIZE INFO MOVE R,F.PPN(TT) HLLZ TT,F.FN2(TT) CAMN TT,[SIXBIT \___\] SETZ TT, SETZ D, XCT F ;PERFORM THE ENTER IOJRST 4,OPNLZS ;LOSEY LOSEY XOR F,[#] XCT F ;SET UP BUFFER HEADER BYTE POINTER AND COUNT XOR F,[#] ;NOW THE UGETF, HEH, HEH XCT F POP FXP,R ;RESTORE SIZE INFO JRST OPEN3D ;GO, GO, GO SOPEN3C: ] ;END IFN SAIL XOR F,[#] XCT F ;SET UP BUFFER HEADER BYTE POINTER AND COUNT ;AS A RESULT OF THE LOOKUP OR ENTER, THE SIZE INFORMATION IS IN R OPEN3D: MOVE D,TT POP FXP,TT HLLZM D,F.RFN2(TT) ;SAVE AWAY THE REAL, TRUE FILE NAMES MOVEM T,F.RFN1(TT) MOVE D,F.CHAN(TT) ;GET CHANNEL FOR DEVCHR DEVCHR D, ;DEVICE CHRACTERISTICS TLNE D,(DV.DIR) ;IF NON-DIRECTORY ZERO TRUENAMES JRST OPN3D1 SETZM F.RFN2(TT) SETZM F.RFN1(TT) OPN3D1: MOVE D,F.CHAN(TT) SA% DEVNAM D, ;GET REAL NAME OF DEVICE SA$ PNAME D, MOVE D,F.DEV(TT) ;USE GIVEN DEVICE NAME ON FAILURE MOVEM D,F.RDEV(TT) MOVE F,F.CHAN(TT) ;TRY TO DETERMINE REAL PPN SA% DEVPPN F, SA% CAIA SA% JRST OPEN3F SA% TRZ D,770000 CAMN D,[SIXBIT \SYS\] JRST OPEN3E SA% GETPPN F, ;IF ALL ELSE FAILS, ASSUME YOUR OWN PPN SA% JFCL ;CAN'T REALLY FAIL - THIS JFCL IS FOR ULTRA SAFETY SA$ SKIPE F,F.PPN(TT) ;IF PPN WAS SPECIFIED SA$ JRST OPEN3F ;USE IT AS TRUE PPN SA$ SETZ F, SA$ DSKPPN F, ;FOR SAIL, USE THE DSKPPN (ALIAS) JRST OPEN3F OPEN3E: SA% MOVE F,[%LDSYS] SA% GETTAB R, SA% MOVE F,R70+1 ;ASSUME SYS: IS 1,,1 IF GETTAB FAILS SA$ MOVE F,[SIXBIT \ 1 3\] ;IT'S [1,3] ON SAIL OPEN3F: MOVEM F,F.RPPN(TT) JRST OPEN3N OPEN3M: MOVE D,F.DEV(TT) ;FOR THE TTY, JUST COPY THE DEVICE NAME MOVEM D,F.RDEV(TT) OPEN3N: ] ;END OF IFN D10 IFN D20,[ TLNE T,FBT.EC+FBT.SC LERR [SIXBIT \ECHO AREAS AND SCROLL MODE NOT YET IMPLEMENTED FOR TWENEX!\] ;; HERE WITH MODE BITS IN T HRRZS T ;GET ONLY OPEN9C TABLE INDEX (OPEN MODE) CAILE T,3 ;ONLY CHECK FOR TTY IF STANDARD MODE JRST OPEN3D MOVE T,F.DEV(TT) CAME T,[ASCII \TTY\] ;SKIP IF OPENING *THE* TTY JRST OPEN3D MOVEI 1,.PRIIN ;CONSIDER USING THE PRIMARY JFN TLNE TT,TTS.IO ; OF THE APPROPRIATE DIRECTION MOVEI 1,.PRIOU MOVEI 3,0 ;NO JFN FOR TTY ; GTSTS ;MAKE SURE IT IS OPEN ; JUMPGE 2,OPEN3D .SEE GS%OPN ; MOVSI D,(GS%RDF+GS%NAM) ;MAKE SURE IT CAN DO THE KIND OF I/O WE WANT ; TLNE TT,TTS.IO ; MOVSI D,(GS%WRF+GS%NAM) ; TDC 2,D ; TDCN 2,D MOVE T,(FXP) ;RESTORE FLAG BITS JRST OPEN3E ;HERE TO ALLOCATE A FRESH JFN AND OPEN THE FILE OPEN3D: PUSH FXP,TT ;SAVE THE TTSAR MOVEI T,F.DEV(TT) HRLI T,-L.F6BT PUSH FXP,(T) ;COPY THE GIVEN DEVICE NAMES ONTO THE STACK AOBJN T,.-1 PUSHJ P,6BTTLS ;CONVERT TO A NAMESTRING IN PNBUF POP FXP,TT ;GET TTSAR MOVE T,(FXP) ;RESTORE MODE BITS IN T MOVSI 1,GJ%SHT .SEE .GJDEF TRNE T,1 TLNE T,FBT.AP TLOA 1,(GJ%OLD) ;FOR INPUT OR APPEND, WE WANT AN EXISTING FILE TLO 1,(GJ%FOU+GJ%NEW) ;FOR OUTPUT, A NON-EXISTENT FILE MOVE 2,PNBP GTJFN ;GET A JFN IOJRST 4,OPNLZ0 MOVE 3,1 ;SAVE JFN OPEN3E: MOVE 2,OPEN9C(T) ;GET OPEN MODE TLNE T,FBT.AP ;APPEND MODE, SET APPEND, READ BITS, CLR WRITE TRC 2,OF%RD ; WANT UPDATE (WAS OF%APP+OF%WR+OF%RD) OPENF ;OPEN THE FILE JRST OPNLZR HRRZM 1,F.JFN(TT) ;SAVE THE JFN IN THE FILE OBJECT ] ;END OF IFN D20 ;FALLS THROUGH ;FALLS IN 10$ MOVE T,(FXP) ;FOR D10, FLAGS IN T MIGHT HAVE BEEN DESTROYED JUMPL T,OPEN3G .SEE FBT.CM MOVE D,OPEN9D(T) ;SOME INITIALIZATION FOR BLOCK MODE FILES HRRZM D,FB.BYT(TT) ;SET UP BYTE SIZE IFN ITS+D20,[ HRRI D,FB.BUF-1(TT) MOVEM D,FB.IBP(TT) ;SET UP INITIAL BUFFER POINTER HRRZ D,OPEN9B(T) ] ;END OF IFN ITS+D20 10$ MOVE D,FB.BWS(TT) IMUL D,FB.BYT(TT) ;SET UP BUFFER LENGTH (IN BYTES) MOVEM D,FB.BFL(TT) OPEN3G: SETZM F.FPOS(TT) ;FILEPOS=0 (UNTIL FURTHER NOTICE) ;NOW DETERMINE THE SIZE OF THE FILE, AND SET THE ACCESS POINTER (IF APPLICABLE) ;MODE BITS ARE IN T, TTSAR IS IN TT; FOR D10, FILE SIZE INFO IN R; ;FOR D20, JFN IS IN 1 IFN ITS,[ SKIPL F.FLEN(TT) ;THIS WAS SET BY RCHST BEFORE; -1 = NOT RANDOM JRST OPEN3P ; ACCESS TLZ T,FBT.AP ;CAN'T APPEND IF NOT RANDOMLY ACCESSIBLE JRST OPEN3Q OPEN3P: HRLZI D,1 ;ASSUME 1000000 FOR FAILING FILLEN (USR DEVICE) .CALL FILLEN ;DETERMINE LENGTH OF FILE MOVEM D,F.FLEN(TT) TLNN T,FBT.AP JRST OPEN3Q MOVE D,F.FLEN(TT) ;FOR APPEND MODE, SET THE ACCESS MOVEM D,F.FPOS(TT) ; POINTER TO THE END OF THE FILE .CALL ACCESS .LOSE 1400 ] ;END OF IFN ITS IFN D10,[ JUMPL T,OPEN3Q ;DON'T DO ANY OF THIS FOR TTY MOVE D,F.CHAN(TT) DEVCHR D, TLNE D,(DV.DIR) JRST OPEN3K SA$ TLZ T,FBT.AP ;ASSUME A NON-DIRECTORY DEVICE CAN'T APPEND SETOM F.FLEN(TT) ; OR PERFORM RANDOM ACCESS JRST OPEN3Q ;FILE SIZE INFORMATION IS IN R OPEN3K: SA% HLRE R,R ;FOR TOPS-10/CMU, THE LEFT HALF OF R SA% SKIPL R ; IS A WORD COUNT IF NEGATIVE AND A BLOCK COUNT SA% IMULI R,200 ; IF POSITIVE SA$ MOVSS R ;SAIL JUST HAS SWAPPED NEGATIVE WORD COUNT MOVMS R IMUL R,FB.BYT(TT) MOVEM R,F.FLEN(TT) ;STORE FILE LENGTH SA% ;SHOULD FALL THRU TO OPEN3Q IFN SAIL,[ TLNN T,FBT.AP JRST OPEN3Q MOVEM R,F.FPOS(TT) ;FOR APPEND MODE, SET POINTER TO EOF MOVE F,F.CHAN(TT) LSH F,27 IOR F,[UGETF 0,R] ;THIS UUO WILL CLOBBER R ;SA% IOR F,[USETI 0,-1] XCT F ;SET MONITOR'S POINTER TO EOF ;HACK UP ON SAIL'S RECORD OFFSET FEATURE SETZM FB.ROF(TT) ;ASSUME NO RECORD OFFSET TLNN D,200000 ;SKIP IF DSK/UDP (DEVCHR RESULT IS STILL IN D) JRST OPEN3Q MOVEM T,(FXP) PUSH FXP,TT XOR F,[#] MOVE T,[SIXBIT \GODMOD\] MOVEI TT,20 ;SIXBIT \GODMOD\ ? 20 => GET RECORD OFFSET IN D XCT F POP FXP,TT MOVE T,(FXP) ;CONVERT RECORD OFFSET TO A BYTE OFFSET SUBI D,1 ; FROM THE LOGICAL ORIGIN OF THE FILE IMUL D,FB.BFL(TT) MOVNM D,FB.ROF(TT) ;STORE AS A NEGATIVE OFFSET IN BYTES ] ;END OF IFN SAIL ] ;END OF IFN D10 IFN D20,[ SIZEF ;GET SIZE OF FILE JRST OPN3JA ; NOT A SIZEABLE FILE? MOVE 2,[2,,.FBBYV] MOVEI 3,D GTFDB ;R GETS LENGTH IN "FILE-BYTES" LDB C,[300600,,D] ; C GETS "FILE-BYTE" SIZE (IN BITS) MOVEI 2,36. IDIVI 2,(C) MOVE D,2 ;D HAS # OF "FILE-BYTES" PER WORD TLNN T,FBT.AP JRST OPEN3L SETO 2, SFPTR ;SET FILE POSITION TO END FOR APPENDING JRST OPEN3J RFPTR ;READ BACK THE ACTUAL POSITION IOJRST 4,OPENLZ MOVE R,2 ;R HAS FILEN IN "FILE-BYTES", D HAS # OF "FILE-BYTES" PER WORD OPEN3L: TRNE T,4 JRST OPN3LB ;FIXNUM MODE - 7-BIT-BYTE FILEN TO WORD COUNT OPN3LA: CAIN D,5 ;ASCII MODE FILE ARRAY - CHECK IF JRST OPN3LC ; "FILE-BYTE" SIZE IS ALREAD 7 BITS IMULI R,5 ; IF NOT, CONVERT COUNT TO 7-BIT-BYTE COUNT OPN3LB: CAIN D,1 JRST OPN3LC ADDI R,-1(D) IDIVI R,(D) OPN3LC: MOVEM R,F.FLEN(TT) ;STORE THE CALCULATED LENGTH-OF-FILE TLNE T,FBT.AP MOVEM R,F.FPOS(TT) ;SET FILE POSITION TO END (FOR APPEND MODE) JRST OPEN3Q OPEN3J: CAIE 1,SFPTX2 ;ILLEGAL TO RESET POINTER FOR THIS FILE? IOJRST 4,OPENLZ OPN3JA: TLZ T,FBT.AP ;IF SO, JUST SAY WE CAN'T APPEND SETOM F.FLEN(TT) ] ;END OF IFN D20 OPEN3Q: MOVEM T,(FXP) ;SAVE BACK POSSIBLY ALTERED MODE BITS IFN ITS,[ TLNN T,FBT.CA ;FOR THE CLA DEVICE, JRST OPEN3H ; GOBBLE DOWN THE FIRST TWO WORDS, MOVEI T,F.RFN1(TT) ; WHICH ARE THE SIXBIT FOR THE HRLI T,444400 ; UNAME-JNAME OF THE SENDER, AND MOVEI D,2 ; USE THEM FOR THE TRUENAMES .CALL SIOT ; OF THE FILE ARRAY IOJRST 4,OPENLZ MOVE T,(FXP) ;RESTORE MODE BITS OPEN3H: ] ;END OF IFN ITS TRNE T,1 JRST OPEN3V HRRZ D,DEOFFN ;FOR INPUT, GET THE DEFAULT EOFFN MOVEM D,FI.EOF(TT) SETZM FI.BBC(TT) ; SETZM FI.BBF(TT) ;NOT IMPLEMENTED YET JRST @OPEN3Z(T) ;DISPATCH TO APPROPRIATE PLACE OPEN3V: HRRZ D,DENDPAGEFN ;FOR OUTPUT, GET THE DEFAULT ENDPAGEFN MOVEM D,FO.EOP(TT) MOVE D,DPAGEL ;DEFAULT PAGEL MOVEM D,FO.PGL(TT) MOVE D,DLINEL ;DEFAULT LINEL MOVEM D,FO.LNL(TT) SETZM FB.BVC(TT) JRST @OPEN3Z(T) ;DISPATCH TO APPROPRIATE PLACE OPEN3Z: OPNAI1 ;ASCII DSK INPUT OPNAO1 ;ASCII DSK OUTPUT OPNTI1 ;ASCII TTY INPUT OPNTO1 ;ASCII TTY OUTPUT OPNBI1 ;FIXNUM DSK INPUT OPNBO1 ;FIXNUM DSK OUTPUT OPNTI1 ;FIXNUM TTY INPUT OPNTO1 ;FIXNUM TTY OUTPUT OPNAI1 ;IMAGE DSK INPUT OPNAO1 ;IMAGE DSK OUTPUT OPNTI1 ;IMAGE TTY INPUT OPNTO1 ;IMAGE TTY OUTPUT OPNBO1: OPNAO1: JUMPL T,OPNAT3 .SEE FBT.CM MOVE D,FB.BFL(TT) MOVEM D,FB.BVC(TT) JRST OPNA6 OPNBI1: OPNAI1: SETZM FB.BVC(TT) OPNA6: IFN ITS+D20,[ JUMPL T,OPNAT3 .SEE FBT.CM MOVE D,FB.IBP(TT) ;INITIALIZE BUFFER BYTE POINTER HRRZ R,OPEN9B(T) TRNN T,1 ADDI D,(R) ;FOR AN INPUT BUFFER, FB.BP MUST BE ADJUSTED; MOVEM D,FB.BP(TT) ; THE FIRST "EMPTY" BUFFER ISN'T A REAL ONE MOVE D,FB.BFL(TT) TRNN T,1 SETZ D, MOVEM D,FB.CNT(TT) ] ;END OF IFN ITS+D20 JRST OPNAT3 OPNTI1: 10$ JUMPGE T,OPNAI1 .SEE FBT.CM ;ONLY *THE* TTY HAS THESE HACKS SETZM TI.BFN(TT) SETZM FT.CNS(TT) IFN ITS,[ MOVE D,[STTYW1] MOVEM D,TI.ST1(TT) MOVE D,[STTYW2] MOVEM D,TI.ST2(TT) .CALL TTYGET IOJRST 4,OPENLZ ;TURN OFF AUTO-INT, SUPER-IMAGE TLZ F,%TSINT+%TSSII TRNE T,10 ;TTY IMAGE INPUT => TLO F,%TSSII ; ITS SUPER-IMAGE INPUT .CALL TTYSET IOJRST 4,OPENLZ ] ;END OF IFN ITS IFN SAIL,[ MOVEI D,[SACTW1 ? SACTW2 ? SACTW3 ? SACTW4] HRLI D,TI.ST1(T) SETACT D MOVSS D BLT D,TI.ST4(T) SETO D, GETLIN D AOSN D ;IF NOT -1 THEN OK TO USE CHARACTERISTICS SETZ D, ; ELSE CAN MAKE NO ASSUMPTIONS ABOUT TTY TLNE D,460000 ;CHECK DISLIN, DMLIN, DDDLIN TLOA T,FBT.FU TLZ T,FBT.FU MOVEM T,(FXP) ] ;END OF IFN SAIL IFN D20,[ MOVE 2,CCOCW1 ;"REMODELED" CCOC WORDS MOVE 3,CCOCW2 MOVEM 2,TI.ST1(TT) MOVEM 3,TI.ST2(TT) MOVE 1,F.JFN(TT) SFCOC ;SET CCOC WORDS MOVE 2,[STDJMW] TRNE T,10 XORI 2,<.TTBIN#.TTASC>_6 .SEE TT%DAM MOVEM 2,TI.ST3(TT) SFMOD ] ;END OF IFN D20 JRST OPNAT3 ;; ENTER WITH TTSAR IN TT OPNTO1: 10$ JUMPGE T,OPNAO1 .SEE FBT.CM ;ONLY *THE* TTY HAS THESE HACKS! SETZM FT.CNS(TT) IFN ITS,[ .CALL CNSGET ;SET FO.RPL, FO.LNL, AND GET TTYOPT IN D IOJRST 4,OPENLZ MOVEM D,TI.ST5(TT) ;STORE TTY OPTIONS WORD MOVSI R,200000 ;INFINITE PAGEL INITIALLY MOVEM R,FO.PGL(TT) SOS FO.LNL(TT) TLNN T,FBT.EC JRST OPNTO5 .CALL SCML ;FOR ECHO AREA, SET NUMBER OF ECHO LINES TO 5 .LOSE 1400 OPNTO5: .CALL TTYGET .LOSE 1400 TLNE F,%TSROL ;TURN ON SCROLL MODE IF TTY DEFAULTLY SCROLLS TLO T,FBT.SC TLZ F,%TSFCO TLNE T,FBT.FU TLO F,%TSFCO TLNE T,FBT.SC ;IF SCROLL MODE SET SCROLLING TLO F,%TSROL .CALL TTYSAC .LOSE 1400 MOVE D,TI.ST5(TT) ;GET TTY OPTIONS WORD ] ;END OF IFN ITS IFN D20,[ MOVE 1,F.JFN(TT) RFMOD ;READ JFN MODE WORD FOR TERMINAL LDB D,[.BP TT%WID,2] SUBI D,1 MOVEM D,FO.LNL(TT) ;SET LINEL LDB D,[.BP TT%LEN,2] MOVEM D,FO.RPL(TT) TRNN 1,TT%PGM MOVSI D,200000 ;FOR NON-PAGED MODE, USE INFINITY MOVEM D,FO.PGL(TT) JSP R,OPNTO7 ;capabilities word in D, in ITS format ] ;END OF IFN D20 IFN ITS\D20,[ ;; ENTER HERE WITH TTYOPT WORD IN D 20$ TLZ T,FBT.CP+FBT.SE 20% TLZ T,FBT.SA+FBT.CP+FBT.SE 20% TLNE D,%TOSA1 ;SKIP UNLESS WE HAVE SAIL CHARS 20% TLO T,FBT.SA ;SET SAIL BIT TLNE D,%TOMVU ;IF WE CAN MOVE BACK, ASSUME WE TLO T,FBT.CP ; ARE A DISPLAY TERMINAL (THIS IS OK ACCORDING ; TO ITSTTY) TLNE D,%TOERS ;REMEMBER THE SELECTIVE ERASE BIT TLO T,FBT.SE .SEE RUB1CH MOVEM T,(FXP) PUSHJ FXP,CLRO4 ;INITIALIZE LINENUM AND CHARPOS JRST OPNA6 ] ;END OF IFN ITS\D20 IFN D10,[ MOVSI D,200000 ;INFINITY (???) EXCH D,FO.PGL(TT) MOVEM D,FO.RPL(TT) SETZM AT.CHS(TT) ;SIGH SETZM AT.LNN(TT) IFE SAIL,[ SETO R, TRMNO. R, ;GET UNIVERSAL I/O INDEX FOR TERMINAL JRST OPNTO6 MOVEI D,.TOWID MOVE F,[2,,D] ;2-WD BLOCK: <.TOWID> ? TRMOP. F, ;TRY DETERMINING WIDTH OF TERMINAL OPNTO6: MOVEI F,111 ;DEFAULT WIDTH IS 73. SUBI F,1 ;REDUCE BY 1 SO NO WRAP-AROUND HAPPENS MOVEM F,FO.LNL(TT) JRST OPNA6 ] ;END OF IFE SAIL ;IFN SAIL, FALLS THROUGH TO OPNAT3 ] ;END OF IFN D10 OPNAT3: TRNE T,2 JRST OPNAT5 SETZM AT.CHS(TT) SETZM AT.LNN(TT) OPNAT5: MOVEI D,1 MOVEM D,AT.PGN(TT) OPEN4: POP FXP,F.MODE(TT) POP P,A ;SAR FOR FILE ARRAY - RETURNED MOVEI TT,-1 SETZM @TTSAR(A) ;ILLEGAL FOR LOSER TO ACCESS AS ARRAY MOVSI TT,TTS ANDCAM TT,TTSAR(A) ;UNCLOSE IT POPI P,3 ;FLUSH 2 ARGS AND # OF ARGS 20$ SETZB 2,3 ;MAKE SURE AC'S CONTAIN NO JUNK UNLKPOPJ ;WE HAVE WON! IFN ITS,[ TTYGET: SETZ SIXBIT \TTYGET\ ;GET TTYST1, TTYST2, TTYSTS ,,F.CHAN(TT) ;TTY CHANNEL # 2000,,D ;TTYST1 2000,,R ;TTYST2 402000,,F ;TTYSTS TTYSET: SETZ SIXBIT \TTYSET\ ;SET TTYST1, TTYST2, TTYSTS ,,F.CHAN(TT) ;TTY CHANNEL # ,,TI.ST1(TT) ;TTYST1 ,,TI.ST2(TT) ;TTYST2 400000,,F ;TTYSTS SCML: SETZ SIXBIT \SCML\ ;SET NUMBER OF COMMAND LINES ,,F.CHAN(TT) ;TTY CHANNEL # 401000,,5 ;NUMBER OF LINES TTYSAC: SETZ SIXBIT \TTYSET\ ;SET TTY VARIABLES ,,F.CHAN(TT) ;CHANNEL # ,,D ;TTYST1 ,,R ;TTYST2 400000,,F ;TTYSTS CNSGET: SETZ SIXBIT \CNSGET\ ;GET CONSOLE PARAMETERS ,,F.CHAN(TT) ;TTY CHANNEL # 2000,,FO.RPL(TT) ;VERTICAL SCREEN SIZE 2000,,FO.LNL(TT) ;HORIZONTAL SCREEN SIZE 2000,,D ;TCTYP (THROW AWAY) 2000,,D ;TTYCOM (THROW AWAY) 402000,,D ;TTYOPT ;TTYTYP NOT GOTTEN ] ;END OF IFN ITS IFN D20,[ OPNTO7: SETZB D,TI.ST5 ;WILL CALCULATE TERMINAL-CAPABILITIES-WORD HRRZ 1,F.JFN(TT) ; WORD INTO D TRNN T,14 ;FIXNUM OR IMAGE? SKIPN VTS20P JRST (R) RTCHR ;GET TERMINAL-CAPABILITIES-WORD INTO D MOVEM 2,TI.ST5(TT) ;STORE TERMINAL-CAPABILITIES-WORD HLRZ D,2 ;; RH OF D HAS D20 TC% CODES -- WANT ITS %TO CODES IN LH OPNT7A: TRNE D,(TC%BS) TLO D,%TOMVB TRNE D,(TC%MOV) TLO D,%TOMVU+%TOMVB TRNE D,(TC%SCL) TLO D,%TOERS TRNE D,(TC%LID) TLO D,%TOLID TRNE D,(TC%CID) TLO D,%TOCID JRST (R) ] ;END OF IFN D20 ;;; VARIOUS ERROR HANDLERS - ARRIVE WITH A MESSAGE IN C. ;; BASIC LOSER IS AT "OPNLZ0:" IFN D20,[ OPNLZR: MOVE 1,3 RLJFN JFCL IOJRST 4,OPNLZ0 ] ;END OF IFN D20 IFN D10,[ SA$ OPNLZS: POPI FXP,1 SA$ JRST OPNLZ1 OPNAND: MOVEI C,NSDERR ;NO SUCH DEVICE OPNLZ1: POP FXP,TT JRST OPNLZ0 ] ;END OF IFN D10 OPNALZ: MOVEI C,[SIXBIT \ALL I/O CHANNELS ALREADY IN USE!\] POP FXP,-L.F6BT-1(FXP) ;FAKE OUT CORRECT PDL CONDITIONS POPI FXP,L.F6BT-1 JRST OPNLZ4 OPENLZ: ;CLOSE THE LOSING CHANNEL FIRST IFN ITS,[ .CALL CLOSE9 ;REMEMBER, TT HAS TTSAR .LOSE 1400 ] ;END OF IFN ITS IFN D10,[ MOVE F,F.CHAN(TT) LSH F,27 IOR F,[RELEASE 0,0] XCT F ] ;END OF IFN D10 IFN D20,[ HRRZ 1,F.JFN(TT) CLOSF HALT ] ;END OF IFN D20 OPNLZ0: MOVE F,F.CHAN(TT) ;THEN DEALLOCATE CHANNEL SETZM CHNTB(F) OPNLZ4: POP P,AR1 ;FILE OBJECT SAR POP P,A ;SECOND ARG POP P,B ;FIRST ARG POP P,T ;ARG COUNT JUMPN T,OPNLZ3 MOVEI A,(AR1) PUSHJ P,NAMELIST JRST OPNLZ2 OPNLZ3: PUSHJ P,ACONS EXCH A,B PUSHJ P,ACONS CAMN T,XC-2 HRRM B,(A) OPNLZ2: MOVEI B,Q$OPEN POPI FXP,1 UNLOCKI JRST XCIOL IFN ITS,[ OPENUP: SETZ SIXBIT \OPEN\ ;OPEN FILE 5000,,(D) ;I/O MODE BITS ,,F.CHAN(TT) ;CHANNEL # ,,F.DEV(TT) ;DEVICE NAME ,,F.FN1(TT) ;FILE NAME 1 ,,F.FN2(TT) ;FILE NAME 2 400000,,F.SNM(TT) ;SNAME FILLEN: SETZ SIXBIT \FILLEN\ ;GET FILE LENGTH (IN WORDS) ,,F.CHAN(TT) ;CHANNEL # 402000,,F.FLEN(TT) ;PUT RESULT IN F.FLEN OF THE FILE OBJECT ACCESS: SETZ SIXBIT \ACCESS\ ;SET FILE ACCESS POINTER ,,F.CHAN(TT) ;CHANNEL # 400000,,F.FPOS(TT) ;POSITION RCHST: SETZ SIXBIT \RCHST\ ;READ CHANNEL STATUS ,,F.CHAN(TT) ;CHANNEL # 2000,,F.RDEV(TT) ;DEVICE NAME 2000,,F.RFN1(TT) ;FILE NAME 1 2000,,F.RFN2(TT) ;FILE NAME 2 2000,,F.RSNM(TT) ;SNAME 402000,,F.FLEN(TT) ;ACCESS POINTER ] ;END OF IFN ITS ;;; TABLES FOR OPEN FUNCTION ;;; ALL TABLES ARE INDEXED BY THE RIGHT HALF OF THE MODE WORD. IT$ RBFSIZ==:200 ;RANDOM BUFFER SIZE 20$ RBFSIZ==:200 10$ RBFSIZ==:0 ;;; SIZES FOR FILE ARRAYS: ,, ;;; FOR D10, THIS IS THE SIZE EXCLUSIVE OF THE BUFFER; FOR ITS AND D20, INCLUSIVE. ;;; SIZES ARE IN WORDS. OPEN9A: FB.BUF+RBFSIZ,,FB.BUF ;ASCII DSK INPUT FB.BUF+RBFSIZ,,FB.BUF ;ASCII DSK OUTPUT ,,FB.BUF+NASCII/2 ;ASCII TTY INPUT FB.BUF+RBFSIZ,,FB.BUF ;ASCII TTY OUTPUT FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM DSK INPUT FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM DSK OUTPUT ,,FB.BUF+NASCII/2 ;FIXNUM TTY INPUT FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM TTY OUTPUT FB.BUF+RBFSIZ,,FB.BUF ;IMAGE DSK INPUT FB.BUF+RBFSIZ,,FB.BUF ;IMAGE DSK OUTPUT ,,FB.BUF+NASCII/2 ;IMAGE TTY INPUT FB.BUF+RBFSIZ,,FB.BUF ;IMAGE TTY OUTPUT ;;; ,, ;;; THE RIGHT HALF IS NOT REALLY USED FOR D10. OPEN9B: IRP X,,[A,X,I]J,,[,+BN,+IM] ;ASCII/FIXNUM/IMAGE IRP Y,,[D,T]K,,[,+TY] ;DSK/TTY IRP Z,,[I,O]L,,[,+IO] ;IN/OUT IFSE X!!Y!!Z,IDI, LDGTW5: .SEE LDGTWD ;CROCK TTS,,RBFSIZ TERMIN TERMIN TERMIN ;;; ,, ;;; RELEVANT ONLY FOR BLOCK MODE FILES. ONLY THE RIGHT HALF IS USED FOR D10. OPEN9D: 010700,,5 ;ASCII DSK INPUT 010700,,5 ;ASCII DSK OUTPUT 0 ;ASCII TTY INPUT (IRRELEVANT) 010700,,5 ;ASCII TTY OUTPUT 004400,,1 ;FIXNUM DSK INPUT 004400,,1 ;FIXNUM DSK OUTPUT 0 ;FIXNUM TTY INPUT (IRRELEVANT) IT$ 001400,,3 ;FIXNUM TTY OUTPUT 10$ SA% 010700,,5 10$ SA$ 001100,,4 20$ 010700,,5 010700,,5 ;IMAGE DSK INPUT 010700,,5 ;IMAGE DSK OUTPUT 0 ;IMAGE TTY INPUT (IRRELEVANT) 10% 041000,,4 ;IMAGE TTY OUTPUT 10$ SA% 010700,,5 10$ SA$ 001100,,4 ? WARN [IMAGE TTY OUTPUT?] ;;; OPEN9C CONTAINS THE OPEN MODE WORD. FOR D10, THE MODE IS ALWAYS ;;; BLOCK MODE IF THIS TABLE IS USED. FOR D20, THERE IS NO DIFFERENCE ;;; IN THIS TABLE FOR BLOCK VERSUS SINGLE MODE. OPEN9C: IFN ITS,[ ;;; RECALL THE MEANINGS OF THE FOLLOWING BITS IN ITS: ;;; 1.3 0 => ASCII, 1 => IMAGE ;;; 1.2 0 => UNIT (CHARACTER) MODE, 1 => BLOCK MODE ;;; 1.1 0 => INPUT, 1 => OUTPUT ;;; ITS BLOCK MODE IS NOT USED FOR BUFFERED FILES; RATHER, SIOT IS USED. 0 ;ASCII DSK INPUT 1 ;ASCII DSK OUTPUT 0 ;ASCII TTY INPUT %TJDIS+1 ;ASCII TTY OUTPUT (DISPLAY IF POSSIBLE) 4 ;FIXNUM DSK INPUT 5 ;FIXNUM DSK OUTPUT %TIFUL+0 ;FIXNUM TTY INPUT (>7 BITS ON IMLACS AND TVS) %TJDIS+1 ;FIXNUM TTY OUTPUT 0 ;IMAGE DSK INPUT 1 ;IMAGE DSK OUTPUT 0 ;IMAGE TTY INPUT (SUPER-IMAGE INPUT) %TJSIO+1 ;IMAGE TTY OUTPUT (SUPER-IMAGE OUTPUT) ] ;END OF IFN ITS IFN D10,[ .IOASC ;ASCII DSK INPUT .IOASC ;ASCII DSK OUTPUT .IOASC ;ASCII TTY INPUT .IOASC ;ASCII TTY OUTPUT .IOBIN ;FIXNUM DSK INPUT .IOBIN ;FIXNUM DSK OUTPUT .IOASC ;FIXNUM TTY INPUT .IOASC ;FIXNUM TTY OUTPUT .IOASC ;IMAGE DSK INPUT .IOASC ;IMAGE DSK OUTPUT .IOIMG ;IMAGE TTY INPUT .IOIMG ;IMAGE TTY OUTPUT ] ;END OF IFN D10 IFN D20,[ .SEE OF%BSZ OF%MOD 070000,,OF%RD ;ASCII DSK INPUT 070000,,OF%WR ;ASCII DSK OUTPUT 070000,,OF%RD ;ASCII TTY INPUT 070000,,OF%WR ;ASCII TTY OUTPUT 440000,,OF%RD ;FIXNUM DSK INPUT 440000,,OF%WR ;FIXNUM DSK OUTPUT 440000,,OF%RD ;FIXNUM TTY INPUT 440000,,OF%WR ;FIXNUM TTY OUTPUT 074000,,OF%RD ;IMAGE DSK INPUT 074000,,OF%WR ;IMAGE DSK OUTPUT 104000,,OF%RD ;IMAGE TTY INPUT 104000,,OF%WR ;IMAGE TTY OUTPUT ] ;END OF IFN D20 IFN SAIL,[ ;EOPEN FOR SAIL -- HANDLE 'E' FILES ;;; DO AN OPEN, THEN, IF THE FILE IS OPEN IN NON-IMAGE NON-TTY ASCII MODE SKIP ;;; OVER E'S COMMENT BY DOING SUCCESIVE IN'S $EOPEN: MOVEI TT,(P) ;MUST CALCULATE WHERE RETURN ADR IS ADD TT,T ;SUBTRACT NUMBER OF ARGS GIVEN PUSH FXP,(TT) ;REMEMBER USER'S RETURN ADR MOVEI R,$EOPN1 ;NEW RETURN ADR MOVEM R,(TT) JRST $OPEN ;NOW OPEN THE FILE $EOPN1: MOVEI TT,F.MODE ;GET MODE OF FILE HRRZ TT,@TTSAR(A) SKIPE TT ;ASCII, DSK, INPUT? POPJ FXP, ;NOPE, JUST RETURN PUSH P,A ;REMEMBER FILE ARRAY PUSH FXP,[440700,,[ASCIZ \COMMENT \]] $EOPN2: ILDB T,(FXP) ;GET NEXT CHARACTER TO LOOK FOR JUMPE T,$EOPN5 ;LOOKS LIKE WE FOUND AN 'E' FILE, SKIP INDEX PUSH P,[$EOPN3] ;RETURN ADR PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM MOVNI T,1 ;ONE ARG JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL) $EOPN3: JUMPL TT,$EOPN4 ;EOF -- ERROR! LDB T,(FXP) ;GET THE CURRENT CHARACTER CAIN T,(TT) ;MATCH? JRST $EOPN2 ;YES, KEEP SCANNING THE FILE PUSH P,[$EOPN6] ;NOPE, FILEPOS TO BOF PUSH P,-1(P) ;FILE ARRAY PUSH P,CIN0 ;ZERO - LOGICAL BOF MOVNI T,2 ;TWO ARGS -- SET FILEPOS JRST FILEPOS $EOPN6: POPI FXP,1 ;BYTE POINTER POP P,A ;FILE ARRAY RETURNED IN A POPJ FXP, ;RETURN TO USER ;HERE WHEN FOUND AN 'E' FILE, SKIP TO AFTER ^L AFTER NEXT ^V $EOPN5: PUSH P,[$EOPN7] ;RETURN ADR PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM MOVNI T,1 ;ONE ARG JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL) $EOPN7: JUMPL TT,$EOPN4 ;EOF -- ERROR! CAIE TT,^V ;FOUND ^V? JRST $EOPN5 ;NOPE, KEEP ON LOOPING $EOPN8: PUSH P,[$EOPN9] ;RETURN ADR PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM MOVNI T,1 ;ONE ARG JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL) $EOPN9: JUMPL TT,$EOPN4 ;EOF -- ERROR! CAIE TT,^L ;FOUND ^L? JRST $EOPN8 ;NOPE, KEEP ON LOOPING POPI FXP,1 ;GET RID OF BYTE POINTER POP P,A ;RETURN FILE ARRAY POPJ FXP, ;TO USER $EOPN4: POP P,A ;FILE ARRAY -- EOF, WE LOST FAC [EOF READING A FILE WHICH LOOKED LIKE AN 'E' FILE - EOPEN!] ] ;END IFN SAIL SUBTTL DEFAULTF, ENDPAGEFN, EOFFN ;;; (DEFAULTF X) SETS THE DEFAULT NAMELIST TO X. ;;; X IS MERGEF'D WITH THE OLD NAMELIST FIRST. ;;; IT FOLLOWS THAT (DEFAULTF NIL) = (NAMELIST NIL). DEFAULTF: PUSHJ P,FIL6BT PUSHJ P,DMRGF PUSHJ P,6BTNML MOVEM A,VDEFAULTF POPJ P, SSCRFILE==DEFAULTF ;;; (EOFFN F) GETS INPUT FILE F'S END-OF-FILE FUNCTION. ;;; (EOFFN F X) SETS THE FUNCTION TO BE X. ;;; (ENDPAGEFN F) GETS OUTPUT FILE F'S END-OF-PAGE FUNCTION. ;;; (ENDPAGEFN F X) SETS IT TO BE X. ENDPAGEFN: JSP TT,LWNACK ;LSUBR (1 . 2) LA12,,QENDPAGEFN MOVEI TT,ATOFOK MOVEI B,DENDPAGEFN MOVEI C,QENDPAGEFN JRST EOFFN0 EOFFN: JSP TT,LWNACK ;LSUBR (1 . 2) LA12,,QEOFFN MOVEI TT,IFILOK MOVEI B,DEOFFN MOVEI C,QEOFFN EOFFN0: AOJN T,EOFFN5 POP P,AR1 JUMPE AR1,EOFFN2 IFN SFA,[ PUSH FXP,TT JSP TT,XFOSP ;SFA? JRST EOFFNZ JRST EOFFNZ ;NOPE POPI FXP,1 MOVEI A,(AR1) ;CALL THE SFA, AND RETURN ITS ANSWER HRRZI B,(C) ;THE OPERATION -- EOFFN OR ENDPAGEFUN SETZ C, ;WE WANT THE SFA TO RETURN A VALUE JRST ISTCSH ;SHORT INTERNAL CALL EOFFNZ: POP FXP,TT ] ;END IFN SFA PUSHJ P,(TT) MOVEI TT,FI.EOF .SEE FO.EOP HRRZ A,@TTSAR(AR1) UNLKPOPJ EOFFN2: HRRZ A,(B) POPJ P, EOFFN5: POP P,A POP P,AR1 JUMPE AR1,EOFFN7 IFN SFA,[ PUSH FXP,TT JSP TT,XFOSP ;CHECK IF WE HAVE AN SFA JRST EOFFNY JRST EOFFNY ;NOPE POPI FXP,1 JSP T,%NCONS ;LISTIFY IT SO IT IS IDENTIFIABLE AS AN ARG MOVEI B,(C) ;THE OPERATION MOVEI C,(A) ;AS THE ARG TO THE SFA MOVEI A,(AR1) ;THE SFA ITSELF JRST ISTCSH ;DO THE SHORT INTERNAL CALL EOFFNY: POP FXP,TT ;UNDO PUSHES ] ;END IFN SFA PUSHJ P,(TT) MOVE TT,TTSAR(AR1) HRRZM A,FI.EOF(TT) .SEE FO.EOP UNLKPOPJ EOFFN7: HRRZM A,(B) POPJ P, SUBTTL LISTEN FUNCTION ;;; (LISTEN X) LISTENS TO THE SPECIFIED TTY X. $LISTEN: SKIPA F,CFIX1 ;LSUBR (0 . 1) NCALLABLE MOVEI F,CPOPJ HRRZ AR1,V%TYI JUMPE T,$LSTN3 MOVEI D,Q$LISTEN AOJN T,S1WNAL POP P,AR1 ;FILE ARRAY SPECIFIED $LSTN3: IFN SFA,[ JSP TT,XFOSP ;FILE OR SFA? JRST $LSTNS JRST $LSTNS ;NOT AN SFA JSP T,QIOSAV MOVEI A,(AR1) ;SFA IN A MOVEI B,Q$LISTEN ;OPERATION SETZ C, ;NO THIRD ARG PUSHJ P,ISTCSH ;SHORT INTERNAL SFA INVOCATION MOVE TT,(A) ;BE PREPARED IF NCALL'ED POPJ P, $LSTNS: ] ;END IFN SFA PUSHJ P,TIFLOK ;IT BETTER BE TTY INPUT IFN ITS,[ .CALL LISTEN ;SO LISTEN ALREADY SETZ R, ;ON FAILURE, JUST ASSUME 0 ] ;END OF IFN ITS IFN D10,[ SKIPL T,F.MODE(TT) .SEE FBT.CM SA$ JRST $LSTN4 ? WARN [REALLY OUGHT TO BE SMARTER] SA% JRST $LSTN5 IFE SAIL,[ TLNE T,FBT.LN SKIPA D,[SKPINL] MOVSI D,(SKPINC) ] ;END OF IFE SAIL IFN SAIL,[ MOVE D,[SNEAKS R,] JRST $LSTN6 $LSTN4: MOVE D,F.CHAN(TT) LSH D,27 IOR D,[TTYSKP 0,] ] ;END OF IFN SAIL $LSTN6: XCT D $LSTN5: TDZA R,R MOVEI R,1 ] ;END OF IFN D10 IFN D20,[ HRRZ 1,F.JFN(TT) SIBE ;SKIP IF INPUT BUFFER EMPTY SKIPA R,2 ;NUMBER OF WAITING CHARS IN 2 SETZ R, ] ;END OF IFN D20 MOVEI TT,FI.BBC MOVE A,@TTSAR(AR1) ;ALSO COUNT IN ANY BUFFERED TLZE A,-1 ; UP CHARACTERS PENDING AOS R JSP T,LNG1A ADD TT,R UNLOCKI JRST (F) IFN ITS,[ LISTEN: SETZ SIXBIT \LISTEN\ ;LISTEN AT A TTY, ALREADY ,,F.CHAN(TT) ;TTY CHANNEL # 402000,,R ;NUMBER OF TYPED-AHEAD CHARS ] ;END OF IFN ITS SUBTTL LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM ;;; VARIOUS FUNCTIONS TO GET AND SET A FILE'S LINEL, PAGEL, ;;; CHARPOS, LINENUM, AND PAGENUM. LINEL: SKIPA D,CFIX1 MOVEI D,CPOPJ JSP F,FLFROB ;LSUBR (1 . 2) FO.LNL,,QLINEL DLINEL,,ATOFOK PAGEL: SKIPA D,CFIX1 MOVEI D,CPOPJ JSP F,FLFROB ;LSUBR (1 . 2) FO.PGL,,QPAGEL DPAGEL,,ATOFOK CHARPOS: SKIPA D,CFIX1 MOVEI D,CPOPJ JSP F,FLFROB ;LSUBR (1 . 2) AT.CHS,,QCHARPOS 0,,ATOFOK LINENUM: SKIPA D,CFIX1 MOVEI D,CPOPJ JSP F,FLFROB ;LSUBR (1 . 2) AT.LNN,,QLINEN 0,,ATFLOK PAGENUM: SKIPA D,CFIX1 MOVEI D,CPOPJ JSP F,FLFROB ;LSUBR (1 . 2) AT.PGN,,QPAGENUM 0,,ATFLOK IFN SFA,[ FLFWNA: HRRZ D,(F) ;FUNCTION NAME JRST WNALOSE ;WNA ERROR FLNSFL: EXCH AR1,A WTA [NOT SFA OR FILE!] ] ;END IFN SFA FLFROB: IFN SFA,[ CAME T,XC-1 ;WRONG NUMBER OF ARGS? CAMN T,XC-2 SKIPA JRST FLFWNA MOVEI TT,(P) ;TOP OF STACK CONTAINS FILE ARG? CAMN T,XC-2 ;UNLESS TWO ARGS MOVEI TT,-1(P) MOVE A,(TT) ;GET THE ARG CAIN A,TRUTH MOVE A,V%TYO MOVEM A,(TT) ;RE-STORE IT INCASE IT HAS BEEN ALTERED JUMPE A,FLFRF1 ;IF NIL THEN HANDLE SPECIALLY EXCH A,AR1 JSP TT,XFOSP JRST FLNSFL ;NOT AN SFA OR FILE JRST FLFRFL MOVEI AR1,NIL AOSE T ;HAVE TWO ARGS? POP P,AR1 ;YES, IT WILL BECOME SECOND ARG TO SFA EXCH AR2A,(P) ;SAVE AR2A ON STACK, GET SFA PUSH P,A ;SAVE OLD AR1 PUSH P,C ;SIGH! THE PAIN WE GO THRU TO SAVE THE ACS! PUSH P,B MOVEI C,(AR1) ;THIRD ARG TO SFA IS NULL, IF THERE WAS ONLY JUMPE T,.+4 ; ONE ARG TO THE CALLING FUNCTION. BUT MOVE A,AR1 ; LISTIFY SECOND ARG IF THERE WERE TWO. PUSHJ P,NCONS MOVEI C,(A) MOVEI A,(AR2A) ;SFA INTO A HRRZ B,(F) ;OPERATION NAME INTO B PUSHJ P,ISTCSH POP P,B POP P,C POP P,AR1 POP P,AR2A JSP T,FXNV1 ;MAKE SURE RESULT IS A FIXNUM POPJ P, FLFRFL: EXCH A,AR1 FLFRF1: ] ;END IFN SFA AOJN T,FLFRB5 PUSH P,AR1 MOVE AR1,-1(P) MOVEM D,-1(P) JUMPE AR1,FLFRB3 FLFRB1: HRRZ TT,1(F) PUSHJ P,(TT) HLRZ TT,(F) MOVM TT,@TTSAR(AR1) .SEE STERPRI ;LINEL MAY BE NEGATIVE UNLOCKI FLFB1A: POP P,AR1 POPJ P, FLFRB3: HLRZ TT,1(F) JUMPE TT,FLFRB1 MOVE TT,(TT) JRST FLFB1A FLFRB5: POP P,A JSP T,FXNV1 PUSH P,AR1 MOVE AR1,-1(P) MOVEM D,-1(P) MOVE D,TT JUMPE AR1,FLFRB7 FLFRB6: HRRZ TT,1(F) PUSHJ P,(TT) HLRZ TT,(F) MOVMS D EXCH D,@TTSAR(AR1) SKIPGE D MOVNS @TTSAR(AR1) UNLOCKI FLFRB8: MOVE TT,D JRST FLFB1A FLFRB7: HLRZ TT,1(F) JUMPE TT,FLFRB6 MOVMM D,(TT) JRST FLFRB8 SUBTTL IN ;;; (IN X) INPUTS ONE FIXNUM FROM THE BINARY FILE X AND ;;; RETURNS IT. $IN: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE - ACS 1 PUSH P,AR1 IFN SFA,[ JSP TT,AFOSP ;FILE OR SFA OR NOT? JFCL ;NOT, LET OTHER CODE GIVE ERROR JRST $INNOS ;NOT SFA, PROCEED POP P,AR1 PUSHJ FXP,SAV5M1 ;SAVE ALL BUT A MOVEI B,Q$IN ;IN OPERATION SETZ C, ;NO THIRD ARG PUSHJ P,ISTCSH ;SHORT +INTERNAL-SFA-CALL PUSHJ FXP,RST5M1 MOVE T,CFIX1 CAMN T,(P) ;NCALL'ED? POPI P,1 ;YUP, WILL RETURN ARGS IN BOTH A AND TT JSP T,FXNV1 ;INSURE A FIXNUM POPJ P, ;RETURN $INNOS: ] ;END IFN SFA MOVEI AR1,(A) PUSHJ P,XIFLOK ;LOCKI, and put TTSAR in TT IFN ITS+D20,[ MOVEI R,(TT) ;SAVE A COPY OF TTSAR SKIPL F.MODE(TT) .SEE FBT.CM JRST $IN2 ;FOR ITS AND D20, HANDLE SINGLE MODE FILES IFN ITS,[ PUSH FXP,[%TIACT] ;ASSUME A TTY TLNN TT,TTS.TY ;A TTY? SETZM (FXP) ;NO, SO NO FLAG BITS MOVE T,[444400,,TT] ;READ ONE 36.-BIT BYTE INTO TT MOVEI D,1 .CALL INSIOT .LOSE 1400 POPI FXP,1 JUMPN D,$IN7 ;IF WE GOT NO WORD, ASSUME EOF ] ;END OF IFN ITS IFN D20,[ PUSH P,2 ;PRESERVE AC'S HRRZ 1,F.JFN(TT) BIN ;READ ONE 36.-BIT BYTE INTO TT ERJMP $INTST MOVE TT,2 POP P,2 ] ;END OF IFN D20 AOS F.FPOS(R) JRST $IN1 IFN D20,[ $INTST: PUSH FXP,2 GTSTS TLNN 2,(GS%EOF) JRST IIOERR POP FXP,TT POP P,2 JRST $IN7 ] ;END OF IFN D20 ] ;END OF IFN ITS+D20 IFN D10,[ SKIPGE F.MODE(TT) .SEE FBT.CM LERR [SIXBIT \SINGLE MODE BINARY NOT AVAILABLE - IN!\] ] ;END OF IFN D10 $IN2: 10$ HRRZ D,FB.HED(TT) 10% SOSGE FB.CNT(TT) ;ARE THERE ANY BYTES LEFT? 10$ SOSGE 2(D) JRST $IN3 ;NO, GO GET ANOTHER BUFFER FULL 10% ILDB TT,FB.BP(TT) ;YES, GOBBLE DOWN THE NEXT BYTE 10$ ILDB TT,1(D) $IN1: POP P,AR1 UNLKPOPJ ;GET THE NEXT INPUT BUFFER $IN3: MOVE F,FB.BVC(TT) ADDM F,F.FPOS(TT) ;UPDATE FILE POSITION IFN D20\ITS,[ MOVE T,FB.IBP(TT) MOVEM T,FB.BP(TT) ;REINITIALIZE BYTE POINTER MOVE D,FB.BFL(TT) ;GET BUFFER LENGTH INTO D ] ;END OF IFN D10\ITS IFN ITS,[ MOVE R,D ;GET NEXT BUFFER-LOAD .CALL SIOT .LOSE 1400 SUBB R,D ;GET COUNT OF BYTES OBTAINED ] ;END OF IFN ITS IFN D20,[ PUSH P,B PUSH P,C HRRZ 1,F.JFN(TT) MOVE 2,T MOVN 3,D SIN ;GET NEXT BUFFER-LOAD ADD D,3 ;GET COUNT OF BYTES OBTAINED POP P,C POP P,B ] IFN D10,[ HRRZ F,F.CHAN(TT) LSH F,27 IFE SAIL,[ TLNN TT,TTS.BM JRST INB6 ;$DEV5R HRRZ D,FB.HED(TT) ;MAYBE BUFFER HAS BEEN RELOCATED? THEN FOR MOVSI R,(BF.IOU) ANDCAB R,@(D) ;TURNS OFF BUFFER-IN-USE BIT AND ADVANCES BUFFER SKIPGE (R) ;BF.IOU MUST BE BIT 4.9 FOR THIS TO WORK JRST INB4 ;$DEV5S MOVSI F,TTS.BM ANDCAM F,TTSAR(AR1) ;TURN OFF "BUFFER-MOVED" BIT, BUT LEAVE BUF ADDR IN F MOVE F,F.CHAN(TT) ;$DEV5Q: LSH F,27 HRR F,R ] ;END OF IFE SAIL INB6: TLO F,(IN 0,) ;$DEV5R: XCT F ;GET NEXT INPUT BUFFER JRST $IN4 ;SUCCESS XOR F,[#] XCT F ;SKIP IF EOF JRST IIOERR ;HALT FOR OTHER LOSS $IN4: MOVE D,FB.HED(TT) MOVE D,2(D) ;GET, FROM HEADER, NUMBER OF BYTES READ ] ;END OF IFN D10 $IN5M: MOVEM D,FB.BVC(TT) ;STORE "VALID COUNT" - # OF OF BYTES OBTAINED IFN D20\ITS, MOVEM D,FB.CNT(TT) JUMPN D,$IN2 ;EXIT IF WE GOT ANY (ELSE EOF?) IFN D20,[ PUSH P,B GTSTS ;GET FILE STATUS TLNN 2,(GS%EOF) ;SKIP ON EOF JRST IIOERR ;HALT FOR OTHER LOSS POP P,B ] ;END OF IFN D20 $IN7: MOVEI A,(AR1) ;NO DATA WORDS - EOF HRRZ T,FI.EOF(TT) UNLOCKI POP P,AR1 JUMPE T,$IN8 JCALLF 1,(T) ;CALL USER EOF FUNCTION IFN D10*<1-SAIL>,[ INB4: HRRZ F,FB.HED(TT) HRRZM R,(F) ;STORE CURRENT BUFFER ADDR IN CONTROL BLOCK TLZ R,-1 ADD R,[4400,,1] MOVEM R,1(F) ;CONSTRUCT NEW BP FOR BUFFER MOVE D,(R) MOVEM D,2(F) ;STORE NEW BYTE COUNT INITO BUFFERCONTROL-BLOCK JRST $IN5M ] ;END OF D10*<1-SAIL> $IN8: PUSH P,B ;NO USER EOF FUNCTION PUSHJ P,NCONS MOVEI B,Q$IN PUSHJ P,XCONS POP P,B IOL [EOF - IN!] ;SIGNAL ERROR IFN ITS,[ INSIOT: SETZ SIXBIT \SIOT\ ;STRING I/O TRANSFER ,,F.CHAN(TT) ;CHANNEL # ,,T ;BYTE POINTER ,,D ;BYTE COUNT 404000,,(FXP) ] ;END IFN ITS IFN D10*<1-SAIL>,[ IB4: HRRZ D,FB.HED(TT) HRRZM R,(D) ;STORE CURRENT BUFFER ADDR IN CONTROL BLOCK TLZ R,-1 ADD R,[4400,,1] MOVEM R,1(D) ;CONSTRUCT NEW BP FOR BUFFER MOVE R,(R) MOVEM R,2(D) ;STORE NEW BYTE COUNT INITO BUFFERCONTROL-BLOCK MOVEM R,FB.BVC(F) ;STORE "VALID COUNT" - # OF OF BYTES OBTAINED JRST $IN2 ] ;END OF IFE D10*<1-SAIL> SUBTTL OUT ;;; (OUT X N) OUTPUTS THE FIXNUM N TO THE FILE X. RETURNS T. $OUT: PUSH P,AR1 ;SUBR 2 - ACS 1 IFN SFA,[ JSP TT,AFOSP ;FILE OR SFA OR NOT? JFCL ;NOT, LET OTHER CODE GIVE ERROR JRST $OUTNS ;NOT SFA, PROCEED POP P,AR1 JSP T,QIOSAV MOVEI C,(B) ;ARG IS FIXNUM TO OUTPUT MOVEI B,Q$OUT ;OUT OPERATION JRST ISTCSH ;SHORT +INTERNAL-SFA-CALL $OUTNS: ] ;END IFN SFA JSP T,FXNV2 MOVEI AR1,(A) PUSHJ P,XOFLOK SKIPL F.MODE(TT) .SEE FBT.CM JRST $OUT2 ;OUTPUT ONE BYTE TO A SINGLE MODE BINARY FILE 10$ LERR [SIXBIT \SINGLE MODE BINARY NOT AVAILABLE - OUT!\] IFN ITS,[ MOVE R,D MOVEI D,1 MOVE T,[444400,,R] .CALL SIOT .LOSE 1400 ] ;END OF IFN ITS IFN D20,[ PUSH P,B HRRZ 1,F.JFN(TT) MOVE 2,D BOUT ERJMP OIOERR POP P,B ] ;END OF IFN D20 IFN ITS+D20,[ AOS F.FPOS(TT) JRST $OUT1 ] ;END OF IFN ITS+D20 $OUT3: PUSH FXP,D 10% SETZM FB.CNT(TT) ;DOING OWN BUFFERED I/O, -1 IN FB.CNT IS N.G. PUSHJ P,IFORCE ;FORCE OUT CURRENT OUTPUT BUFFER POP FXP,D $OUT2: 10$ HRRZ R,FB.HED(TT) 10% SOSGE FB.CNT(TT) ;SEE IF THERE IS ROOM FOR ANOTHER BYTE 10$ SOSGE 2(R) JRST $OUT3 ;NO, GO OUTPUT THIS BUFFER FIRST 10% IDPB D,FB.BP(TT) ;STICK BYTE IN BUFFER 10$ IDPB D,1(R) $OUT1: POP P,AR1 JRST UNLKTRUE SUBTTL FILEPOS, LENGTHF ;;; FILEPOS FUNCTION ;;; (FILEPOS F) RETURNS CURRENT FILE POSITION ;;; (FILEPOS F N) SETQ FILEPOS TO X ;;; FOR ASCII FILES, THE POSITION IS MEASURED IN CHARACTERS; ;;; FOR FIXNUM FILES, IN FIXNUMS (WORDS). ZERO IS THE ;;; BEGINNING OF THE FILE. ERROR IF FILE IS NOT RANDOMLY ;;; ACCESSIBLE. FILEPOS: AOJE T,FPOS1 ;ONE ARG => GET AOJE T,FPOS5 ;TWO ARGS => SET MOVEI D,QFILEPOS ;ARGH! ARGH! ARGH! ... JRST S2WNALOSE IFN D20,[ FPOS0E: POP P,B JRST FPOS0D ] ;END OF IFN D20 FPOS0B: SKIPA C,FPOS0 FPOS0C: MOVEI C,[SIXBIT \ILLEGAL ACCESS POINTER!\] FPOS0D: MOVEI A,(B) ;COME HERE FOR TWO-ARG CASE, PUSHJ P,NCONS ; MESSAGE IN C JRST FPOS0A FPOS0: MOVEI C,[SIXBIT \FILE NOT RANDOMLY ACCESSIBLE!\] SETZ A, ;HERE FOR ONE-ARG ERROR, MESSAGE IN C FPOS0A: MOVEI B,(AR1) PUSHJ P,XCONS MOVEI B,QFILEPOS UNLOCKI JRST XCIOL ;ONE-ARGUMENT CASE: GET FILE POSITION FPOS1: POP P,AR1 ;ARG IS FILE IFN SFA,[ JSP TT,XFOSP ;DO WE HAVE AN SFA? JRST FP1SF1 ;NOPE JRST FP1SF1 ;NOPE MOVEI A,(AR1) ;YES, CALL THE STREAM MOVEI B,QFILEPOS SETZ C, ;NO ARGS JRST ISTCSH FP1SF1: ] ;END IFN SFA PUSHJ P,FILOK ;DOES LOCKI SKIPGE F.FLEN(TT) JRST FPOS0 ;ERROR IF NOT RANDOMLY ACCESSIBLE SKIPGE D,F.FPOS(TT) JRST FPOS1A 10$ MOVE R,FB.HED(TT) ADD D,FB.BVC(TT) 10% SUB D,FB.CNT(TT) ;FOR BUFFERED FILES, ADJUST FOR COUNT 10$ SUB D,2(R) FPOS1A: TLNN TT,TTS SKIPN B,FI.BBC(TT) JRST FPOS2 TLZE B,-1 ;ALLOW FOR ANY BUFFERED BACK CHARS SUBI D,1 FPOS1C: JUMPE B,FPOS2 HRRZ B,(B) SA% SKIPLE D SA$ CAMLE D,FB.ROF(TT) ;FOR SAIL, MAY BE AS LOW AS RECORD OFFSET SOJA D,FPOS1C FPOS2: MOVE TT,D ;RETURN POSITION AS FIXNUM UNLOCKI JRST FIX1 ;TWO-ARGUMENT CASE: SET FILE POSITION FPOS5: POP P,B ;SECOND ARG IS T, NIL, OR FIXNUM POP P,AR1 ;FIRST IS FILE IFN SFA,[ JSP TT,XFOSP ;DO WE HAVE AN SFA? JRST FP5SF1 ;NOPE, CONTINUE JRST FP5SF1 ;NOPE MOVEI A,(B) ;LISTIFY THE ARG JSP T,%NCONS MOVEI C,(A) ;PASS IT AS THE ARG TO THE SFA MOVEI A,(AR1) ;THE SFA MOVEI B,QFILEPOS ;FILEPOS OPERATION JRST ISTCSH FP5SF1: ] ;END IFN SFA SETZ D, JUMPE B,FPOS5A ;NIL MEANS ABSOLUTE BEGINNING OF FILE CAIE B,TRUTH ;T MEANS END OF FILE JSP T,FXNV2 ;OTHERWISE A FIXNUM POSITION FPOS5A: PUSHJ P,FILOK ;DOES LOCKI, SAVES D 10$ TLNN TT,TTS.IO ;OUTPUT LOSES FOR D10 SKIPGE F.FLEN(TT) ;NOT RANDOMLY ACCESSIBLE? JRST FPOS0C SA% JUMPL D,FPOS0C ;FOR NON-SAIL, NEGATIVE POSITION ILLEGAL SA$ CAMGE D,FB.ROF(TT) ;FOR SAIL, MAY BE DOWN TO RECORD OFFSET SA$ JRST FPOS0C IFN ITS+D20,[ TLNN TT,TTS.IO JRST FPOS6 PUSH FXP,D PUSHJ P,IFORCE ;FORCE OUTPUT BUFFER POP FXP,D MOVE R,F.FPOS(TT) ;CALCULATE PRESENT FILE POSITION SKIPL F.MODE(TT) ADD R,FB.BVC(TT) SKIPL F.MODE(TT) SUB R,FB.CNT(TT) CAMLE R,F.FLEN(TT) ;ADJUST LENGTH UPWARD IF NECESSARY MOVEM R,F.FLEN(TT) FPOS6: ] ;END OF IFN ITS+D20 CAMLE D,F.FLEN(TT) JRST FPOS0C ;LOSE IF SPECIFIED POSITION GREATER THAN LENGTH SA$ CAIN B,NIL ;R IS BY DEFAULT 0, BUT FOR SAIL SA$ MOVE D,FB.ROF(TT) ; NIL MEANS USE THE RECORD OFFSET CAIN B,TRUTH MOVE D,F.FLEN(TT) IFE D10,[ TLNE TT,TTS.IO ;DETERMINE IF BYTE WE DESIRE IS IN THE BUFFER JRST FPOSZ ; IF AN INPUT FILE MOVE R,F.FPOS(TT) ;POSITION OF FIRST BYTE IN BUFFER CAMGE D,R ;IF TARGET TOO SMALL THEN MUST DO I/O JRST FPOSZ ADD R,FB.BVC(TT) ;ADD IN NUMBER OF BYTES IN THE BUFFER CAML D,R ;IF TARGET TOO LARGE THEN ALSO MUST DO I/O JRST FPOSZ MOVE R,F.FPOS(TT) ;IN RANGE, GET POS OF FIRST BYTE IN BUFFER SUBM D,R ;MAKE R INTO BYTE OFFSET INTO BUFFER MOVE D,FB.IBP(TT) ;RESTORE BYTE POINTER MOVEM D,FB.BP(TT) MOVE D,FB.BVC(TT) ;GET VALID NUMBER OF BYTES IN BUFFER SUBI D,(R) ;NUMBER OF BYTES REMAINING MOVEM D,FB.CNT(TT) ; IS THE NEW COUNT SKIPE R IBP FB.BP(TT) ;SKIP APPROPRIATE NUMBER OF BYTES SOJG R,.-1 SETZM FI.BBC(TT) ;CLEAR BUFFERED BACK CHARACTER JRST UNLKTRUE FPOSZ: ] ;END IFE D10 MOVEM D,F.FPOS(TT) IFN ITS,[ .CALL ACCESS ;SET FILE POSITION IOJRST 0,FPOS0D ;JUMP ON FAILURE ] ;END OF IFN ITS IFN D20,[ PUSH P,B CAME D,F.FLEN(TT) ;BE ULTRA CAUTIOUS SKIPA 2,D SETO 2, HRRZ 1,F.JFN(TT) SFPTR ;SET FILE POINTER IOJRST 0,FPOS0E POP P,B ] ;END OF IFN D20 IFN D10,[ IDIV D,FB.BFL(TT) ;DIVIDE FILE POSITION BY BUFFER LENGTH MOVE T,F.CHAN(TT) LSH T,27 TLO T,(USETI 0,0) HRRI T,1(D) ;BLOCKS ARE NUMBERED 1-ORIGIN XCT T ;POSITION FILE TO CORRECT BLOCK IMUL D,FB.BFL(TT) ;CALCUALTE F.FPOS MOVEM D,F.FPOS(TT) MOVE T,FB.HED(TT) SETZM 2(T) ;ZERO THE REMAINING BYTE COUNT HRLZI D,400000 ;NOW WE HAVE TO ZERO ALL USE BITS FPOS6C: HRRZ T,(T) ;GET POINTER TO NEXT BUFFER SKIPL (T) ;THIS ONE IN USE? JRST FPOS6B ;NOPE, SO WE ARE DONE XORM D,(T) ;CLEAR THE USE BIT JRST FPOS6C ;AND LOOP OVER ALL BUFFERS FPOS6B: ] ;END OF IFN D10 10% TLNE TT,TTS.IO 10% JRST FPOS6A SETZM FB.BVC(TT) SETZM FI.BBC(TT) ; SETZM FI.BBF(TT) ;NOT IMPLEMENTED YET FPOS6A: IFN ITS+D20,[ SKIPGE F.MODE(TT) JRST UNLKTRUE ;THAT'S ALL FOR SINGLE MODE FILES TLNE TT,TTS.IO JRST FPOS7 ;JUMP FOR OUTPUT FILES ] ;END OF IFN ITS+D20 MOVE T,TT 10$ PUSH FXP,R ;R HAS DESIRED BYTE WITHIN BLOCK PUSHJ P,$DEVBUF ;GET NEW INPUT BUFFER JFCL ;IGNORE EOF 10% JRST UNLKTRUE IFN D10,[ POP FXP,R MOVE TT,FB.HED(T) MOVN D,R ADDM D,2(TT) ;DECREASE COUNT BY NUMBER OF SKIPPED BYTES SKIPE R IBP 1(TT) ;SKIP APPROPRIATE NUMBER OF BYTES SOJG R,.-1 ] ;END OF IFN D10 JRST UNLKTRUE IFN ITS+D20,[ FPOS7: JSP D,FORCE6 ;INITIALIZE OUTPUT POINTERS JRST UNLKTRUE ] ;END OF IFN ITS+D20 ;;; LENGTHF -- SUBR, 1 ARG, NCALLABLE ;;; RETURNS THE LENGTH OF AN OPEN FILE $LENWT: EXCH A,AR1 %WTA NAFOS $LENGTHF: PUSH P,CFIX1 ;STANDARD ENTRY, RETURN FIXNUM ;ALTERNATE ENTRY, RETURN NUMBER IN TT EXCH A,AR1 ;FILE/SFA INTO AR1 JSP TT,XFOSP ;MUST BE EITHER JRST $LENWT IFN SFA,[ JRST $LENFL EXCH AR1,A JSP T,QIOSAV MOVEI B,Q$LENGTHF SETZ C, PUSHJ P,ISTCSH ;SHORT INTERNAL SFA CALL MOVE T,CFIX1 CAMN T,(P) ;WE WILL RETURN RESULTS IN A AND TT, SO NO NEED TO RECONS POPI P,1 JSP T,FXNV1 POPJ P, $LENFL: ] ;END IFN SFA EXCH A,AR1 MOVEI TT,F.FLEN ;GET FILE LENGTH MOVE TT,@TTSAR(A) POPJ P, ;RETURNS TO CFIX1 OR CPOPJ SUBTTL CONTROL-P CODES AND TTY INITIALIZATION ;;; CNPCHK DOES A .5LOCKI. THEN SKIPS IF CAPABILITY EXITS. ;;; Leaves file-array ttsar in T, if successful ;;; CLOBBERS T, TT, D, AND F. SAVES R (SEE RUB1C3). ;;; SEE COMMENTS ON CNPCOD BELOW CNPCHK: .5LKTOPOPJ .SEE INTTYR .SEE CRSRP7 HLLOS NOQUIT IFE ITS\D20, POPJ FLP, IFN ITS\D20,[ 20$ SKIPN VTS20P 20$ POPJ FLP, ;IFN ITS,[ ; .CALL [ SETZ ; SIXBIT \TTYVAR\ ; ,,F.CHAN(T) ;CHANNEL ; [SIXBIT \TTYOPT\] ;READ THE TTYOPT VARIABLE ; 402000,,TT ;RETURN RESULT INTO TT ; ] ; POPJ FLP, ;OH WELL, ASSUME NOTHING IS LEGAL ;] ;END OF IFN ITS MOVE T,TTSAR(AR1) MOVE TT,TI.ST5(T) ;GET TERMINAL-CAPABILITIES-WORD IFN D20,[ HLRZS TT EXCH TT,D JSP R,OPNT7A ;CONVERT TO ITS-STYLE %TO BITS EXCH TT,D ] ;END OF IFN D20 XCT CNPOK-"A(D) ;IS THIS FUNCTION DOABLE? POPJ FLP, ;WOULD HAVE NO AFFECT ANYWAY SO JUST RETURN AOS (FLP) POPJ FLP, ;; TABLE OF INSTRUCTIONS TO DETERMINE IF A ^P CODE IS DOABLE ON THE TERMINAL ;; AND RCPOS: AND RSTCUR: CNPOK: SKIPA ;A OK ON ALL TTY'S TLNN TT,%TOMVB ;B ON TTY'S THAT CAN DO IT DIRECTLY SKIPA ;C THIS HAS SOME AFFECT ON ALL TTY'S SKIPA ;D TLNN TT,%TOERS ;E REQUIRES %TOERS SKIPA ;F JFCL SKIPA ;H TLNN TT,%TOMVU ;I JFCL TLNN TT,%TOMVU ;K ASSUME ONLY ON DISPLAY TERMINALS TLNN TT,%TOERS ;L SKIPA ;M SKIPA ;N JFCL SKIPA ;P SKIPA ;Q TLNN TT,%TOMVU ;R MAKE SAME ASSUMPTION AS K AND S TLNN TT,%TOMVU ;S TLNN TT,%TOMVU ;T WHEREAS C IS MEANINGFUL FOR NON-DISPLAYS, I ; DO NOT FEEL THIS IS TLNN TT,%TOMVU ;U TLNN TT,%TOMVU ;V JFCL ;X TTY'S THAT CAN BACKSPACE AND DON'T OVERSTRIKE ; OR THAT CAN ERASE PUSHJ P,[TLNN TT,%TOMVB ;MUST BE ABLE TO BACK-UP POPJ P, TLNN TT,%TOERS ;IF CAN ERASE IS OK TLNN TT,%TOOVR ;OR IF DOESN'T OVERSTRIKE AOS (P) POPJ P,] JFCL TLNN TT,%TOMVU ;Z SAME CRITERIA AS ^PT TLNN TT,%TOLID ;[ TLNN TT,%TOLID ;\ TLNN TT,%TOERS ;] SAME AS ^PL TLNN TT,%TOCID ;^ TLNN TT,%TOCID ;_ ;; WARN [CURSORPOS S AND R SHOULD SAVE AND RESTORE POSITION INFO FOR TTY] ] ;END OF IFN ITS\D20 ;;; PUSH A ^P CODE INTO A TTY FILE ARRAY IN AR1. ;;; THE CHARACTER TO FOLLOW THE ^P IS IN D. ;;; IF THE CHARACTER IS "H, "I, OR "V, THEN THE SECOND ;;; CHARACTER IS IN THE LEFT HALF OF D. ;;; CHARPOS, LINENUM, AND PAGEL ARE CORRECTLY UPDATED. ;;; I/O LOSSES DUE TO INTERRUPTS BETWEEN ^P AND THE ;;; NEXT CHARACTER ARE SCRUPULOUSLY AVOIDED. ;;; CLOBBERS T, TT, D, AND F. SAVES R (SEE RUB1C3). CNPCOD: PUSHJ FLP,CNPCHK ;DOES A .5LOCKI. THEN SKIPS IF CAPABILITY EXITS JRST CZECHI ; BUT IF NOT EXISTS, THEN JUST FAILS TO SKIP CNPCUR: MOVE TT,F.MODE(T) PUSH FXP,D JUMPL TT,CNPCD1 .SEE FBT.CM IFE ITS\D20, LERR [SIXBIT \LOSE ON BUFFERED FILES - CNPCOD!\] IFN ITS\D20,[ MOVE TT,FB.CNT(T) SUBI TT,3 JUMPGE TT,CNPCD1 MOVE TT,T ;IF THERE ISN'T ROOM IN THE CURRENT BUFFER PUSHJ P,IFORCE ; FOR THE WHOLE ^P CODE SEQUENCE, FORCE MOVE T,TTSAR(AR1) ; OUT THE BUFFER TO AVOID TIMING ERRORS ] ;END OF IFN ITS\D20 CNPCD1: IFE ITS\D20, JRST CZECHI IFN ITS\D20,[ SETZM ATO.LC(T) ;IF USING ^P CODES, THEN FORGET WE DID LF MOVEI TT,^P ;OUTPUT A ^P PUSHJ P,TYOF6 HRRZ TT,(FXP) ;OUTPUT THE CHARACTER PUSHJ P,TYOF6 HLRZ TT,(FXP) JUMPE TT,CNPCD2 TRZ TT,400000 ;OUTPUT ANY ADDITIONAL MAGIC ARGUMENT PUSHJ P,TYOF6 CNPCD2: POP FXP,TT XCT CNPC9-"A(TT) ;ACCOUNT FOR THE EFFECTS OF THE ^P CODE IT$ .LOSE 20$ HALTF CNPC9: JRST CNP.A ;A ADVANCE TO FRESH LINE JRST CNP.B ;B MOVE BACK 1, WRAPAROUND JRST CNP.C ;C CLEAR SCREEN JRST CNP.D ;D MOVE DOWN, WRAPAROUND JRST CZECHI ;E CLEAR TO EOF JRST CNP.F ;F MOVE FORWARD 1, WRAPAROUND JFCL JRST CNP.H ;H SET HORIZONTAL POSITION JRST CNP.I ;I NEXT CHARACTER IS ONE-POSITION PRINTING CHAR JFCL JRST CZECHI ;K KILL CHARACTER UNDER CURSOR JRST CZECHI ;L CLEAR TO END OF LINE JRST CNP.M ;M GO INTO **MORE** STATE, THEN HOME UP JRST CZECHI ;N GO INTO **MORE** STATE JFCL JRST CZECHI ;P OUTPUT A ^P JRST CZECHI ;Q OUTPUT A ^C JRST CZECHI ;R RESTORE CURSOR POSITION JRST CZECHI ;S SAVE CURSOR POSITION JRST CNP.T ;T TOP OF SCREEN (HOME UP) JRST CNP.U ;U MOVE UP, WRAPPING AROUND JRST CNP.V ;V SET VERTICAL POSITION JFCL JRST CNP.X ;X BACKSPACE AND ERASE ONE CHAR JFCL JRST CNP.Z ;Z HOME DOWN JRST CNP.IL ;[ INSERT LINE ;BEWARE THE BRACKETS! JRST CNP.DL ;\ DELETE LINE JRST CZECHI ;] SAME AS L (OBSOLETE) JRST CZECHI ;^ INSERT CHARACTER JRST CZECHI ;_ DELETE CHARACTER ;;; STILL WITHIN AN IFN ITS\D20 CNP.X: ;SAME AS ^P K ^P B CNP.B: MOVE D,FO.LNL(T) ;MOVE BACKWARDS SUBI D,1 SOSGE AT.CHS(T) ;WRAP AROUND IF AT LEFT MARGIN MOVEM D,AT.CHS(T) JRST CZECHI CNP.M: ;DOES **MORE**, THEN HOMES UP CNP.C: AOS AT.PGN(T) ;CLEAR SCREEN - AOS PAGENUM CNP.T: SETZM AT.LNN(T) ;HOME UP - CLEAR LINENUM AND CHARPOS CNP.IL: ;INSERT LINE - CLEAR CHARPOS CNP.DL: ;DELETE LINE - CLEAR CHARPOS SETZM AT.CHS(T) JRST CZECHI CNP.A: SKIPN AT.CHS(T) ;CRLF, UNLESS AT START OF LINE JRST CZECHI SETZM AT.CHS(T) ;CLEAR CHARPOS, THEN INCR LINENUM CNP.D: AOS D,AT.LNN(T) ;MOVE DOWN CAML D,FO.PGL(T) ;WRAP AROUND OFF BOTTOM TO TOP SETZM AT.LNN(T) JRST CZECHI CNP.F: AOS D,AT.CHS(T) ;MOVE FORWARD - WRAP AROUND CAML D,FO.LNL(T) ; OFF END TO LEFT MARGIN SETZM AT.CHS(T) JRST CZECHI CNP.H: HLRZ D,TT ;SET HORIZONTAL POSITION TRZ D,400000 ;CLEAR LISP'S FLAG (IF PRESENT) SUBI D,7 ;ACCOUNT FOR ITS'S 8 SKIPGE FO.LNL(T) ;IF NEGATIVE, THEN ASSUME C(D) IS ACTUAL HPOS JRST CNP.H1 CAMLE D,FO.LNL(T) ;PUT ON RIGHT MARGIN IF TOO BIG MOVE D,FO.LNL(T) CNP.H1: SUBI D,1 MOVEM D,AT.CHS(T) JRST CZECHI CNP.I: AOS AT.CHS(T) ;NOT REALLY THE RIGHT THING, BUT CLOSE JRST CZECHI CNP.Z: SETZM AT.LNN(T) ;HOME DOWN (GO UP FROM TOP!) CNP.U: MOVE D,FO.RPL(T) ;MOVE UP SUBI D,1 ;WRAP AROUND FROM TOP TO BOTTOM SOSGE AT.LNN(T) ; USING "REAL" PAGE LENGTH MOVEM D,AT.LNN(T) JRST CZECHI CNP.V: HLRZ D,TT ;SET VERTICAL POSITION SUBI D,7 ;IF TOO LARGE, PUT ON BOTTOM CAMLE D,FO.RPL(T) MOVE D,FO.RPL(T) SUBI D,1 MOVEM D,AT.LNN(T) JRST CZECHI ] ;END OF ITS\D20 ;;; VARIOUS ROUTINES FOR PRINTING ^P CODES CNPBBL: MOVEI D,"B PUSHJ P,CNPCOD CNPBL: MOVEI D,"B PUSHJ P,CNPCOD CNPL: MOVEI D,"L JRST CNPCOD CNPU: MOVEI D,"U JRST CNPCOD CNPF: MOVEI D,"F JRST CNPCOD RCPOS: IFN ITS,[ MOVE TT,TTSAR(AR1) ;file array in AR1, Read cursorpos into D .CALL RCPOS1 ;GET CURRENT CURSOR POSITION .LOSE 1400 POPJ FLP, RCPOS1: SETZ SIXBIT \RCPOS\ ;READ CURSOR POSITION ,,F.CHAN(TT) ;CHANNEL # 2000,,D ;MAIN CURSOR POSITION 402000,,R ;ECHO CURSOR POSITION ] ;END OF IFN ITS IFN D20,[ PUSHJ FXP,SAV3 ;PRESERVE LOW THREE AC'S MOVEI TT,F.JFN HRRZ 1,@TTSAR(AR1) RFPOS MOVE D,2 PUSHJ FXP,RST3 ] ;END OF IFN D20 POPJ FLP, RSTCUR: ;RESTORE SAVED CURSOR POSITION HLLZ D,-3(FXP) ;FOR ITS, USE ^P CODES TO SET HRRI D,"V-10 ; CURSOR POSITION PUSHJ P,RSTCU3 HRLZ D,-3(FXP) HRRI D,"H-10 RSTCU3: ADD D,R70+10 JRST CNPCOD ;;; ROUTINE FOR OPENING UP THE INITIAL TTY FILE ARRAYS. ;;; SKIPS ON SUCCESS (FAILS IF THIS JOB NEVER HAD THE TTY). OPNTTY: IFN ITS,[ .SUSET [.RTTY,,T] ;GET .TTY USER VARIABLE TLNE T,%TBWAT ;IF SUPERIOR SET %TBWAT, IT CERTAINLY JRST OPNT0 ; ANTICIPATES OUR OPENING TTY - LET'S OBLIGE TLNE T,%TBNOT ;ELSE DON'T OPEN IF WE DON'T HAVE THE TTY POPJ P, OPNT0: ] ;END OF IFN ITS ;;; 20$ WARN [SHOULD WE NOT OPEN TTY IF DETACHED, OR CHECK .PRIIN?] AOS (P) HRRZ A,V%TYO ;save default end-of-page function MOVE TT,TTSAR(A) MOVEI TT,FO.EOP PUSH P,@TTSAR(A) PUSHJ P,[PUSH P,A ;OPEN UP TTY OUTPUT ARRAY MOVNI T,1 JRST $OPEN] OPNT1: MOVEI AR1,(A) POP P,A MOVEI TT,FO.EOP MOVEM A,@TTSAR(AR1) ;restore default end-of-page function MOVEI TT,FO.LNL MOVE TT,@TTSAR(AR1) MOVEM TT,DLINEL ;SET UP DEFAULT LINEL FROM INITIAL JOB CONSOLE MOVEI TT,FO.PGL MOVE TT,@TTSAR(AR1) MOVEM TT,DPAGEL ;SET UP DEFAULT PAGEL " JSP TT,XFOSP JRST .+2 JRST [ PUSH P,COPT1A PUSH P,AR1 MOVNI T,1 JRST STTYTYPE ] COPT1A: SETZ A,OPNT1A OPNT1A: MOVEM A,VTTY ;INITIALIZE "TTY" TO (STATUS TTYTYPE) HRRZ A,V%TYI MOVE TT,TTSAR(A) ;TRUE, INTERRUPTS AREN'T LOCKED OUT HERE, PUSH P,TI.BFN(TT) ; BUT WHO CARES? IFN ITS+D20+SAIL,[ ;SAVE CHARACTERISTICS OVER OPENING OUTPUT TTY SA% ZZZ==2 SA$ ZZZ==4 REPEAT ZZZ, CONC [PUSH FLP,(TT)TI.ST]\<.RPCNT+1> 20$ PUSH FLP,(TT)TI.ST6 ;TERMINAL MODE WORD ] ;END OF IFN ITS+D20+SAIL PUSH P,COPNT2 ;OPEN UP TTY INPUT ARRAY PUSH P,A ; GENERALLY, V%TYI MOVNI T,1 JRST $OPEN OPNT2: LOCKI MOVE TT,TTSAR(A) POP P,TI.BFN(TT) IFN ITS+D20+SAIL,[ ;RESTORE CERTAIN STATUS WORDS, AS REQUESTED 20$ POP FLP,(TT)TI.ST6 ;TERMINAL MODE WORD REPEAT ZZZ, CONC [POP FLP,(TT)TI.ST]\ HRLZI T,AS.FIL ;IF V%TYI IS A SFA, THEN DO REAL ACTIONS TDNN T,ASAR(A) ; FROM THE INITIAL TTY FILE ARRAY MOVE TT,TTSAR+TTYIFA IT$ .CALL TTY2ST IT$ .LOSE 1400 SA$ MOVEI T,TI.ST1(TT) SA$ SETACT T IFN D20,[ HRRZ 1,F.JFN(TT) ;EVEN FOR THE OUTPUT TTY, WE MAY WANT TO MOVE 2,TI.ST1(TT) ;RE-DO THIS STUFF, JUST TO BE SURE MOVE 3,TI.ST2(TT) SFCOC ;SET CCOC WORDS MOVE 2,TI.ST3(TT) SFMOD ;SET JFN MODE WORD SKIPN VTS20P ;If we are on VTS, then make sure we will win. JRST OPNT4 ; Use the saved value of the right half of the mode RTMOD ; word (in practice this apparently is always 0?), HRR 2,TI.ST6(TT) ; and the left half of the current one, which IOR 2,[STDTMW] ; contains the stuff users set per-session, like more STMOD ; processing. But turn on the display-code option! OPNT4: SETZB 2,3 ] ;END OF IFN D20 ] ;END OF IFN ITS+D20+SAIL UNLOCKI HRRZ A,V%TYI HRRZ B,V%TYO PUSHJ P,SSTTYCONS ;CONS THEM TOGETHER AS CONSOLE COPNT2: POPJ P,OPNT2 SUBTTL CLEAR-INPUT, CLEAR-OUTPUT ;;; (CLEAR-INPUT X) CLEARS ANY PENDING INPUT. ;;; CURRENTLY ONLY EFFECTIVE FOR TTY'S. CLRIN: PUSH P,AR1 ;SUBR 1 MOVEI AR1,(A) IFN SFA,[ JSP TT,XFOSP ;Check for maybe a SFA JFCL ; not file or SFA, OFILOK errs CAIA ; FILE, fall through JRST CLRISF ; Go tell the SFA how. ] PUSHJ P,IFILOK ;MAKE SURE ARGUMENT IS AN INPUT FILE TLNE TT,TTS.TY PUSHJ FXP,CLRI3 ;IF A TTY, CLEAR ITS INPUT JRST $OUT1 CLRI3: IFN ITS,[ .CALL CLRIN9 ;RESET TTY INPUT AT ITS LEVEL .LOSE 1400 ] ;END OF IFN ITS IFN D10,[ MOVE D,F.DEV(TT) CAMN D,[SIXBIT \TTY\] CLRBFI ] ;END OF IFN D10 IFN D20,[ PUSH P,A HRRZ 1,F.JFN(TT) CFIBF ;CLEAR FILE INPUT BUFFER POP P,A ] ;END OF IFN D20 SETZM FI.BBC(TT) ;CLEAR BUFFERED-BACK CHARS ; SETZM FI.BBF(TT) ;CLEAR BUFFERED-BACK FORMS POPJ FXP, IFN ITS,[ CLRIN9: SETZ SIXBIT \RESET\ ;RESET I/O CHANNEL 400000,,F.CHAN(TT) ;CHANNEL # ] ;END OF IFN ITS ;;; (CLEAR-OUTPUT X) CLEARS ANY OUTPUT NOT ACTUALLY ON ;;; THE OUTPUT DEVICE YET. CURRENTLY ONLY EFFECTIVE FOR TTY'S. CLROUT: PUSH P,AR1 ;SUBR 1 MOVEI AR1,(A) IFN SFA,[ JSP TT,XFOSP ;Check for maybe a SFA JFCL ; not file or SFA, OFILOK errs CAIA ; FILE, fall through JRST CLROSF ; Go tell the SFA how. ] ;End IFN SFA, PUSHJ P,OFILOK TLNE TT,TTS ;SKIP IF TTY PUSHJ FXP,CLRO3 JRST $OUT1 IFN SFA,[ CLROSF: SKIPA T,[SO.OCL] ;CLEAR-OUTPUT CLRISF: MOVEI T,SO.ICL ; CLEAR-INPUT SETZ C, ;Arg of () PUSHJ P,ISTCAL ;pass the buck to the SFA POP P,AR1 ;And return, unlocking etc. POPJ P, ]; End IFN SFA, CLRO3: IFN ITS,[ .CALL CLRIN9 ;RESET CHANNEL .LOSE 1400 CLRO4: .CALL RCPOS1 ;RESET CHARPOS AND LINEL .LOSE 1400 HLL T,F.MODE(TT) TLNE T,FBT.EC MOVE D,R ;FOR ECHO MODE, USE ECHO MODE CURSORPOS HLRZM D,AT.LNN(TT) HRRZM D,AT.CHS(TT) ] ;END OF IFN ITS IFN D10,[ MOVE D,F.DEV(TT) CAMN D,[SIXBIT \TTY\] CLRBFO ] ;END OF IFN D10 IFN D20,[ PUSH P,A HRRZ 1,F.JFN(TT) CFOBF ;CLEAR FILE OUTPUT BUFFER CAIA CLRO4: PUSH P,A PUSH P,B HRRZ 1,F.JFN(TT) RFPOS ;READ FILE POSITION HLRZM 2,AT.LNN(TT) ;STORE LINENUM HRRZM 2,AT.CHS(TT) ;STORE CHARPOS POP P,B POP P,A ] ;END OF IFN D20 IFE D10,[ PUSH FXP,T TLNN T,FBT.CM ;IF BLOCK MODE, RESET JSP D,FORCE6 ; LISP BUFFER POINTERS POP FXP,T ] ;END OF IFE D10 POPJ FXP, ;;; STANDARD **MORE** PROCESSOR TTYMOR: PUSHJ P,STTYCONS ;SUBR 1 JUMPE A,CPOPJ ;STTYCONS LEFT ARG IN AR1 PUSH P,AR1 PUSH P,A SETZ A, ;RESET NOINTERRUPT STATUS PUSHJ P,NOINTERRUPT ; SO INTERRUPT CHARS WILL TAKE EFFECT HRRZ AR1,-1(P) STRT AR1,[SIXBIT \####MORE####!\] ;# IS QUOTE CHAR TTYMO3: PUSHJ P,[PUSH P,R70 PUSH P,-2(P) MOVNI T,2 JRST TYIPEEK+1] TTYMO1: CAILE TT,40 CAIN TT,177 PUSHJ P,[PUSH P,-1(P) ;SWALLOW SPACE OR RUBOUT MOVNI T,1 JRST %TYI+1] TTYMO2: CAIE TT,^S ;DON'T IGNORE ^S CAIN TT,33 ;OR JRST TTYMOZ CAIGE TT,40 ;COMPLETELY IGNORE CONTROL CHARS JRST TTYMO3 ? SA$ WARN [SAIL TTYMOR?] TTYMOZ: POPI P,1 POP P,AR1 IT% POPJ P, IFN ITS,[ MOVE D,[10,,"H] ;GO TO BEGINNING OF LINE PUSHJ P,CNPCOD PUSHJ P,CNPL ;CLEAR TO END OF LINE HRLI AR1,600000 ;FLAG TO TERPRI (THIS IS ACTUAL FILE ARRAY) JRST TERP1 ;DO SEMI-INTERNAL TERPRI ] ;END OF IFN ITS IFN SFA,[ SUBTTL SFA FUNCTIONS (INTERNAL AND USER) ; (SFA-CREATE ; ; ) STCREA: SKOTT A,LS\SY JRST STCRE1 ;HERE TO CREATE A NEW SFA: SFA-FUNCTION IN A, LISP FIXNUM IN B STCREN: JSP T,FXNV2 ;GET THE LENGTH OF THE USER AREA INTO D PUSH P,A PUSH P,B PUSH P,C MOVEI TT,+1(D) ;TO INSURE GETTING ENOUGH HALFWORDS LSH TT,-1 ;THEN CONVERT TO NUMBER OF WORDS MOVSI A,-1 ;JUST NEED THE SAR PUSHJ P,MKLSAR ;GET A GC-PROTECTED ARRAY POP P,C LOCKI ;GOING TO HACK WITH THE ARRAY MOVE TT,TTSAR(A) ;POINTER TO THE ARRAY DATA AREA POP P,B ;LENGTH OF THE USER DATA AREA MOVE T,(B) MOVEM T,SR.UDL(TT) ;REMEMBER LENGTH OF USER DATA EXCH A,(P) ;RESTORE FUNCTION AND SAVE SAR ADR HRLI A,(CALL 3,) ;A CALL FUNCTION GOES IN UN-MARKED-FROM SLOT MOVEM A,SR.CAL(TT) ;STORE THE CALL INSTRUCTION HRRZM A,SR.FUN(TT) ;STORE THE FUNCTION, and zero the TTYCONS slot HRRZM C,SR.PNA(TT) ;STORE THE PRINTNAME, and zero the PLIST slot ROT T,-1 ;LENGTH OF USER AREA IN T SKIPGE T ;CONVERT INTO NUMBER OF WORDS NEEDED ADDI T,1 ADDI T,SR.LEN-SR.FML ;NUMBER OF SYSTEM WORDS MARKED MOVNI R,(T) ;NUMBER OF WORDS TO MARK HRLZI R,(R) ;IN LEFT HALF HRRI R,SR.FML(TT) ;POINTER TO FIRST MARKED LOCATION IN RH HRRZ D,@(P) ;GET SAR MOVEM R,-1(D) ;STORE GC MARKING AOBJN POINTER HRLZI TT,AS.SFA ;TURN THE ARRAY INTO AN SFA IORM TT,@(P) ;TURN ON SFA BIT IN THE SAR UNLOCKI ;ALLOW INTERRUPTS AGAIN ;THE FOLLOWING CODE SIMULATES: ; (SFA-CALL 'WHICH-OPERATIONS NIL) HRRZ A,(P) ;FIRST ARG TO SFA IS SFA-OBJCT ITSELF MOVEI B,QWOP ;WHICH-OPERATIONS SETZ C, ;NO THIRD ARG MOVEI TT,SR.CAL ;CALL INSTRUCTION SLOT XCT @TTSAR(A) ;DO CALL INDIRECTLY THROUGH TTSAR JUMPE A,STCRE3 ;THE SFA CAN'T DO ANYTHING, BUT WHY WORRY... SKOTT A,LS ;BETTER HAVE GOTTEN A LIST BACK JRST SCREBS ;BAD SFA IF DIDN'T GET BACK A LIST! STMASK: SETZ F, ;F ACCUMLATES KNOWN SYSTEM OPERATIONS MASK STCRE4: MOVE R,[-STKNOL,,STKNOT] ;AOBJN POINTER OVER KNOWN OPERATIONS HLRZ B,(A) ;CAR IS THE OPERATION STCRE5: HRRZ T,(R) ;KNOWN OPERATIOON CAIE T,(B) ;MATCH? JRST STCRE6 ;NOPE, KEEP LOOPING HRRZ T,R ;GET POINTER HLLZ TT,(R) ;GET MASK CAIL T,STKNOT+18. ;LEFT HALF VALUE? MOVSS TT ;NOPE, ASSUMED WRONG TDOA F,TT ;ACCUMLATE THIS OPERATION AND EXIT LOOP STCRE6: AOBJN R,STCRE5 ;CONTINUE LOOPING UNTIL ALL LOOPED OUT HRRZ A,(A) ;CDR DOWN THE WHICH-OPERATIONS LIST JUMPN A,STCRE4 ;DON'T JUMP IF DON'T HAVE TO STCRE3: POP P,A ;POINTER TO SAR MOVEI TT,SR.WOM ;POINT TO KNOWN OPERATIONS MASK MOVEM F,@TTSAR(A) ;STORE IN ARRAY POPJ P, ;THEN RETURN SAR SCREBS: FAC [NON-LIST FOR WHICH-OPERATIONS MSG!] STCRE1: FAC [SFA FOR 1ST ARG ? -- SFA-CREATE!] ;SFA OPERATION/INTERNAL BIT CORRESPONDANCE TABLE STKNOT: ;LH BITS SO.OPN,,Q$OPEN SO.CLO,,Q$CLOSE SO.REN,,Q$RENAMEF SO.DEL,,Q$DELETEF SO.TRP,,Q%TERPRI SO.PR1,,Q%PR1 SO.TYI,,Q%TYI SO.UNT,,QUNTYI SO.TIP,,QTYIPEEK SO.IN,,Q$IN SO.EOF,,QEOFFN SO.TYO,,Q%TYO SO.PRO,,Q%PRO SO.FOU,,QFORCE SO.RED,,QOREAD SO.RDL,,Q%READLINE SO.PRT,,Q%PRINT SO.PRC,,Q%PRC ;RH BITS SO.MOD,,QFILEMODE SO.POS,,QFILEPOS SO.ICL,,QCLRIN SO.OCL,,QCLROUT SO.OUT,,Q$OUT SO.CUR,,QCURSORPOS SO.RUB,,QRUBOUT STKNOL==:.-STKNOT ;LENGTH OF TABLE ;;; (SFA-CALL ) STCAL1: %WTA @STDISW STCALL: SKOTT A,SA ;MUST BE AN ARRAY HEADER JRST STCAL1 HRLZI TT,AS.SFA ;NOW CHECK FOR SFA-NESS TDNN TT,ASAR(A) JRST STCAL1 ;AN ARRAY BUT NOT A REAL SFA MOVEI TT,SR.CAL XCT @TTSAR(A) ;INVOKE THE SFA POPJ P, ;INTERNAL SFA CALL, BIT INDICATNG OP IN T, SFA-OBJECT IN AR1, ; THIRD ARG TO SFA IN C. RETURNS VALUE OF SFA IN A. DESTORYS ALL ; ACS. ISTCAL: JFFO T,ISTCA0 ;MUST HAVE ONE BIT SET JRST ISTCA1 ISTCA0: HRRZ B,STKNOT(TT) ;GET SYMBOL REPRESENTING OPERATION MOVEI A,(AR1) ;SFA GETS ITSELF AS FIRST ARG MOVEI TT,SR.WOM ;CHECK FOR LEGAL OP -- USE WHICH OP MASK TDNN T,@TTSAR(A) ;MAKE SURE THIS INTERNAL OP IS DOABLE JRST ISTCA1 ;ENTER HERE FOR 'SHORT' INTERNAL CALL PROTOCOL, A, B, AND C SET UP CORRECTLY ISTCSH: MOVEI TT,SR.CAL ;EXECUTE THE CALL TO THE SFA XCT @TTSAR(A) POPJ P, ;RETURN TO CALLER WITH RESULT IN A ISTCA1: LERR [SIXBIT \INVOKING SFA ON UNSUPPORTED OPERATION!\] ;;; (SFAP ) RETURNS T IF IS AN SFA, ELSE NIL STPRED: JSP TT,AFOSP ;CHECK IF A FILE OR SFA JRST FALSE ;NEITHER, RETURN NIL JRST FALSE ;FILE, RETURN FALSE JRST TRUE ;SFA, RETURN TRUE ;;; (SFA-GET ) ;;; (SFA-STORE ) STSTOR: SKIPA F,[STSTOD] ;SFA-STORE DISPATCH TABLE STGET: MOVEI F,STGETD ;SFA-GET DISPATCH TABLE SKIPA STDISW: WTA [NOT A SFA -- SFA-GET/SFA-STORE/SFA-CALL!] JSP TT,AFOSP ;INSURE WE HAVE AN SFA, A ==> AR1 JRST STDISW ;NOT AN SFA JRST STDISW ;A FILE-OBJECT, BUT STILL NOT AN SFA SKOTT B,FX JRST STDIS1 ;NOPE, MUST BE A SYSTEM-LOCATION NAME SKIPGE R,(B) ;GET THE ACTUAL FIXNUM, hopefully positive JRST STDIOB ;NOPE, GIVE OUT-OF-BOUNDS CALL MOVEI TT,SR.UDL ;CHECK AGAINST THE MAXIMUM VALUE CAML R,@TTSAR(AR1) ;IN RANGE? JRST STDIOB ;NOPE, GIVE OUT-OF-BOUNDS CALL ROT R,-1 ;MAKE INTO AN OFFSET AND A FLAG BIT (RH/LH) JRST @-1(F) ;GIVE USER LOCATION ACCESS RETURN STDIOB: EXCH A,B ;GIVE AN OUT-OF-BOUNDS ERROR %FAC IXEXBD STDIS1: MOVE T,[-STRSLN,,0] ;FIND SYS-LOC THAT 2ND ARG IS EQ TO STDIS2: CAME B,STSYSL(T) ;MATCH THIS ENTRY? AOBJN T,STDIS2 ;NOPE, CONTINUE THE LOOP ADDI T,(F) ;MAKE CORRECT TABLE ADDRESS SKIPGE T ;BUT DID WE REALY FIND A MATCH? JRST @(T) ;YES, SO DISPATCH JRST STDIOB ;SFA SYSTEM-NAME TABLE STSYSL: QFUNCTION ;FUNCTION ;stream-specific handler QWOP ;WHICH-OPERATIONS ;list of all acceptible msgs QPNAME ;PNAME ;name for print to use Q$XCONS ;Associated SFA for bi-directional sfas QPLIST ;PLIST ;general property list STRSLN==:.-STSYSL ;SFA-GET DISPATCH TABLE AND FUNCTIONS STGETU ;USER LOCATION STGETD: STGFUN ;FUNCTION STGWOM ;OPERATIONS MASK STGPNA ;PRINT NAME STGCNS ;TTYCONS (i.e., associate for bi-directional) STGPLI ;PLIST STGETU: MOVEI TT,SR.FUS(R) ;INDEX INTO ARRAY HLRZ A,@TTSAR(AR1) ;TRY THE LEFT HALF SKIPGE R ;BUT IS IT THE RIGHT HALF? HRRZ A,@TTSAR(AR1) ;YUP, SO FETCH THAT POPJ P, ;RETURN SLOT'S VALUE STGPNA: SKIPA TT,[SR.PNA] ;RETURN THE PNAME STGFUN: MOVEI TT,SR.FUN ;RETURN THE FUNCTION HRRZ A,@TTSAR(AR1) POPJ P, STGCNS: SKIPA TT,[SR.CNS] ;TTYCONS IS IN LH OF WORD WITH THE FUN STGPLI: MOVEI TT,SR.PLI ;PLIST IS STORED IN LH OF WORD CONTAING PNAME HLRZ A,@TTSAR(AR1) POPJ P, STGWOM: MOVEI TT,SR.WOM ;RETURN THE WHICH-OPERATIONS MASK MOVE D,@TTSAR(AR1) ;GET THE MACHINE NUMBER AND CONS UP A FIXNUM SETZ A, ;START OFF WITH NIL STGWO1: JFFO D,STGWO2 ;ANY MORE LEFT TO DO? POPJ P, ;NOPE, RETURN WITH CONSED UP LIST IN A STGWO2: HRRZ B,STKNOT(R) ;GET ATOM CORRESPONDING TO MASK BIT JSP T,%XCONS ;ADD TO THE HEAD OF THE LIST HRLZI T,400000 ;NOW TURN OFF THE BIT WE JUST HACKED MOVNS R ;MUST NEGATE TO ROTATE ROT T,(R) ;SHIFT INTO CORRECT BIT POSITION TDZ D,T ;TURN OFF THE BIT JRST STGWO1 ;AND DO THE REMAINING BITS ;SFA-STORE DISPATCH TABLE AND ROUTINES STSTOU ;USER LOCATION STSTOD: STSFUN ;FUNCTION STSWOM ;OPERATIONS MASK STSPNA ;PRINT NAME STSCNS ;TTYCONS (i.e., associate for bi-directional) STSPLI ;PLIST STSTOU: MOVEI A,(C) ;PDLNMK THE THING WE ARE GOING TO STORE JSP T,PDLNMK MOVEI TT,SR.FUS(R) ;INDEX INTO ARRAY JUMPL R,STSTU1 ;RIGHT HALF HRLM A,@TTSAR(AR1) ;STORE IN THE LEFT HALF POPJ P, ;RETURN SLOT'S VALUE STSTU1: HRRM A,@TTSAR(AR1) ;LEFT HALF POPJ P, STSPNA: SKIPA TT,[SR.PNA] ;STORE THE PNAME STSFUN: MOVEI TT,SR.FUN ;STORE THE FUNCTION HRRM C,@TTSAR(AR1) MOVEI A,(C) ;RETURN THE STORED VALUE CAIE TT,SR.FUN ;WERE WE HACKING THE FUNCTION? POPJ P, ;NO, SO WE ARE DOINE HRLI C,(CALL 3,) ;WE MUST ALSO FIX THE CALL INSTRUCTION MOVEI TT,SR.CAL MOVEM C,@TTSAR(AR1) POPJ P, STSPLI: SKIPA TT,[SR.PLI] ;STORE THE PLIST STSCNS: MOVEI TT,SR.CNS ;STORE THE "TTYCONS" HRLM C,@TTSAR(AR1) MOVEI A,(C) ;RETURN THE STORED VALUE POPJ P, STSWO1: EXCH A,C %WTA NAPLMS EXCH A,C STSWOM: SKOTT C,LS ;IS THE ARGUMENT A LIST? JRST STSWO1 ;NOPE, WRONG TYPE ARG ERROR PUSH P,AR1 ;SAVE THE SFA FOR STMASK ROUTINE MOVEI A,(C) ;EXPECTS WHICH-OPERATIONS LIST IN A JRST STMASK ;THEN GENERATE A NEW MASK AND RETURN ] ;END IFN SFA PGTOP QIO,[NEW I/O PACKAGE]