github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-29 19:08:01 +00:00
Code Issues Releases Wiki Activity
Files
57b5ce7ac6d3a50b88d409bdac2ce3968939baf5
PDP-10.its/src/l/qio.759

5598 lines
146 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;;; -*-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<CL>
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<CL> ;SET CLOSED BIT
IORB TT,TTSAR(A)
MOVSI T,AS<FIL> ;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<CL>
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<FIL>
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<FIL>
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<IO>,,TTS<IO> ; DESIRED BITS,,MASK
SIXBIT \NOT OUTPUT FILE!\ ; ERROR MSG IF FAIL
IFILOK: JSP T,FILOK0
0,,TTS<IO>
SIXBIT \NOT INPUT FILE!\
ATFLOK: JSP T,FILOK0
0,,TTS<BN>
SIXBIT \NOT ASCII FILE!\
ATOFOK: JSP T,FILOK0
TTS<IO>,,TTS<BN+IO>
SIXBIT \NOT ASCII OUTPUT FILE!\
ATIFOK: JSP T,FILOK0
0,,TTS<BN+IO>
SIXBIT \NOT ASCII INPUT FILE!\
TFILOK: JSP T,FILOK0
TTS<TY>,,TTS<TY>
SIXBIT \NOT TTY FILE!\
TIFLOK: JSP T,FILOK0
TTS<TY>,,TTS<TY+IO>
SIXBIT \NOT TTY INPUT FILE!\
TOFLOK: JSP T,FILOK0
TTS<TY+IO>,,TTS<TY+IO>
SIXBIT \NOT TTY OUTPUT FILE!\
XIFLOK: JSP T,FILOK0
TTS<BN>,,TTS<IM+BN+IO>
SIXBIT \NOT BINARY INPUT FILE!\
XOFLOK: JSP T,FILOK0
TTS<BN+IO>,,TTS<IM+BN+IO>
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<IO>
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<CL>
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: <SIXBIT DEVICE NAME>
;;; <SIXBIT SNAME>
;;; <SIXBIT FILE NAME 1>
;;; <SIXBIT FILE NAME 2> ;TOP OF STACK
;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO
;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE).
;;;
;;; FOR DEC10: <SIXBIT DEVICE NAME>
;;; <PROJ-PROG NUMBER>
;;; <SIXBIT FILE NAME>
;;; <SIXBIT EXTENSION> ;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: <ASCIZ DEVICE OR LOGICAL NAME>
;;; <ASCIZ DIRECTORY NAME>
;;; <ASCIZ FILE NAME>
;;; <ASCIZ EXTENSION/TYPE NAME>
;;; <ASCIZ VERSION/GENERATION> ;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: ((<DEVICE> <SNAME>) <FILE NAME 1> <FILE NAME 2>)
;;; TOPS10: ((<DEVICE> (<PROJ#> <PROG#>)) <FILE NAME> <EXTENSION>)
;;; SAIL: ((<DEVICE> (<PROJ> <PROG>)) <FILE NAME> <EXTENSION>)
;;; CMU: ((<DEVICE> <PPN>) <FILE NAME> <EXTENSION>)
;;; CMU ALSO ALLOWS TOPS10-STYLE NAMELISTS.
;;; TENEX: ((<DEVICE> <DIRECTORY>) <FILE NAME> <EXTENSION> <VERSION>)
;;; TOPS20: ((<DEVICE> <DIRECTORY>) <FILE NAME> <TYPE> <GENERATION>)
;;;
;;; ALL COMPONENTS ARE NOMINALLY ATOMIC SYMBOLS, EXCEPT <PROJ#> AND <PROG#>,
;;; 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: ; There are currently 62. entries in this table.
IRP X,,[AI,AIAR,AIARC,AIDIR,AR,ARC,BOJ,CLA,CLI,CLO,CLU,COM,COR
DIR,DIRHNG,DK,DM,DMAR,DMARC,DMDIR,DNR,DNRF,DSK,ERR,JOB,LP,LPT,LR
MC,MCAR,MCARC,MCDIR,MD,MDAR,MDARC,MDDIR
ML,MLAR,MLARC,MLDIR,MX,MXAR,MXARC,MXDIR
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_<LOG2IDNTB-.RPCNT-1>>(R)
ADDI R,1_<LOG2IDNTB-.RPCNT-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.6DEV-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<JOB+FIL>
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 <FILE>) 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,[<CLOSE 0,0>#<RENAME 0,T>]
SA$ XCT F
SA$ XOR F,[<RELEASE 0,0>#<CLOSE 0,0>]
SA% XOR F,[<RELEASE 0,0>#<RENAME 0,T>]
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,[<CLOSE 0,40>#<RENAME 0,T>]
XCT F ;40 BIT MEANS AVOID SUPERSEDING A FILE
XOR F,[<RELEASE 0,0>#<CLOSE 0,40>]
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,[<RELEASE 0,0>#<CLOSE 0,0>]
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 <FILE> ) 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<BN>
MOVEI B,QFIXNUM
PUSHJ P,XCONS
MOVEI B,Q$IN ;INPUT, OUTPUT, OR APPEND MODE
TLNE TT,TTS<IO>
MOVEI B,Q$OUT
TLNE F,FBT<AP>
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*<ITS\D20>,[
MOVEI B,QCURSORPOS ;CURSORPOS-ABLE
TLNE F,FBT.CP
PUSHJ P,XCONS
] ;END OF IFN USELESS*<ITS\D20>
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 (<THE FILE>, 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 <FILE>) 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 <FILE> <MODELIST>) OPENS A FILE AND RETURNS A
;;; CORRESPONDING FILE OBJECT. IT IS ACTUALLY AN LSUBR
;;; OF ZERO TO TWO ARGUMENTS. THE <FILE> DEFAULTS TO THE
;;; CURRENT DEFAULT FILE NAMES. THE <MODELIST> DEFAULTS
;;; TO NIL.
;;; IF <FILE> IS A NAMELIST OR NAMESTRING, A NEW FILE ARRAY
;;; IS CREATED. IF <FILE> IS A FILE ARRAY ALREADY, IT IS
;;; CLOSED AND RE-OPENED IN THE SPECIFIED MODE; ITS FORMER
;;; MODES SERVE AS THE DEFAULTS FOR THE <MODELIST>.
;;; THE <MODELIST> 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 <FILE> IS A NAMELIST OR
;;; NAMESTRING. IF THE <MODELIST> 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 <NUMBER OF BUFFERS,,BUFFER SIZE>
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,[<INBUF>#<OPEN>]
TRNE R,1
XOR F,[<OUTBUF>#<INBUF>]
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,[<ENTER 0,T>#<LOOKUP 0,T>]
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,[<ENTER 0,T>#<LOOKUP 0,T>] ;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,[<OUTPUT 0,>#<ENTER 0,T>]
XCT F ;SET UP BUFFER HEADER BYTE POINTER AND COUNT
XOR F,[<UGETF 0,T>#<OUTPUT 0,>] ;NOW THE UGETF, HEH, HEH
XCT F
POP FXP,R ;RESTORE SIZE INFO
JRST OPEN3D ;GO, GO, GO
SOPEN3C:
] ;END IFN SAIL
XOR F,[<OUT 0,>#<ENTER 0,T>]
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,[<MTAPE 0,T>#<UGETF 0,R>]
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)
MOVEI 2,.MORLW
MTOPR% ;GET TERMINAL PAGE WIDTH
SUBI 3,1
MOVEM 3,FO.LNL(TT) ;SET LINEL
MOVEI 2,.MORLL
MTOPR% ;GET TERMINAL PAGE LENGTH
MOVEM 3,FO.RPL(TT)
RFMOD%
TRNN 2,TT%PGM
MOVSI 3,200000 ;FOR NON-PAGED MODE, USE INFINITY
MOVEM 3,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> ? <TERMINAL INDEX>
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<CL>
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: <BLOCKMODE SIZE>,,<CHARMODE SIZE>
;;; 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
;;; <BITS FOR LEFT HALF OF TTSAR>,,<BLOCK MODE BUFFER SIZE>
;;; 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<CL!J!!K!!L>,,RBFSIZ
TERMIN
TERMIN
TERMIN
;;; <LEFT HALF FOR FB.IBP>,,<BYTES PER WORD>
;;; 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,[<STATO 0,IO.EOF>#<IN 0,>]
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<IO>
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]\<ZZZ-.RPCNT>
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<TY> ;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 <ALT>
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 <old-sfa or sfa-function>
; <amount-of-local-user-storage>
; <printname>)
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,<SR.LEN*2>+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 <NEWLY-CREATED-SFA> '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 <sfa-object> <operation> <extra-arg>)
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 <object>) RETURNS T IF <object> 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-object> <fixnum or system-location-name>)
;;; (SFA-STORE <sfa-object> <fixnum or system-location-name> <new-value>)
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]
Reference in New Issue View Git Blame Copy Permalink