--- /dev/null
+TITLE OPEN - CHANNEL OPENER FOR MUDDLE
+
+RELOCATABLE
+
+;C. REEVE MARCH 1973
+
+.INSRT MUDDLE >
+
+SYSQ
+
+FNAMS==1
+F==E+1
+G==F+1
+
+IFE ITS,[
+IF1, .INSRT STENEX >
+]
+;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING,
+; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS?
+
+;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM.
+
+; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES
+; FIVE OPTINAL ARGUMENTS AS FOLLOWS:
+
+; FOPEN (<DIR>,<FILE NAME1>,<FILE NAME2>,<DEVICE>,<SYSTEM NAME>)
+;
+; <DIR> - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ
+
+; <FILE NAME1> - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT.
+
+; <FILE NAME2> - SECOND FILE NAME. DEFAULT MUDDLE.
+
+; <DEVICE> - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK.
+
+; <SNAME> - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME.
+
+; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL
+
+
+; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES
+; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES
+
+
+; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION
+
+; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL.
+; DIRECT ;DIRECTION (EITHER READ OR PRINT)
+; NAME1 ;FIRST NAME OF FILE AS OPENED.
+; NAME2 ;SECOND NAME OF FILE
+; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN
+; SNAME ;DIRECTORY NAME
+; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS)
+; RNAME2 ;REAL SECOND NAME
+; RDEVIC ;REAL DEVICE
+; RSNAME ;SYSTEM OR DIRECTORY NAME
+; STATUS ;VARIOUS STATUS BITS
+; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER
+; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO)
+; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION
+
+; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY ***
+; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE
+; CHRPOS ;CURRENT POSITION ON CURRENT LINE
+; PAGLN ;LENGTH OF A PAGE
+; LINPOS ;CURRENT LINE BEING WRITTEN ON
+
+; *** THE FOLLOWING FILEDS FOR INPUT ONLY ***
+; EOFCND ;GETS EVALUATED ON EOF
+; LSTCH ;BACKUP CHARACTER
+; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING
+; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST
+; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES
+
+; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER
+BUFLNT==100
+
+;THIS DEFINES BLOCK MODE BIT FOR OPENING
+BLOCKM==2 ;DEFINED IN THE LEFT HALF
+IMAGEM==4
+
+\f
+;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME
+
+ CHANLNT==4 ;INITIAL CHANNEL LENGTH
+
+; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS
+BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER
+SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS
+PROCHN:
+
+IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR]
+[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR]
+[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR]
+[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX]
+[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]]
+
+ IRP B,C,[A]
+ B==CHANLNT-3
+ T!C,,0
+ 0
+ .ISTOP
+ TERMIN
+ CHANLNT==CHANLNT+2
+TERMIN
+
+
+; EQUIVALANCES FOR CHANNELS
+
+EOFCND==LINLN
+LSTCH==CHRPOS
+WAITNS==PAGLN
+EXBUFR==LINPOS
+DISINF==BUFSTR ;DISPLAY INFO
+INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS
+
+
+;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS
+
+IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR]
+A==.IRPCNT
+TERMIN
+
+EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER
+
+
+
+
+.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS
+.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR
+.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST
+.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL
+.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO
+.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN
+.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST
+.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS
+.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR
+.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1
+.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT
+.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH
+.GLOBAL TGFALS,ONINT
+\f
+.VECT.==40000
+
+; PAIR MOVING MACRO
+
+DEFINE PMOVEM A,B
+ MOVE 0,A
+ MOVEM 0,B
+ MOVE 0,A+1
+ MOVEM 0,B+1
+ TERMIN
+
+; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN
+
+T.SPDL==0 ; SAVES P STACK BASE
+T.DIR==2 ; CONTAINS DIRECTION AND MODE
+T.NM1==4 ; NAME 1 OF FILE
+T.NM2==6 ; NAME 2 OF FILE
+T.DEV==10 ; DEVICE NAME
+T.SNM==12 ; SNAME
+T.XT==14 ; EXTRA CRUFT IF NECESSARY
+T.CHAN==16 ; CHANNEL AS GENERATED
+
+; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES)
+
+S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY
+ ; S.DIR(P) = <control word>,,<direction>
+IFN ITS,[
+S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED
+S.NM1==2 ; SIXBIT NAME1
+S.NM2==3 ; SIXBIT NAME2
+S.SNM==4 ; SIXBIT SNAME
+S.X1==5 ; TEMPS
+S.X2==6
+S.X3==7
+]
+
+IFE ITS,[
+S.DEV==1
+S.X1==2
+S.X2==3
+S.X3==4
+]
+
+
+; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES
+
+NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS
+MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN
+SNSET==100000 ; FLAG, SNAME SUPPLIED
+DVSET==040000 ; FLAG, DEV SUPPLIED
+N2SET==020000 ; FLAG, NAME2 SET
+N1SET==010000 ; FLAG, NAME1 SET
+4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS
+
+RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR
+]
+
+; TABLE OF LEGAL MODES
+
+MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO]
+ SIXBIT /A/
+ TERMIN
+NMODES==.-MODES
+
+MODCOD: 0?1?2?3?3?1
+; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS
+
+IFN ITS,[
+DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL]
+ SIXBIT /A/ ; DEVICE NAMES
+ TERMIN
+
+DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL]
+ SETZ B ; POINTERS
+ TERMIN
+]
+
+IFE ITS,[
+DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET]
+ SIXBIT /A/
+ TERMIN
+
+DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET]
+ SETZ B
+ TERMIN
+]
+NDEVS==.-DEVS
+
+
+\f
+;SUBROUTINE TO DO OPENING BEGINS HERE
+
+MFUNCTION NFOPEN,SUBR,[OPEN-NR]
+
+ JRST FOPEN1
+
+MFUNCTION FOPEN,SUBR,[OPEN]
+
+FOPEN1: ENTRY
+ PUSHJ P,MAKCHN ;MAKE THE CHANNEL
+ PUSHJ P,OPNCH ;NOW OPEN IT
+ JUMPL B,FINIS
+ SUB D,[4,,4] ; TOP THE CHANNEL
+ MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL
+ SETZM (D) ; ZAP IT
+ MOVEI C,1(D)
+ HRLI C,(D)
+ BLT C,CHANLNT-1(D)
+ JRST FINIS
+
+; SUBR TO JUST CREATE A CHANNEL
+
+IMFUNCTION CHANNEL,SUBR
+
+ ENTRY
+ PUSHJ P,MAKCHN
+ MOVSI A,TCHAN
+ JRST FINIS
+
+
+\f
+
+; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT
+
+MAKCHN: PUSH TP,$TPDL
+ PUSH TP,P ; POINT AT CURRENT STACK BASE
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE READ
+ MOVEI E,10 ; SLOTS OF TP NEEDED
+ PUSH TP,[0]
+ SOJG E,.-1
+ MOVEI E,0
+ EXCH E,(P) ; GET RET ADDR IN E
+IFE ITS, PUSH P,[0]
+IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]]
+ MOVE B,IMQUOTE ATM
+IFN ITS, PUSH P,E
+ PUSHJ P,IDVAL1
+ GETYP 0,A
+ CAIN 0,TCHSTR
+ JRST MAK!ATM
+
+ MOVE A,$TCHSTR
+IFN ITS, MOVE B,CHQUOTE MDF
+IFE ITS, MOVE B,CHQUOTE TMDF
+MAK!ATM:
+ MOVEM A,T.!ATM(TB)
+ MOVEM B,T.!ATM+1(TB)
+IFN ITS,[
+ POP P,E
+ PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED
+]
+ TERMIN
+ PUSH TP,[0] ; PUSH SLOTS
+ PUSH TP,[0]
+
+ PUSH P,[0] ; EXT SLOTS
+ PUSH P,[0]
+ PUSH P,[0]
+ PUSH P,E ; PUSH RETURN ADDRESS
+ MOVEI A,0
+
+ JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE
+ GETYP 0,(AB) ; 1ST ARG MUST BE A STRING
+ CAIE 0,TCHSTR
+ JRST WTYP1
+ MOVE A,(AB) ; GET ARG
+ MOVE B,1(AB)
+ PUSHJ P,CHMODE ; CHECK OUT OPEN MODE
+
+ PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS
+ ADD AB,[2,,2] ; BUMP PAST DIRECTION
+ MOVEI A,0
+ JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE
+
+ MOVEI 0,0 ; FLAGS PRESET
+ PUSHJ P,RGPARS ; PARSE THE STRING(S)
+ JRST TMA
+
+; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL
+
+MAKCH0:
+IFN ITS,[
+ MOVE C,T.SPDL+1(TB)
+ MOVE D,S.DEV(C) ; GET DEV
+]
+IFE ITS,[
+ MOVE A,T.DEV(TB)
+ MOVE B,T.DEV+1(TB)
+ PUSHJ P,STRTO6
+ POP P,D
+ HLRZS D
+ MOVE C,T.SPDL+1(TB)
+ MOVEM D,S.DEV(C)
+]
+IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL?
+IFN ITS, CAME D,[SIXBIT /INT /]
+ JRST CHNET ; NO, MAYBE NET
+ SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED?
+ JRST TFA
+
+; FALLS TROUGH IF SKIP
+
+\f
+
+; NOW BUILD THE CHANNEL
+
+ARGSOK: MOVEI A,CHANLNT ; GET LENGTH
+ SKIPN B,RCYCHN+1 ; RECYCLE?
+ PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF
+ SETZM RCYCHN+1
+ ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ HRLI C,PROCHN ; POINT TO PROTOTYPE
+ HRRI C,(B) ; AND NEW ONE
+ BLT C,CHANLN-5(B) ; CLOBBER
+ MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS
+ HLLM C,SCRPTO-1(B)
+
+; NOW BLT IN STUFF FROM THE STACK
+
+ MOVSI C,T.DIR(TB) ; DIRECTION
+ HRRI C,DIRECT-1(B)
+ BLT C,SNAME(B)
+ MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS
+ HRLI C,T.NM1(TB)
+ BLT C,RSNAME(B)
+ MOVE B,IMQUOTE MODE
+ PUSHJ P,IDVAL1
+ GETYP 0,A
+ CAIN 0,TFIX
+ JRST .+3
+ MOVE B,(TP)
+ POPJ P,
+
+ MOVE C,(TP)
+IFE ITS,[
+ ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS
+]
+ HRRM B,-4(C) ; HIDE BITS
+ MOVE B,C
+ POPJ P,
+
+; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN
+
+CHNET:
+IFN ITS,[
+ CAME D,[SIXBIT /NET /] ; IS IT NET
+ JRST MAKCH1]
+IFE ITS,[
+ CAIE D,(SIXBIT /NET/) ; IS IT NET
+ JRST ARGSOK]
+ MOVSI D,TFIX ; FOR TYPES
+ MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED
+ PUSHJ P,CHFIX
+ MOVEI B,T.NM2(TB)
+ PUSHJ P,CHFIX
+ MOVEI B,T.SNM(TB)
+ LSH A,-1 ; SKIP DEV FLAG
+ PUSHJ P,CHFIX
+ JRST ARGSOK
+
+MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX
+ JRST ARGSOK
+ JRST WRONGT
+
+IFN ITS,[
+CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED
+ JRST CHFIX1
+ SETOM 1(B) ; SET TO -1
+ SETOM S.NM1(C)
+ MOVEM D,(B) ; CORRECT TYPE
+]
+IFE ITS,CHFIX:
+ GETYP 0,(B)
+ CAIE 0,TFIX
+ JRST PARSQ
+CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD
+ LSH A,-1 ; AND NEXT FLAG
+ POPJ P,
+PARSQ: CAIE 0,TCHSTR
+ JRST WRONGT
+IFE ITS, POPJ P,
+IFN ITS,[
+ PUSH P,A
+ PUSH P,C
+ PUSH TP,(B)
+ PUSH TP,1(B)
+ SUBI B,(TB)
+ PUSH P,B
+ MCALL 1,PARSE
+ GETYP 0,A
+ CAIE 0,TFIX
+ JRST WRONGT
+ POP P,C
+ ADDI C,(TB)
+ MOVEM A,(C)
+ MOVEM B,1(C)
+ POP P,C
+ POP P,A
+ POPJ P,
+]
+\f
+
+; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE
+
+CHMODE: PUSHJ P,CHMOD ; DO IT
+ MOVE C,T.SPDL+1(TB)
+ HRRZM A,S.DIR(C)
+ POPJ P,
+
+CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT
+ POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT
+
+ MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE
+ CAME B,MODES(A)
+ AOBJN A,.-1
+ JUMPGE A,WRONGD ; ILLEGAL MODE NAME
+ MOVE A,MODCOD(A)
+ POPJ P,
+\f
+
+IFN ITS,[
+; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES
+
+RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE
+
+RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE?
+ IORI 0,4ARG ; 4 STRING CASE
+ HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG
+ MOVSI E,-4 ; FIELDS TO FILL
+
+RPARGL: GETYP 0,(AB) ; GET TYPE
+ CAIE 0,TCHSTR ; STRING?
+ JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW
+ JUMPGE E,CPOPJ ; DON'T DO ANY MORE
+ PUSH TP,(AB) ; GET AN ARG
+ PUSH TP,1(AB)
+
+FPARS: PUSH TP,-1(TP) ; ANOTHER COPY
+ PUSH TP,-1(TP)
+ HLRZ 0,(P)
+ TRNN 0,4ARG
+ PUSHJ P,FLSSP ; NO LEADING SPACES
+ MOVEI A,0 ; WILL HOLD SIXBIT
+ MOVEI B,6 ; CHARS PER 6BIT WORD
+ MOVE C,[440600,,A] ; BYTE POINTER INTO A
+
+FPARSL: HRRZ 0,-1(TP) ; GET COUNT
+ JUMPE 0,PARSD ; DONE
+ SOS -1(TP) ; COUNT
+ ILDB 0,(TP) ; CHAR TO 0
+
+ CAIE 0,"\11 ; FILE NAME QUOTE?
+ JRST NOCNTQ
+ HRRZ 0,-1(TP)
+ JUMPE 0,PARSD
+ SOS -1(TP)
+ ILDB 0,(TP) ; USE THIS
+ JRST GOTCNQ
+
+NOCNTQ: HLL 0,(P)
+ TLNE 0,4ARG
+ JRST GOTCNQ
+ ANDI 0,177
+ CAIG 0,40 ; SPACE?
+ JRST NDFLD ; YES, TERMINATE THIS FIELD
+ CAIN 0,": ; DEVICE ENDED?
+ JRST GOTDEV
+ CAIN 0,"; ; SNAME ENDED
+ JRST GOTSNM
+
+GOTCNQ: ANDI 0,177
+ PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK
+
+ JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6
+ IDPB 0,C
+ SOJA B,FPARSL
+
+; HERE IF SPACE ENCOUNTERED
+
+NDFLD: MOVEI D,(E) ; COPY GOODIE
+ PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES
+ JUMPE 0,PARSD ; NO CHARS LEFT
+
+NFL0: PUSH P,A ; SAVE SIXBIT WORD
+ SKIPGE -1(P) ; SKIP IF STRING TO BE STORED
+ JRST NFL1
+ PUSH TP,$TAB ; PREVENT AB LOSSAGE
+ PUSH TP,AB
+ PUSHJ P,6TOCHS ; CONVERT TO STRING
+ MOVE AB,(TP)
+ SUB TP,[2,,2]
+NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT
+
+NFL2: MOVEI C,(D) ; COPY REL PNTR
+ SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED
+ JRST NFL3
+ ASH D,1 ; TIMES 2
+ ADDI D,T.NM1(TB)
+ MOVEM A,(D) ; STORE
+ MOVEM B,1(D)
+NFL3: MOVSI A,N1SET ; FLAG IT
+ LSH A,(C)
+ IORM A,-1(P) ; AND CLOBBER
+ MOVE D,T.SPDL+1(TB) ; GET P BASE
+ POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT
+
+ POP TP,-2(TP) ; MAKE NEW STRING POINTER
+ POP TP,-2(TP)
+ JUMPE 0,.+3 ; SKIP IF NO MORE CHARS
+ AOBJN E,FPARS ; MORE TO PARSE?
+CPOPJ: POPJ P, ; RETURN, ALL DONE
+
+ SUB TP,[2,,2] ; FLUSH OLD STRING
+ ADD E,[1,,1]
+ ADD AB,[2,,2] ; BUMP ARG
+ JUMPL AB,RPARGL ; AND GO ON
+CPOPJ1: AOS A,(P) ; PREPARE TO WIN
+ HLRZS A
+ POPJ P,
+
+\f
+
+; HERE IF STRING HAS ENDED
+
+PARSD: PUSH P,A ; SAVE 6 BIT
+ MOVE A,-3(TP) ; CAN USE ARG STRING
+ MOVE B,-2(TP)
+ MOVEI D,(E)
+ JRST NFL2 ; AND CONTINUE
+
+; HERE IF JUST READ DEV
+
+GOTDEV: MOVEI D,2 ; CODE FOR DEVICE
+ JRST GOTFLD ; GOT A FIELD
+
+; HERE IF JUST READ SNAME
+
+GOTSNM: MOVEI D,3
+GOTFLD: PUSHJ P,FLSSP
+ SOJA E,NFL0
+
+
+; HERE FOR NON STRING ARG ENCOUNTERED
+
+ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END
+
+ POPJ P,
+ MOVE C,T.SPDL+1(TB) ; GET P-BASE
+ MOVE A,S.DEV(C) ; GET DEVICE
+ CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE
+ JRST TRYNET ; NO, COUD BE NET
+ MOVE A,0 ; OFFNEDING TYPE TO A
+ PUSHJ P,APLQ ; IS IT APPLICABLE
+ JRST NAPT ; NO, LOSE
+ PMOVEM (AB),T.XT(TB)
+ ADD AB,[2,,2] ; MUST BE LAST ARG
+ JUMPL AB,TMA
+ JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN
+TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX
+ JRST WRONGT ; TREAT AS WRONG TYPE
+ MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY
+ IORM A,(P) ; STORE FLAGS
+ MOVSI A,TFIX
+ MOVE B,1(AB) ; GET NUMBER
+ MOVEI 0,(E) ; MAKE SURE NOT DEVICE
+ CAIN 0,2
+ JRST WRONGT
+ PUSH P,B ; SAVE NUMBER
+ MOVEI D,(E) ; SET FOR TABLE OFFSETS
+ MOVEI 0,0
+ ADD TP,[4,,4]
+ JRST NFL2 ; GO CLOBBER IT AWAY
+]
+\f
+
+; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD
+
+FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT
+ JUMPE 0,CPOPJ ; FINISHED STRING
+FLSS1: MOVE B,(TP) ; GET BYTR
+ ILDB C,B ; GETCHAR
+ CAIE C,^Q ; DONT FLUSH CNTL-Q
+ CAILE C,40
+ JRST FLSS2
+ MOVEM B,(TP) ; UPDATE BYTE POINTER
+ SOJN 0,FLSS1
+
+FLSS2: HRRM 0,-1(TP) ; UPDATE STRING
+ POPJ P,
+
+IFN ITS,[
+;TABLE FOR STFUFFING SIXBITS AWAY
+
+SIXTBL: SETZ S.NM1(D)
+ SETZ S.NM2(D)
+ SETZ S.DEV(D)
+ SETZ S.SNM(D)
+ SETZ S.X1(D)
+]
+
+RDTBL: SETZ RDEVIC(B)
+ SETZ RNAME1(B)
+ SETZ RNAME2(B)
+ SETZ RSNAME(B)
+
+
+\f
+IFE ITS,[
+
+; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING)
+
+
+RGPRS: MOVEI 0,NOSTOR
+
+RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING
+ CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE?
+ JRST TN.MLT ; YES, GO PROCESS
+RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE
+ CAIE 0,TCHSTR
+ JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ PUSHJ P,FLSSP ; FLUSH LEADING SPACES
+ PUSHJ P,RGPRS1
+ ADD AB,[2,,2]
+CHKLST: JUMPGE AB,CPOPJ1
+ SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE
+ POPJ P,
+ PMOVEM (AB),T.XT(TB)
+ ADD AB,[2,,2]
+ JUMPL AB,TMA
+CPOPJ1: AOS (P)
+ POPJ P,
+
+RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC
+TN.SNM: MOVE A,(TP)
+ HRRZ 0,-1(TP)
+ JUMPE 0,RPDONE
+ ILDB A,A
+ CAIE A,"< ; START "DIRECTORY" ?
+ JRST TN.N1 ; NO LOOK FOR NAME1
+ SETOM (P) ; DEV NOT ALLOWED
+ IBP (TP) ; SKIP CHAR
+ SOS -1(TP)
+ PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "."
+ JUMPE B,ILLNAM ; RAN OUT
+ CAIE A,".
+ JRST TN.SN3
+ PUSH TP,0
+ PUSH TP,C
+TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">"
+ JUMPE B,ILLNAM ; RAN OUT
+ CAIE A,".
+ JRST TN.SN2
+ MOVEM 0,-1(TP)
+ MOVEM C,(TP)
+ JRST TN.SN1
+TN.SN2: HRRZ B,-3(TP)
+ SUB B,0
+ SUBI B,1
+ SUB TP,[2,,2]
+TN.SN3: CAIE A,"> ; SKIP IF WINS
+ JRST ILLNAM
+ PUSHJ P,TN.CPS ; COPY TO NEW STRING
+ HLLOS T.SPDL(TB)
+ MOVEM A,T.SNM(TB)
+ MOVEM B,T.SNM+1(TB)
+
+TN.N1: PUSHJ P,TN.CNT
+ JUMPE B,RPDONE
+ CAIE A,": ; GOT A DEVICE
+ JRST TN.N11
+ SKIPE (P)
+ JRST ILLNAM
+ SETOM (P)
+ PUSHJ P,TN.CPS
+ MOVEM A,T.DEV(TB)
+ MOVEM B,T.DEV+1(TB)
+ JRST TN.SNM ; NOW LOOK FOR SNAME
+
+TN.N11: CAIE A,">
+ CAIN A,"<
+ JRST ILLNAM
+ MOVEM A,(P) ; SAVE END CHAR
+ PUSHJ P,TN.CPS ; GEN STRING
+ MOVEM A,T.NM1(TB)
+ MOVEM B,T.NM1+1(TB)
+
+TN.N2: SKIPN A,(P) ; GET CHAR BACK
+ JRST RPDONE
+ CAIN A,"; ; START VERSION?
+ JRST .+3
+ CAIE A,". ; START NAME2?
+ JRST ILLNAM ; I GIVE UP!!!
+ HRRZ B,-1(TP) ; GET RMAINS OF STRING
+ PUSHJ P,TN.CPS ; AND COPY IT
+ MOVEM A,T.NM2(TB)
+ MOVEM B,T.NM2+1(TB)
+RPDONE: SUB P,[1,,1] ; FLUSH TEMP
+ SUB TP,[2,,2]
+CPOPJ: POPJ P,
+
+TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT
+ MOVE C,(TP) ; BPTR
+ MOVEI B,0 ; INIT COUNT TO 0
+
+TN.CN1: MOVEI A,0 ; IN CASE RUN OUT
+ SOJL 0,CPOPJ ; RUN OUT?
+ ILDB A,C ; TRY ONE
+ CAIE A,"\16 ; TNEX FILE QUOTE?
+ JRST TN.CN2
+ SOJL 0,CPOPJ
+ IBP C ; SKIP QUOTED CHAT
+ ADDI B,2
+ JRST TN.CN1
+
+TN.CN2: CAIE A,"<
+ CAIN A,">
+ POPJ P,
+
+ CAIE A,".
+ CAIN A,";
+ POPJ P,
+ CAIN A,":
+ POPJ P,
+ AOJA B,TN.CN1
+
+TN.CPS: PUSH P,B ; # OF CHARS
+ MOVEI A,4(B) ; ADD 4 TO B IN A
+ IDIVI A,5
+ PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING
+
+ POP P,C ; CHAR COUNT BACK
+ HRLI B,010700
+ SUBI B,1
+ MOVSI A,TCHSTR
+ HRRI A,(C) ; CHAR STRING
+ MOVE D,B ; COPY BYTER
+
+ JUMPE C,CPOPJ
+ ILDB 0,(TP) ; GET CHAR
+ IDPB 0,D ; AND STROE
+ SOJG C,.-2
+
+ MOVNI C,(A) ; - LENGTH TO C
+ ADDB C,-1(TP) ; DECREMENT WORDS COUNT
+ TRNN C,-1 ; SKIP IF EMPTY
+ POPJ P,
+ IBP (TP)
+ SOS -1(TP) ; ELSE FLUSH TERMINATOR
+ POPJ P,
+
+ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME
+
+TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A
+
+TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE
+ CAIE 0,TFIX
+ CAIN 0,TCHSTR
+ JRST .+2
+ JRST RGPRSS ; ASSUME SINGLE STRING
+ ADD A,[2,,2]
+ JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT
+
+ MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION
+ HLRO A,AB ; MINUS NUMBER OF ARGS IN A
+ MOVN A,A ; NUMBER OF ARGS IN A
+ SUBI A,1
+ CAMGE AB,[-10,,0]
+ MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7
+ ADD A,0 ; LAST WORD OF DESTINATION
+ HRLI 0,(AB)
+ BLT 0,(A) ; BLT 'EM IN
+ ADD AB,[10,,10] ; SKIP THESE GUYS
+ JRST CHKLST
+
+]
+\f
+
+; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY
+; BE ON BOTH TP STACK AND P STACK
+
+OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE
+ HRRZ A,S.DIR(C)
+ ANDI A,1 ; JUST WANT I AND O
+IFE ITS,[
+ HRLM A,S.DEV(C)
+; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS
+; JRST TRLOST ; COMPLAIN
+]
+IFN ITS,[
+ HRLM A,S.DIR(C)
+]
+
+IFN ITS,[
+ MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE
+]
+
+IFE ITS,[HRLZS A,S.DEV(C)
+]
+
+ MOVSI B,-NDEVS ; AOBJN COUNTER
+DEVLP: SETO D,
+ MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE
+ MOVE E,A
+DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS
+ CAMN 0,E
+ JRST CHDIGS ; MAKE SURE REST IS DIGITS
+ LSH D,6
+ JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE
+
+; WASN'T THAT DEVICE, MOVE TO NEXT
+NXTDEV: AOBJN B,DEVLP
+ JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK
+
+IFN ITS,[
+OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT?
+ TRNE A,2 ; SKIP IF UNIT
+ JRST ODSK
+ PUSHJ P,OPEN1 ; OPEN IT
+ PUSHJ P,FIXREA ; AND READCHST IT
+ MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL
+ MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS
+ MOVEM 0,IOINS(B)
+ MOVE C,T.SPDL+1(TB)
+ HRRZ A,S.DIR(C)
+ TRNN A,1
+ JRST EOFMAK
+ MOVEI 0,80.
+ MOVEM 0,LINLN(B)
+ JRST OPNWIN
+
+OSTY: HLRZ A,S.DIR(C)
+ IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT)
+ HRLM A,S.DIR(C)
+ JRST OUSR
+]
+
+; MAKE SURE DIGITS EXIST
+
+CHDIGS: SETCA D,
+ JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE
+ MOVE E,A
+ AND E,D ; LEAVES ONLY DIGITS, IF WINNING
+ LSH E,6
+ LSH D,6
+ JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED
+ JRST CHDIGN
+
+CHDIG1: CAIG D,'9
+ CAIGE D,'0
+ JRST NXTDEV ; NOT A DIGIT, LOSE
+ JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN!
+CHDIGN: SETZ D,
+ ROTC D,6 ; GET NEXT CHARACTER INTO D
+ JRST CHDIG1 ; GO TEST?
+
+; HERE TO DISPATCH IF SUCCESSFUL
+
+DISPA: JRST @DEVS(B)
+
+\f
+IFN ITS,[
+
+; DISK DEVICE OPNER COME HERE
+
+ODSK: MOVE A,S.SNM(C) ; GET SNAME
+ .SUSET [.SSNAM,,A] ; CLOBBER IT
+ PUSHJ P,OPEN0 ; DO REAL LIVE OPEN
+]
+IFE ITS,[
+
+; TENEX DISK FILE OPENER
+
+ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL
+ PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P)
+ MOVE A,DIRECT-1(B)
+ MOVE B,DIRECT(B)
+ PUSHJ P,STRTO6 ; GET DIR NAME
+ MOVE C,(P)
+ MOVE D,T.SPDL+1(TB)
+ HRRZ D,S.DIR(D)
+ CAME C,[SIXBIT /PRINAO/]
+ CAMN C,[SIXBIT /PRINTO/]
+ IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE
+ MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB
+ TRNE D,1 ; SKIP IF INPUT
+ TRNE D,100 ; WITE OVER?
+ TLOA A,100000 ; FORCE OLD VERSION
+ TLO A,600000 ; FORCE NEW VERSION
+ HRROI B,1(E) ; POINT TO STRING
+ GTJFN
+ TDZA 0,0 ; SAVE FACT OF NO SKIP
+ MOVEI 0,1 ; INDICATE SKIPPED
+ POP P,C ; RECOVER OPEN MODE SIXBIT
+ MOVE P,E ; RESTORE PSTACK
+ JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED
+
+ MOVE B,T.CHAN+1(TB) ; GET CHANNEL
+ HRRZ 0,-4(B) ; FUNNY MODE BITS
+ HRRZM A,CHANNO(B) ; SAVE IT
+ ANDI A,-1 ; READ Y TO DO OPEN
+ MOVSI B,440000 ; USE 36. BIT BYES
+ HRRI B,200000 ; ASSUME READ
+; CAMN C,[SIXBIT /READB/]
+; TRO B,2000 ; TURN ON THAWED IF READB
+ IOR B,0
+ TRNE D,1 ; SKIP IF READ
+ HRRI B,300000 ; WRITE BIT
+ HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK
+ CAIN 0,NFOPEN
+ TRO B,400 ; SET DON'T MUNG REF DATE BIT
+ MOVE E,B ; SAVE BITS FOR REOPENS
+ OPENF
+ JRST OPFLOS
+ MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE
+ PUSH P,[0]
+ PUSH P,[0]
+ MOVEI C,-1(P)
+ GTFDB
+ LDB 0,[300600,,-1(P)] ; GET BYTE SIZE
+ MOVE B,(P)
+ SUB P,[2,,2]
+ CAIN 0,7
+ JRST SIZASC
+ CAIN 0,36.
+ SIZEF ; USE OPENED SIZE
+ JFCL
+ IMULI B,5 ; TO BYTES
+SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK
+ TRNE D,1 ; SKIP FOR READ
+ MOVEI 0,C.OPN+C.PRIN+C.DISK
+ TRNE D,2 ; SKIP IF NOT BINARY FILE
+ TRO 0,C.BIN
+ HRL 0,B
+ MOVE B,T.CHAN+1(TB)
+ TRNE D,1
+ HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH
+ MOVEM E,STATUS(B)
+ HRRM 0,-2(B) ; MUNG THOSE BITS
+ ASH A,1 ; POINT TO SLOT
+ ADDI A,CHNL0 ; TO REAL SLOT
+ MOVEM B,1(A) ; SAVE CHANNEL
+ PUSHJ P,TMTNXS ; GET STRING FROM TENEX
+ MOVE B,CHANNO(B) ; JFN TO A
+ HRROI A,1(E) ; BASE OF STRING
+ MOVE C,[111111,,140001] ; WEIRD CONTROL BITS
+ JFNS ; GET STRING
+ MOVEI B,1(E) ; POINT TO START OF STRING
+ SUBM P,E ; RELATIVIZE E
+ PUSHJ P,TNXSTR ; MAKE INTO A STRING
+ SUB P,E ; BACK TO NORMAL
+ PUSH TP,A
+ PUSH TP,B
+ PUSHJ P,RGPRS1 ; PARSE INTO FIELDS
+ MOVE B,T.CHAN+1(TB)
+ MOVEI C,RNAME1-1(B)
+ HRLI C,T.NM1(TB)
+ BLT C,RSNAME(B)
+ JRST OPBASC
+OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE
+ MOVE B,T.CHAN+1(TB)
+ HRRZ A,CHANNO(B) ; JFN BACK TO A
+ RLJFN ; TRY TO RELEASE IT
+ JFCL
+ MOVEI A,(C) ; ERROR CODE BACK TO A
+
+GTJLOS: MOVE B,T.CHAN+1(TB)
+ PUSHJ P,TGFALS ; GET A FALSE WITH REASON
+ JRST OPNRET
+
+STSTK: PUSH TP,$TCHAN
+ PUSH TP,B
+ MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE)
+ MOVE B,(TP)
+ ADD A,RDEVIC-1(B)
+ ADD A,RNAME1-1(B)
+ ADD A,RNAME2-1(B)
+ ADD A,RSNAME-1(B)
+ ANDI A,-1 ; TO 18 BITS
+ MOVEI 0,A(A)
+ IDIVI A,5 ; TO WORDS NEEDED
+ POP P,C ; SAVE RET ADDR
+ MOVE E,P ; SAVE POINTER
+ PUSH P,[0] ; ALOCATE SLOTS
+ SOJG A,.-1
+ PUSH P,C ; RET ADDR BACK
+ INTGO ; IN CASE OVERFLEW
+ PUSH P,0
+ MOVE B,(TP) ; IN CASE GC'D
+ MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT
+ MOVEI A,RDEVIC-1(B)
+ PUSHJ P,MOVSTR ; FLUSH IT ON
+ HRRZ A,T.SPDL(TB)
+ JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON
+ ; A BEING NON ZERO)
+ PUSH P,B
+ PUSH P,C
+ MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N.
+ HRROI B,1(E)
+ HRROI C,1(P)
+ LNMST ; LOOK UP LOGICAL NAME
+ MOVNI A,1 ; NOT A LOGICAL NAME
+ POP P,C
+ POP P,B
+NLNMS: MOVEI 0,":
+ IDPB 0,D
+ JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME
+ HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL?
+ JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT
+ MOVEI A,"<
+ IDPB A,D
+ MOVEI A,RSNAME-1(B)
+ PUSHJ P,MOVSTR ; SNAME UP
+ MOVEI A,">
+ IDPB A,D
+ST.NM1: MOVEI A,RNAME1-1(B)
+ PUSHJ P,MOVSTR
+ MOVEI A,".
+ IDPB A,D
+ MOVEI A,RNAME2-1(B)
+ PUSHJ P,MOVSTR
+ SUB TP,[2,,2]
+ POP P,A
+ POPJ P,
+
+MOVSTR: HRRZ 0,(A) ; CHAR COUNT
+ MOVE A,1(A) ; BYTE POINTER
+ SOJL 0,CPOPJ
+ ILDB C,A ; GET CHAR
+ IDPB C,D ; MUNG IT UP
+ JRST .-3
+
+; MAKE A TENEX ERROR MESSAGE STRING
+
+TGFALS: PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH P,A ; SAVE ERROR CODE
+ PUSHJ P,TMTNXS ; STRING ON STACK
+ HRROI A,1(E) ; POINT TO SPACE
+ MOVE B,(E) ; ERROR CODE
+ HRLI B,400000 ; FOR ME
+ MOVSI C,-100. ; MAX CHARS
+ ERSTR ; GET TENEX STRING
+ JRST TGFLS1
+ JRST TGFLS1
+
+ MOVEI B,1(E) ; A AND B BOUND STRING
+ SUBM P,E ; RELATIVIZE E
+ PUSHJ P,TNXSTR ; BUILD STRING
+ SUB P,E ; P BACK TO NORMAL
+TGFLS2:
+IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT
+IFN FNAMS,[
+ PUSH TP,A
+ PUSH TP,B
+ SKIPN B,-2(TP)
+ JRST TGFLS3
+ PUSHJ P,STSTK
+ MOVEI B,1(E)
+ SUBM P,E
+ MOVSI A,440700
+ HRRI A,(P)
+ MOVEI C,5
+ ILDB 0,A
+ JUMPE 0,.+2
+ SOJG C,.-2
+
+ PUSHJ P,TNXSTR
+ PUSH TP,A
+ PUSH TP,B
+ SUB P,E
+TGFLS3: POP P,A
+ PUSH TP,$TFIX
+ PUSH TP,A
+ MOVEI A,3
+ SKIPN B
+ MOVEI A,2
+]
+IFE FNAMS,[
+ MOVEI A,1
+]
+ PUSHJ P,IILIST ; BUILD LIST
+ MOVSI A,TFALSE ; MAKE IT FALSE
+ SUB TP,[2,,2]
+ POPJ P,
+
+TGFLS1: MOVE P,E ; RESET STACK
+ MOVE A,$TCHSTR
+ MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O
+ JRST TGFLS2
+
+]
+; OTHER BUFFERED DEVICES JOIN HERE
+
+OPDSK1:
+IFN ITS,[
+ PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL
+]
+OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK
+ HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD
+ TRZN A,2 ; SKIP IF BINARY
+ PUSHJ P,OPASCI ; DO IT FOR ASCII
+
+; NOW SET UP IO INSTRUCTION FOR CHANNEL
+
+MAKION: MOVE B,T.CHAN+1(TB)
+ MOVEI C,GETCHR
+ JUMPE A,MAKIO1 ; JUMP IF INPUT
+ MOVEI C,PUTCHR ; ELSE GET INPUT
+ MOVEI 0,80. ; DEFAULT LINE LNTH
+ MOVEM 0,LINLN(B)
+ MOVSI 0,TFIX
+ MOVEM 0,LINLN-1(B)
+MAKIO1:
+ HRLI C,(PUSHJ P,)
+ MOVEM C,IOINS(B) ; STORE IT
+ JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL
+
+; HERE TO CONS UP <ERROR END-OF-FILE>
+
+EOFMAK: MOVSI C,TATOM
+ MOVE D,EQUOTE END-OF-FILE
+ PUSHJ P,INCONS
+ MOVEI E,(B)
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE ERROR
+ PUSHJ P,ICONS
+ MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL
+ MOVSI 0,TFORM
+ MOVEM 0,EOFCND-1(D)
+ MOVEM B,EOFCND(D)
+
+OPNWIN: MOVEI 0,10. ; SET UP RADIX
+ MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL
+ MOVE B,T.CHAN+1(TB)
+ MOVEM 0,RADX(B)
+
+OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT
+ MOVE C,(P) ; RET ADDR
+ SUB P,[S.X3+2,,S.X3+2]
+ SUB TP,[T.CHAN+2,,T.CHAN+2]
+ JRST (C)
+\f
+
+; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O
+
+OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT
+ MOVEI A,BUFLNT ; GET SIZE OF BUFFER
+ PUSHJ P,IBLOCK ; GET STORAGE
+ MOVSI 0,TWORD+.VECT. ; SET UTYPE
+ MOVEM 0,BUFLNT(B) ; AND STORE
+ MOVSI A,TCHSTR
+ SKIPE (P) ; SKIP IF INPUT
+ JRST OPASCO
+ MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER
+OPASCA: HRLI D,010700
+ MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK
+ MOVEI 0,C.BUF
+ IORM 0,-2(B) ; TURN ON BUFFER BIT
+ MOVEM A,BUFSTR-1(B)
+ MOVEM D,BUFSTR(B) ; CLOBBER
+ POP P,A
+ POPJ P,
+
+OPASCO: HRROI C,777776
+ MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT)
+ MOVSI C,(B)
+ HRRI C,1(B) ; BUILD BLT POINTER
+ BLT C,BUFLNT-1(B) ; ZAP
+ MOVEI D,-1(B) ; START MAKING STRING POINTER
+ HRRI A,BUFLNT*5 ; SET UP CHAR COUNT
+ JRST OPASCA
+\f
+
+; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.)
+
+IFN ITS,[
+ONUL:
+OPTP:
+OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN
+ SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS
+ SETZM S.NM2(C)
+ SETZM S.SNM(C)
+ JRST OPDSK1
+
+; OPEN DEVICES THAT IGNORE SNAME
+
+OUTN: PUSHJ P,OPEN0
+ SETZM S.SNM(C)
+ JRST OPDSK1
+
+]
+
+; INTERNAL CHANNEL OPENER
+
+OINT: HRRZ A,S.DIR(C) ; CHECK DIR
+ CAIL A,2 ; READ/PRINT?
+ JRST WRONGD ; NO, LOSE
+
+ MOVE 0,INTINS(A) ; GET INS
+ MOVE D,T.CHAN+1(TB) ; AND CHANNEL
+ MOVEM 0,IOINS(D) ; AND CLOBBER
+ MOVEI 0,C.OPN+C.READ
+ TRNE A,1
+ MOVEI 0,C.OPN+C.PRIN
+ HRRM 0,-2(D)
+ SETOM STATUS(D) ; MAKE SURE NOT AA TTY
+ PMOVEM T.XT(TB),INTFCN-1(D)
+
+; HERE TO SAVE PSEUDO CHANNELS
+
+SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST
+ MOVSI C,TCHAN
+ PUSHJ P,ICONS ; CONS IT ON
+ HRRZM B,CHNL0+1
+ JRST OPNWIN
+
+; INT DEVICE I/O INS
+
+INTINS: PUSHJ P,GTINTC
+ PUSHJ P,PTINTC
+\f
+
+; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET)
+
+IFN ITS,[
+ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE
+ CAILE A,1 ; ASCII ?
+ IORI A,4 ; TURN ON IMAGE BIT
+ SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN
+ IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE
+ SKIPGE S.NM2(C) ; NORMAL OR "LISTEN"
+ IORI A,20 ; TURN ON LISTEN BIT
+ MOVEI 0,7 ; DEFAULT BYTE SIZE
+ TRNE A,2 ; UNLESS
+ MOVEI 0,36. ; IMAGE WHICH IS 36
+ SKIPN T.XT(TB) ; BYTE SIZE GIVEN?
+ MOVEM 0,S.X1(C) ; NO, STORE DEFAULT
+ SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE?
+ JRST RBYTSZ ; NO <0, COMPLAIN
+ TRNE A,2 ; SKIP TO CHECK ASCII
+ JRST ONET2 ; CHECK IMAGE
+ CAIN D,7 ; 7-BIT WINS
+ JRST ONET1
+ CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE
+ JRST .+3
+ IORI A,2 ; SET BLOCK FLAG
+ JRST ONET1
+ IORI A,40 ; USE 8-BIT MODE
+ CAIN D,10 ; IS IT RIGHT
+ JRST ONET1 ; YES
+]
+
+RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD
+
+IFN ITS,[
+ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE?
+ JRST RBYTSZ ; NO
+ CAIN D,36. ; NORMAL
+ JRST ONET1 ; YES, DONT SET FIELD
+
+ ASH D,9. ; POSITION FOR FIELD
+ IORI A,40(D) ; SET IT AND ITS BIT
+
+ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK
+ MOVE E,A ; SAVE BLOCK MODE INFO
+ PUSHJ P,OPEN1 ; DO THE OPEN
+ PUSH P,E
+
+; CLOBBER REAL SLOTS FOR THE OPEN
+
+ MOVEI A,3 ; GET STATE VECTOR
+ PUSHJ P,IBLOCK
+ MOVSI A,TUVEC
+ MOVE D,T.CHAN+1(TB)
+ HLLM A,BUFRIN-1(D)
+ MOVEM B,BUFRIN(D)
+ MOVSI A,TFIX+.VECT. ; SET U TYPE
+ MOVEM A,3(B)
+ MOVE C,T.SPDL+1(TB)
+ MOVE B,T.CHAN+1(TB)
+
+ PUSHJ P,INETST ; GET STATE
+
+ POP P,A ; IS THIS BLOCK MODE
+ MOVEI 0,80. ; POSSIBLE LINE LENGTH
+ TRNE A,1 ; SKIP IF INPUT
+ MOVEM 0,LINLN(B)
+ TRNN A,2 ; BLOCK MODE?
+ JRST .+3
+ TRNN A,4 ; ASCII MODE?
+ JRST OPBASC ; GO SETUP BLOCK ASCII
+ MOVE 0,[PUSHJ P,DOIOT]
+ MOVEM 0,IOINS(B)
+
+ JRST OPNWIN
+
+; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL
+
+INETST: MOVE A,S.NM1(C)
+ MOVEM A,RNAME1(B)
+ MOVE A,S.NM2(C)
+ MOVEM A,RNAME2(B)
+ LDB A,[1100,,S.SNM(C)]
+ MOVEM A,RSNAME(B)
+
+ MOVE E,BUFRIN(B) ; GET STATE BLOCK
+INTST1: HRRE 0,S.X1(C)
+ MOVEM 0,(E)
+ ADDI C,1
+ AOBJN E,INTST1
+
+ POPJ P,
+\f
+
+; ACCEPT A CONNECTION
+
+MFUNCTION NETACC,SUBR
+
+ PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL
+ MOVE A,CHANNO(B) ; GET CHANNEL
+ LSH A,23. ; TO AC FIELD
+ IOR A,[.NETACC]
+ XCT A
+ JRST IFALSE ; RETURN FALSE
+NETRET: MOVE A,(AB)
+ MOVE B,1(AB)
+ JRST FINIS
+
+; FORCE SYSTEM NETWORK BUFFERS TO BE SENT
+
+MFUNCTION NETS,SUBR
+
+ PUSHJ P,ARGNET
+ CAME A,MODES+1
+ CAMN A,MODES+3
+ SKIPA A,CHANNO(B) ; GET CHANNEL
+ JRST WRONGD
+ LSH A,23.
+ IOR A,[.NETS]
+ XCT A
+ JRST NETRET
+
+; SUBR TO RETURN UPDATED NET STATE
+
+MFUNCTION NETSTATE,SUBR
+
+ PUSHJ P,ARGNET ; IS IT A NET CHANNEL
+ PUSHJ P,INSTAT
+ JRST FINIS
+
+; INTERNAL NETSTATE ROUTINE
+
+INSTAT: MOVE C,P ; GET PDL BASE
+ MOVEI 0,S.X3 ; # OF SLOTS NEEDED
+ PUSH P,[0]
+ SOJN 0,.-1
+; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF
+; COMMENTED OUT HERE CERTAINLY DOESN'T.
+ MOVEI D,S.DEV(C)
+ HRL D,CHANNO(B)
+ .RCHST D,
+; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL
+; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]]
+; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF
+ ; LOSSAGE
+ PUSHJ P,INETST ; INTO VECTOR
+ SUB P,[S.X3,,S.X3]
+ MOVE B,BUFRIN(B)
+ MOVSI A,TUVEC
+ POPJ P,
+]
+; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE
+
+ARGNET: ENTRY 1
+ GETYP 0,(AB)
+ CAIE 0,TCHAN
+ JRST WTYP1
+ MOVE B,1(AB) ; GET CHANNEL
+ SKIPN CHANNO(B) ; OPEN?
+ JRST CHNCLS
+ MOVE A,RDEVIC-1(B) ; GET DEV NAME
+ MOVE B,RDEVIC(B)
+ PUSHJ P,STRTO6
+ POP P,A
+ CAME A,[SIXBIT /NET /]
+ JRST NOTNET
+ MOVE B,1(AB)
+ MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET
+ MOVE B,DIRECT(B)
+ PUSHJ P,STRTO6
+ MOVE B,1(AB) ; RESTORE CHANNEL
+ POP P,A
+ POPJ P,
+\f
+IFE ITS,[
+
+; TENEX NETWRK OPENING CODE
+
+ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL
+ MOVSI C,100700
+ HRRI C,1(P)
+ MOVE E,P
+ PUSH P,[ASCII /NET:/] ; FOR STRINGS
+ GETYP 0,RNAME1-1(B) ; CHECK TYPE
+ CAIE 0,TFIX ; SKIP IF # SUPPLIED
+ JRST ONET1
+ MOVE 0,RNAME1(B) ; GET IT
+ PUSHJ P,FIXSTK
+ JFCL
+ JRST ONET2
+ONET1: CAIE 0,TCHSTR
+ JRST WRONGT
+ HRRZ 0,RNAME1-1(B)
+ MOVE B,RNAME1(B)
+ JUMPE 0,ONET2
+ ILDB A,B
+ JSP D,ONETCH
+ SOJA 0,.-3
+ONET2: MOVEI A,".
+ JSP D,ONETCH
+ MOVE B,T.CHAN+1(TB)
+ GETYP 0,RNAME2-1(B)
+ CAIE 0,TFIX
+ JRST ONET3
+ GETYP 0,RSNAME-1(B)
+ CAIE 0,TFIX
+ JRST WRONGT
+ MOVE 0,RSNAME(B)
+ CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER?
+ JRST ONET2A
+;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS
+ MOVEI A,0
+ LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 ->
+ DPB B,[201000,,A] ; 2.8-3.6
+ LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 ->
+ DPB B,[001000,,A] ; 1.1-1.8
+ LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 ->
+ DPB B,[101000,,A] ; 1.9-2.7
+ LDB B,[331100,,0] ;NETWORK: 4.1-4.9 ->
+ DPB B,[301000,,A] ; 3.7-4.5
+ MOVE 0,A
+ONET2A: PUSHJ P,FIXSTK
+ JRST ONET4
+ MOVE B,T.CHAN+1(TB)
+ MOVEI A,"-
+ JSP D,ONETCH
+ MOVE 0,RNAME2(B)
+ PUSHJ P,FIXSTK
+ JRST WRONGT
+ JRST ONET4
+ONET3: CAIE 0,TCHSTR
+ JRST WRONGT
+ HRRZ 0,RNAME2-1(B)
+ MOVE B,RNAME2(B)
+ JUMPE 0,ONET4
+ ILDB A,B
+ JSP D,ONETCH
+ SOJA 0,.-3
+
+ONET4:
+ONET5: MOVE B,T.CHAN+1(TB)
+ GETYP 0,RNAME2-1(B)
+ CAIN 0,TCHSTR
+ JRST ONET6
+ MOVEI A,";
+ JSP D,ONETCH
+ MOVEI A,"T
+ JSP D,ONETCH
+ONET6: MOVSI A,1
+ HRROI B,1(E) ; STRING POINTER
+ GTJFN ; GET THE G.D JFN
+ TDZA 0,0 ; REMEMBER FAILURE
+ MOVEI 0,1
+ MOVE P,E ; RESTORE P
+ JUMPE 0,GTJLOS ; CONS UP ERROR STRING
+
+ MOVE B,T.CHAN+1(TB)
+ HRRZM A,CHANNO(B) ; SAVE THE JFN
+
+ MOVE C,T.SPDL+1(TB)
+ MOVE D,S.DIR(C)
+ MOVEI B,10
+ TRNE D,2
+ MOVEI B,36.
+ SKIPE T.XT(TB)
+ MOVE B,T.XT+1(TB)
+ JUMPL B,RBYTSZ
+ CAILE B,36.
+ JRST RBYTSZ
+ ROT B,-6
+ TLO B,3400
+ HRRI B,200000
+ TRNE D,1 ; SKIP FOR INPUT
+ HRRI B,100000
+ ANDI A,-1 ; ISOLATE JFCN
+ OPENF
+ JRST OPFLOS ; REPORT ERROR
+ MOVE B,T.CHAN+1(TB)
+ ASH A,1 ; POINT TO SLOT
+ ADDI A,CHNL0 ; TO REAL SLOT
+ MOVEM B,1(A) ; SAVE CHANNEL
+ MOVE C,T.SPDL+1(TB) ; POINT TO P BASE
+ HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT
+ MOVEI 0,C.OPN+C.READ
+ TRNE A,1
+ MOVEI 0,C.OPN+C.PRIN
+ TRNE A,2
+ TRO 0,C.BIN
+ HRRM 0,-2(B)
+ MOVE A,CHANNO(B)
+ CVSKT ; GET ABS SOCKET #
+ FATAL NETWORK BITES THE BAG!
+ MOVE D,B
+ MOVE B,T.CHAN+1(TB)
+ MOVEM D,RNAME1(B)
+ MOVSI 0,TFIX
+ MOVEM 0,RNAME1-1(B)
+
+ MOVSI 0,TFIX
+ MOVEM 0,RNAME2-1(B)
+ MOVEM 0,RSNAME-1(B)
+ MOVE C,T.SPDL+1(TB)
+ MOVE C,S.DIR(C)
+ MOVE 0,[PUSHJ P,DONETO]
+ TRNN C,1 ; SKIP FOR OUTPUT
+ MOVE 0,[PUSHJ P,DONETI]
+ MOVEM 0,IOINS(B)
+ MOVEI 0,80. ; LINELENGTH
+ TRNE C,1 ; SKIP FOR INPUT
+ MOVEM 0,LINLN(B)
+ MOVEI A,3 ; GET STATE UVECTOR
+ PUSHJ P,IBLOCK
+ MOVSI 0,TFIX+.VECT.
+ MOVEM 0,3(B)
+ MOVE C,B
+ MOVE B,T.CHAN+1(TB)
+ MOVEM C,BUFRIN(B)
+ MOVSI 0,TUVEC
+ HLLM 0,BUFRIN-1(B)
+ MOVE B,CHANNO(B) ; GET JFN
+ MOVEI A,4 ; CODE FOR GTNCP
+ MOVEI C,1(P)
+ ADJSP P,4 ; ROOM FOR DATA
+ MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC
+ GTNCP
+ FATAL NET LOSSAGE ; GET STATE
+ MOVE B,(P)
+ MOVE D,-1(P)
+ MOVE C,-3(P)
+ ADJSP P,-4
+ MOVE E,T.CHAN+1(TB)
+ MOVEM D,RNAME2(E)
+ MOVEM C,RSNAME(E)
+ MOVE C,BUFRIN(E)
+ MOVEM B,(C) ; INITIAL STATE STORED
+ MOVE B,E
+ JRST OPNWIN
+
+; DOIOT FOR TENEX NETWRK
+
+DONETO: PUSH P,0
+ MOVE 0,[BOUT]
+ JRST .+3
+
+DONETI: PUSH P,0
+ MOVE 0,[BIN]
+ PUSH P,0
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0
+ MOVE A,CHANNO(B)
+ MOVE B,0
+ ENABLE
+ XCT (P)
+ DISABLE
+ MOVEI A,(B) ; RET CHAR IN A
+ MOVE B,(TP)
+ MOVE 0,-1(P)
+ SUB P,[2,,2]
+ SUB TP,[2,,2]
+ POPJ P,
+
+NETPRS: MOVEI D,0
+ HRRZ 0,(C)
+ MOVE C,1(C)
+
+ONETL: ILDB A,C
+ CAIN A,"#
+ POPJ P,
+ SUBI A,60
+ ASH D,3
+ IORI D,(A)
+ SOJG 0,ONETL
+ AOS (P)
+ POPJ P,
+
+FIXSTK: CAMN 0,[-1]
+ POPJ P,
+ JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG
+ MOVEI A,"0
+ POP P,D
+ AOJA D,ONETCH
+FIXS3: IDIVI A,3
+ MOVEI B,12.
+ SUBI B,(A)
+ HRLM B,(P)
+ IMULI A,3
+ LSH 0,(A)
+ POP P,B
+FIXS2: MOVEI A,0
+ ROTC 0,3 ; NEXT DIGIT
+ ADDI A,60
+ JSP D,ONETCH
+ SUB B,[1,,0]
+ TLNN B,-1
+ JRST 1(B)
+ JRST FIXS2
+
+ONETCH: IDPB A,C
+ TLNE C,760000 ; SKIP IF NEW WORD
+ JRST (D)
+ PUSH P,[0]
+ JRST (D)
+
+INSTAT: MOVE E,B
+ MOVE B,CHANNO(B) ; GET JFN
+ MOVEI A,4 ; CODE FOR GTNCP
+ MOVEI C,1(P)
+ ADJSP P,4 ; ROOM FOR DATA
+ MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC
+ GTNCP
+ FATAL NET LOSSAGE ; GET STATE
+ MOVE B,(P)
+ MOVE D,-1(P)
+ MOVE C,-3(P)
+ ADJSP P,-4
+ MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET
+ MOVEM C,RSNAME(E) ; AND HOST
+ MOVE C,BUFRIN(E)
+ XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS
+ MOVEM B,(C) ; STORE STATE
+ MOVE B,E
+ POPJ P,
+\r
+ITSTRN: MOVEI B,0\r
+ JRST NLOSS\r
+ JRST NLOSS\r
+ MOVEI B,1\r
+ MOVEI B,2\r
+ JRST NLOSS\r
+ MOVEI B,4\r
+ PUSHJ P,NOPND\r
+ MOVEI B,0\r
+ JRST NLOSS\r
+ JRST NLOSS\r
+ PUSHJ P,NCLSD\r
+ MOVEI B,0\r
+ JRST NLOSS\r
+ MOVEI B,0
+
+NLOSS: FATAL ILLEGAL NETWORK STATE
+
+NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT
+ ILDB B,B ; GET 1ST CHAR
+ CAIE B,"R ; SKIP FOR READ
+ JRST NOPNDW
+ SIBE ; SEE IF INPUT EXISTS
+ JRST .+3
+ MOVEI B,5
+ POPJ P,
+ MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR
+ MOVEI B,11 ; RETURN DATA PRESENT STATE
+ POPJ P,
+
+NOPNDW: SOBE ; SEE IF OUTPUT PRESENT
+ JRST .+3
+ MOVEI B,5
+ POPJ P,
+
+ MOVEI B,6
+ POPJ P,
+
+NCLSD: MOVE B,DIRECT(E)
+ ILDB B,B
+ CAIE B,"R
+ JRST RET0
+ SIBE
+ JRST .+2
+ JRST RET0
+ MOVEI B,10
+ POPJ P,
+
+RET0: MOVEI B,0
+ POPJ P,
+
+
+MFUNCTION NETSTATE,SUBR
+
+ PUSHJ P,ARGNET
+ PUSHJ P,INSTAT
+ MOVE B,BUFRIN(B)
+ MOVSI A,TUVEC
+ JRST FINIS
+
+MFUNCTION NETS,SUBR
+
+ PUSHJ P,ARGNET
+ CAME A,MODES+1 ; PRINT OR PRINTB?
+ CAMN A,MODES+3
+ SKIPA A,CHANNO(B)
+ JRST WRONGD
+ MOVEI B,21
+ MTOPR
+NETRET: MOVE B,1(AB)
+ MOVSI A,TCHAN
+ JRST FINIS
+
+MFUNCTION NETACC,SUBR
+
+ PUSHJ P,ARGNET
+ MOVE A,CHANNO(B)
+ MOVEI B,20
+ MTOPR
+ JRST NETRET
+
+]
+\f
+; HERE TO OPEN TELETYPE DEVICES
+
+OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE
+ TRNE A,2 ; SKIP IF NOT READB/PRINTB
+ JRST WRONGD ; CANT DO THAT
+
+IFN ITS,[
+ MOVE A,S.NM1(C) ; CHECK FOR A DIR
+ MOVE 0,S.NM2(C)
+ CAMN A,[SIXBIT /.FILE./]
+ CAME 0,[SIXBIT /(DIR)/]
+ SKIPA E,[-15.*2,,]
+ JRST OUTN ; DO IT THAT WAY
+
+ HRRZ A,S.DIR(C) ; CHECK DIR
+ TRNE A,1
+ JRST TTYLP2
+ HRRI E,CHNL1
+ PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME
+ ; HRLZS (P) ; POSTITION DEVICE NAME
+
+TTYLP: SKIPN D,1(E) ; CHANNEL OPEN?
+ JRST TTYLP1 ; NO, GO TO NEXT
+ MOVE A,RDEVIC-1(D) ; GET DEV NAME
+ MOVE B,RDEVIC(D)
+ PUSHJ P,STRTO6 ; TO 6 BIT
+ POP P,A ; GET RESULT
+ CAMN A,(P) ; SAME?
+ JRST SAMTYQ ; COULD BE THE SAME
+TTYLP1: ADD E,[2,,2]
+ JUMPL E,TTYLP
+ SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE
+TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE
+ HRRZ A,S.DIR(C) ; GET DIR OF OPEN
+ SKIPE A ; IF OUTPUT,
+ IORI A,20 ; THEN USE DISPLAY MODE
+ HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK
+ PUSHJ P,OPEN2 ; OPEN THE TTY
+ MOVE A,S.DEV(C) ; GET DEVICE NAME
+ PUSHJ P,6TOCHS ; TO A STRING
+ MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL
+ MOVEM A,RDEVIC-1(D)
+ MOVEM B,RDEVIC(D)
+ MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE
+ MOVE B,D ; CHANNEL TO B
+ HRRZ 0,S.DIR(C) ; AND DIR
+ JUMPE 0,TTYSPC
+TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]]
+ .LOSE %LSSYS
+ DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D]
+ .LOSE %LSSYS
+ MOVE A,[PUSHJ P,GMTYO]
+ MOVEM A,IOINS(B)
+ DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]]
+ .LOSE %LSSYS
+ MOVEM D,LINLN(B)
+ MOVEM A,PAGLN(B)
+ JRST OPNWIN
+
+; MAKE AN IOT
+
+IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL
+ ROT A,5
+ IOR A,[.IOT A] ; BUILD IOT
+ MOVEM A,IOINS(B) ; AND STORE IT
+ POPJ P,
+\f
+
+; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY
+
+SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL
+ MOVE A,DIRECT-1(D) ; GET DIR
+ MOVE B,DIRECT(D)
+ PUSHJ P,STRTO6
+ POP P,A ; GET SIXBIT
+ MOVE C,T.SPDL+1(TB)
+ HRRZ C,S.DIR(C)
+ CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION
+ JRST TTYLP1
+
+; HERE IF A RE-OPEN ON A TTY
+
+ HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN
+ CAIN 0,FOPEN
+ JRST RETOLD ; RET OLD CHANNEL
+
+ PUSH TP,$TCHAN
+ PUSH TP,1(E) ; PUSH OLD CHANNEL
+ PUSH TP,$TFIX
+ PUSH TP,T.CHAN+1(TB)
+ MOVE A,[PUSHJ P,CHNFIX]
+ MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS
+ PUSHJ P,GCHACK
+ SUB TP,[4,,4]
+
+RETOLD: MOVE B,1(E) ; GET CHANNEL
+ AOS CHANNO-1(B) ; AOS REF COUNT
+ MOVSI A,TCHAN
+ SUB P,[1,,1] ; CLEAN UP STACK
+ JRST OPNRET ; AND LEAVE
+
+
+; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER
+
+CHNFIX: CAIN C,TCHAN
+ CAME D,(TP)
+ POPJ P,
+ MOVE D,-2(TP) ; GET REPLACEMENT
+ SKIPE B
+ MOVEM D,1(B) ; CLOBBER IT AWAY
+ POPJ P,
+]\f
+
+IFE ITS,[
+ MOVE C,T.SPDL+1(TB) ; POINT TO P BASE
+ HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT
+ MOVE A,[PUSHJ P,INMTYO]
+ MOVE B,T.CHAN+1(TB)
+ MOVEM A,IOINS(B)
+ MOVEI A,100 ; PRIM INPUT JFN
+ JUMPN 0,TNXTY1
+ MOVEI E,C.OPN+C.READ+C.TTY
+ HRRM E,-2(B)
+ MOVEM B,CHNL0+2*100+1
+ JRST TNXTY2
+TNXTY1: MOVEM B,CHNL0+2*101+1
+ MOVEI A,101 ; PRIM OUTPUT JFN
+ MOVEI E,C.OPN+C.PRIN+C.TTY
+ HRRM E,-2(B)
+TNXTY2: MOVEM A,CHANNO(B)
+ JUMPN 0,OPNWIN
+]
+; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES
+
+TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER
+ PUSHJ P,IBLOCK ; GET BLOCK
+ MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER
+IFN ITS,[
+ MOVE A,CHANNO(D)
+ LSH A,23.
+ IOR A,[.IOT A]
+ MOVEM A,IOIN2(B)
+]
+IFE ITS,[
+ MOVE A,[PBIN]
+ MOVEM A,IOIN2(B)
+]
+ MOVSI A,TLIST
+ MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS
+ SETZM EXBUFR(D) ; NIL LIST
+ MOVEM B,BUFRIN(D) ;STORE IN CHANNEL
+ MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR
+ HLLM A,BUFRIN-1(D)
+ MOVEI A,177 ;SET ERASER TO RUBOUT
+ MOVEM A,ERASCH(B)
+IFE ITS,[
+ MOVEI A,25
+ MOVEM A,KILLCH(B)
+]
+IFN ITS,[
+ SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED
+]
+ MOVEI A,33 ;BREAKCHR TO C.R.
+ MOVEM A,BRKCH(B)
+ MOVEI A,"\ ;ESCAPER TO \
+ MOVEM A,ESCAP(B)
+ MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER
+ MOVEM A,BYTPTR(B)
+ MOVEI A,14 ;BARF BACK CHARACTER FF
+ MOVEM A,BRFCHR(B)
+ MOVEI A,^D
+ MOVEM A,BRFCH2(B)
+
+; SETUP DEFAULT TTY INTERRUPT HANDLER
+
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE CHAR,CHAR,INTRUP
+ PUSH TP,$TFIX
+ PUSH TP,[10] ; PRIORITY OF CHAR INT
+ PUSH TP,$TCHAN
+ PUSH TP,D
+ MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TSUBR
+ PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER
+ MCALL 2,HANDLER
+
+; BUILD A NULL STRING
+
+ MOVEI A,0
+ PUSHJ P,IBLOCK ; USE A BLOCK
+ MOVE D,T.CHAN+1(TB)
+ MOVEI 0,C.BUF
+ IORM 0,-2(D)
+ HRLI B,010700
+ SUBI B,1
+ MOVSI A,TCHSTR
+ MOVEM A,BUFSTR-1(D)
+ MOVEM B,BUFSTR(D)
+ MOVEI A,0
+ MOVE B,D ; CHANNEL TO B
+ JRST MAKION
+\f
+
+; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST
+
+IFN ITS,[
+OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK
+ PUSHJ P,MOPEN ; OPEN THE FILE
+ JRST OPNLOS
+ MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK
+ MOVEM A,CHANNO(B) ; SAVE THE CHANNEL
+ JRST OPEN3
+
+; FIX UP MODE AND FALL INTO OPEN
+
+OPEN0: HRRZ A,S.DIR(C) ; GET DIR
+ TRNE A,2 ; SKIP IF NOT BLOCK
+ IORI A,4 ; TURN ON IMAGE
+ IORI A,2 ; AND BLOCK
+
+ PUSH P,A
+ PUSH TP,$TPDL
+ PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA
+ MOVE B,T.CHAN+1(TB)
+ MOVE A,DIRECT-1(B)
+ MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR
+ PUSHJ P,STRTO6
+ MOVE C,(TP)
+ POP P,D ; THE SIXBIT FOR KLUDGE
+ POP P,A ; GET BACK THE RANDOM BITS
+ SUB TP,[2,,2]
+ CAME D,[SIXBIT /PRINAO/]
+ CAMN D,[SIXBIT /PRINTO/]
+ IORI A,100000 ; WRITEOVER BIT
+ HRRZ 0,FSAV(TB)
+ CAIN 0,NFOPEN
+ IORI A,10 ; DON'T CHANGE REF DATE
+OPEN9: HRLM A,S.DIR(C) ; AND STORE IT
+
+; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL
+
+OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK
+ PUSHJ P,MOPEN
+ JRST OPNLOS
+ MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK
+ MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL
+ DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]]
+ JFCL
+
+; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL
+
+OPEN3: MOVE A,S.DIR(C)
+ MOVEI 0,C.OPN+C.READ
+ TRNE A,1
+ MOVEI 0,C.OPN+C.PRIN
+ TRNE A,2
+ TRO 0,C.BIN
+ HRRM 0,-2(B)
+ MOVE A,CHANNO(B) ; GET CHANNEL #
+ ASH A,1
+ ADDI A,CHNL0 ; POINT TO SLOT
+ MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP
+
+; NOW GET STATUS WORD
+
+DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD
+ DOTCAL STATUS,[A,[2002,,STATUS]]
+ JFCL
+ POPJ P,
+\f
+
+; HERE IF OPEN FAILS (CHANNEL IS IN A)
+
+OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE
+ LSH A,23. ; DO A .STATUS
+ IOR A,[.STATUS A]
+ XCT A ; STATUS TO A
+ MOVE B,T.CHAN+1(TB)
+ PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE
+ SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED
+ JRST OPNRET ; AND RETURN
+]
+
+CGFALS: SUBM M,(P)
+ MOVEI B,0
+IFN ITS, PUSHJ P,GFALS
+IFE ITS, PUSHJ P,TGFALS
+ JRST MPOPJ
+
+; ROUTINE TO CONS UP FALSE WITH REASON
+IFN ITS,[
+GFALS: PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV
+ PUSH P,[3] ; SAY ITS FOR CHANNEL
+ PUSH P,A
+ .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS
+ FATAL CAN'T OPEN ERROR DEVICE
+ SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW
+IFN FNAMS, PUSH P,A
+ MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK
+EL1: PUSH P,[0] ; WHERE IT WILL GO
+ MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK
+EL2: .IOT 0,0 ; GET A CHAR
+ JUMPL 0,EL3 ; JUMP ON -1,,3
+ CAIN 0,3 ; EOF?
+ JRST EL3 ; YES, MAKE STRING
+ CAIN 0,14 ; IGNORE FORM FEEDS
+ JRST EL2 ; IGNORE FF
+ CAIE 0,15 ; IGNORE CR & LF
+ CAIN 0,12
+ JRST EL2
+ IDPB 0,B ; STUFF IT
+ TLNE B,760000 ; SIP IF WORD FULL
+ AOJA A,EL2
+ AOJA A,EL1 ; COUNT WORD AND GO
+
+EL3:
+IFN FNAMS,[
+ SKIPN (P)
+ SUB P,[1,,1]
+ PUSH P,A
+ .CLOSE 0,
+ PUSHJ P,CHMAK
+ PUSH TP,A
+ PUSH TP,B
+ SKIPN B,-2(TP)
+ JRST EL4
+ MOVEI A,0
+ MOVSI B,(<440700,,(P)>)
+ PUSH P,[0]
+ IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40]
+IFSN YY,0,[
+ MOVEI 0,YY
+ JSP E,1PUSH
+]
+ MOVE E,-2(TP)
+ MOVE C,XX(E)
+ HRRZ D,XX-1(E)
+ JSP E,PUSHIT
+ TERMIN
+]
+ SKIPN (P) ; ANY CHARS AT END?
+ SUB P,[1,,1] ; FLUSH XTRA
+ PUSH P,A ; PUT UP COUNT
+ .CLOSE 0, ; CLOSE THE ERR DEVICE
+ PUSHJ P,CHMAK ; MAKE STRING
+ PUSH TP,A
+ PUSH TP,B
+IFN FNAMS,[
+EL4: POP P,A
+ PUSH TP,$TFIX
+ PUSH TP,A]
+IFE FNAMS, MOVEI A,1
+IFN FNAMS,[
+ MOVEI A,3
+ SKIPN B
+ MOVEI A,2
+]
+ PUSHJ P,IILIST
+ MOVSI A,TFALSE ; MAKEIT A FALSE
+IFN FNAMS, SUB TP,[2,,2]
+ POPJ P,
+
+IFN FNAMS,[
+1PUSH: MOVEI D,0
+ JRST PUSHI2
+PUSHI1: PUSH P,[0]
+ MOVSI B,(<440700,,(P)>)
+PUSHIT: SOJL D,(E)
+ ILDB 0,C
+PUSHI2: IDPB 0,B
+ TLNE B,760000
+ AOJA A,PUSHIT
+ AOJA A,PUSHI1
+]
+]
+\f
+
+; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL
+
+FIXREA:
+IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS
+ MOVE D,[-4,,S.DEV]
+
+FIXRE1: MOVEI A,(D) ; COPY REL POINTER
+ ADD A,T.SPDL+1(TB) ; POINT TO SLOT
+ SKIPN A,(A) ; SKIP IF GOODIE THERE
+ JRST FIXRE2
+ PUSHJ P,6TOCHS ; MAKE INOT A STRING
+ MOVE C,RDTBL-S.DEV(D); GET OFFSET
+ ADD C,T.CHAN+1(TB)
+ MOVEM A,-1(C)
+ MOVEM B,(C)
+FIXRE2: AOBJN D,FIXRE1
+ POPJ P,
+
+IFN ITS,[
+DOOPN: HRLZ A,A
+ HRR A,CHANNO(B) ; GET CHANNEL
+ DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)]
+ SKIPA
+ AOS -1(P)
+ POPJ P,
+]
+\f
+;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES
+STRTO6: PUSH TP,A
+ PUSH TP,B
+ PUSH P,E ;SAVE USEFUL FROB
+ MOVEI E,(A) ; CHAR COUNT TO E
+ GETYP A,A
+ CAIE A,TCHSTR ; IS IT ONE WORD?
+ JRST WRONGT ;NO
+ CAILE E,6 ; SKIP IF L=? 6 CHARS
+ MOVEI E,6
+CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD
+ MOVE D,[440600,,A] ;AND BYTE POINTER TO IT
+NEXCHR: SOJL E,SIXDON
+ ILDB 0,B ; GET NEXT CHAR
+ CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR
+ JRST NEXCHR
+ JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED
+ PUSHJ P,A0TO6 ; CONVERT TO SIXBIT
+ IDPB 0,D ;DEPOSIT INTO SIX BIT
+ JRST NEXCHR ; NO, GET NEXT
+SIXDON: SUB TP,[2,,2] ;FIX UP TP
+ POP P,E
+ EXCH A,(P) ;LEAVE RESULT ON P-STACK
+ JRST (A) ;NOW RETURN
+
+
+;SUBROUTINE TO CONVERT SIXBIT TO ATOM
+
+6TOCHS: PUSH P,E
+ PUSH P,D
+ MOVEI B,0 ;MAX NUMBER OF CHARACTERS
+ PUSH P,[0] ;STRING WILL GO ON P SATCK
+ JUMPE A,GETATM ; EMPTY, LEAVE
+ MOVEI E,-1(P) ;WILL BE BYTE POINTER
+ HRLI E,10700 ;SET IT UP
+ PUSH P,[0] ;SECOND POSSIBLE WORD
+ MOVE D,[440600,,A] ;INPUT BYTE POINTER
+6LOOP: ILDB 0,D ;START CHAR GOBBLING
+ ADDI 0,40 ;CHANGET TOASCII
+ IDPB 0,E ;AND STORE IT
+ TLNN D,770000 ; SKIP IF NOT DONE
+ JRST 6LOOP1
+ TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT
+ AOJA B,GETATM ; YES, DONE
+ AOJA B,6LOOP ;KEEP LOOKING
+6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS
+ JRST .+2
+GETATM: MOVEM B,(P) ;SET STRING LENGTH=1
+ PUSHJ P,CHMAK ;MAKE A MUDDLE STRING
+ POP P,D
+ POP P,E
+ POPJ P,
+
+MSKS: 7777,,-1
+ 77,,-1
+ ,,-1
+ 7777
+ 77
+
+
+; CONVERT ONE CHAR
+
+A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A
+ CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z
+ JRST .+2 ;THEN
+ SUBI 0,40 ;CONVERT TO UPPER CASE
+ SUBI 0,40 ;NOW TO SIX BIT
+ JUMPL 0,BAD6 ;CHECK FOR A WINNER
+ CAILE 0,77
+ JRST BAD6
+ POPJ P,
+\f
+; SUBR TO TEST THE EXISTENCE OF FILES
+
+MFUNCTION FEXIST,SUBR,[FILE-EXISTS?]
+
+ ENTRY
+
+ JUMPGE AB,TFA
+ PUSH TP,$TPDL
+ PUSH TP,P ; SAVE P-STACK BASE
+ ADD TP,[2,,2]
+ MOVSI E,-4 ; 4 THINGS TO PUSH
+EXIST:
+IFN ITS, MOVE B,@RNMTBL(E)
+IFE ITS, MOVE B,@FETBL(E)
+ PUSH P,E
+ PUSHJ P,IDVAL1
+ POP P,E
+ GETYP 0,A
+ CAIE 0,TCHSTR ; SKIP IF WINS
+ JRST EXIST1
+
+IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT
+IFE ITS,[
+; PUSH P,E
+; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA
+; POP P,E
+ PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER
+ PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2
+ ]
+IFN ITS, JRST .+2
+IFE ITS, JRST .+3
+
+EXIST1:
+IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT
+IFE ITS,[
+ PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO
+ PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER
+ ]
+ AOBJN E,EXIST
+
+ PUSHJ P,RGPRS ; PARSE THE ARGS
+ JRST TMA ; TOO MANY ARGUMENTS
+
+IFN ITS,[
+ MOVE 0,-3(P) ; GET SIXBIT DEV NAME
+ MOVEI B,0
+ CAMN 0,[SIXBITS /DSK /]
+ MOVSI B,10 ; DONT SET REF DATE IF DISK DEV
+ .IOPUSH
+ DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]]
+ JRST .+3
+ .IOPOP
+ JRST FDLWON ; WON!!!
+ .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING
+ .IOPOP
+ JRST FDLST1]
+
+IFE ITS,[
+ MOVE B,TB
+ SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS
+ PUSHJ P,STSTK ; GET FILE NAME IN A STRING
+ HRROI B,1(E) ; POINT B TO THE STRING
+ MOVSI A,100001
+ GTJFN
+ JRST TDLLOS ; FILE DOES NOT EXIST
+ RLJFN ; FILE EXIST SO RETURN JFN
+ JFCL
+ JRST FDLWON ; SUCCESS
+ ]
+
+IFN ITS,[
+EXISTS: SIXBITS /DSK INPUT > /
+ ]
+IFE ITS,[
+FETBL: SETZ IMQUOTE NM1
+ SETZ IMQUOTE NM2
+ SETZ IMQUOTE DEV
+ SETZ IMQUOTE SNM
+
+FETYP: TCHSTR,,5
+ TCHSTR,,3
+ TCHSTR,,3
+ TCHSTR,,0
+
+FEVAL: 440700,,[ASCIZ /INPUT/]
+ 440700,,[ASCIZ /MUD/]
+ 440700,,[ASCIZ /DSK/]
+ 0
+ ]
+\f
+; SUBR TO DELETE AND RENAME FILES
+
+MFUNCTION RENAME,SUBR
+
+ ENTRY
+
+ JUMPGE AB,TFA
+ PUSH TP,$TPDL
+ PUSH TP,P ; SAVE P-STACK BASE
+ GETYP 0,(AB) ; GET 1ST ARG TYPE
+IFN ITS,[
+ CAIN 0,TCHAN ; CHANNEL?
+ JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING
+]
+IFE ITS,[
+ PUSH P,[100000,,-2]
+ PUSH P,[377777,,377777]
+]
+ MOVSI E,-4 ; 4 THINGS TO PUSH
+RNMALP: MOVE B,@RNMTBL(E)
+ PUSH P,E
+ PUSHJ P,IDVAL1
+ POP P,E
+ GETYP 0,A
+ CAIE 0,TCHSTR ; SKIP IF WINS
+ JRST RNMLP1
+
+IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT
+IFE ITS,[
+ PUSH P,E
+ PUSHJ P,ADDNUL
+ EXCH B,(P)
+ MOVE E,B
+]
+ JRST .+2
+
+RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT
+ AOBJN E,RNMALP
+
+IFN ITS,[
+ PUSHJ P,RGPRS ; PARSE THE ARGS
+ JRST RNM1 ; COULD BE A RENAME
+
+; HERE TO DELETE A FILE
+
+DELFIL: MOVE A,(P) ; AND GET SNAME
+ .SUSET [.SSNAM,,A]
+ DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]]
+ JRST FDLST ; ANALYSE ERROR
+
+FDLWON: MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST FINIS
+]
+IFE ITS,[
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,ADDNUL
+ MOVE A,(TP) ; GET BASE OF PDL
+ MOVEI A,1(A) ; POINT TO CRAP
+ CAMGE AB,[-3,,] ; SKIP IF DELETE
+ HLLZS (A) ; RESET DEFAULT
+ PUSH P,[0]
+ PUSH P,[0]
+ PUSH P,[0]
+ GTJFN ; GET A JFN
+ JRST TDLLOS ; LOST
+ ADD AB,[2,,2] ; PAST ARG
+ JUMPL AB,RNM1 ; GO TRY FOR RENAME
+ MOVE P,(TP) ; RESTORE P STACK
+ MOVEI C,(A) ; FOR RELEASE
+ DELF ; ATTEMPT DELETE
+ JRST DELLOS ; LOSER
+ RLJFN ; MAKE SURE FLUSHED
+ JFCL
+
+FDLWON: MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST FINIS
+
+RNMLOS: PUSH P,A
+ MOVEI A,(B)
+ RLJFN
+ JFCL
+DELLO1: MOVEI A,(C)
+ RLJFN
+ JFCL
+ POP P,A ; ERR NUMBER BACK
+TDLLOS: MOVEI B,0
+ PUSHJ P,TGFALS ; GET FALSE WITH REASON
+ JRST FINIS
+
+DELLOS: PUSH P,A ; SAVE ERROR
+ JRST DELLO1
+]
+
+;TABLE OF REANMAE DEFAULTS
+IFN ITS,[
+RNMTBL: IMQUOTE DEV
+ IMQUOTE NM1
+ IMQUOTE NM2
+ IMQUOTE SNM
+
+RNSTBL: SIXBIT /DSK _MUDS_> /
+]
+IFE ITS,[
+RNMTBL: SETZ IMQUOTE DEV
+ SETZ IMQUOTE SNM
+ SETZ IMQUOTE NM1
+ SETZ IMQUOTE NM2
+
+RNSTBL: -1,,[ASCIZ /DSK/]
+ 0
+ -1,,[ASCIZ /_MUDS_/]
+ -1,,[ASCIZ /MUD/]
+]
+; HERE TO DO A RENAME
+
+RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING
+ GETYP 0,(AB)
+ MOVE C,1(AB) ; GET ARG
+ CAIN 0,TATOM ; IS IT "TO"
+ CAME C,IMQUOTE TO
+ JRST WRONGT ; NO, LOSE
+ ADD AB,[2,,2] ; BUMP PAST "TO"
+ JUMPGE AB,TFA
+IFN ITS,[
+ MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE
+
+ MOVEI 0,4 ; FOUR DEFAULTS
+ PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT
+ SOJN 0,.-1
+
+ PUSHJ P,RGPRS ; PARSE THE NEXT STRING
+ JRST TMA
+
+ MOVE A,-7(P) ; FIX AND GET DEV1
+ MOVE B,-3(P) ; SAME FOR DEV2
+ CAME A,B ; SAME?
+ JRST DEVDIF
+
+ POP P,A ; GET SNAME 2
+ CAME A,(P)-3 ; SNAME 1
+ JRST DEVDIF
+ .SUSET [.SSNAM,,A]
+ POP P,-2(P) ; MOVE NAMES DOWN
+ POP P,-2(P)
+ DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)]
+ JRST FDLST
+ JRST FDLWON
+
+; HERE FOR RENAME WHILE OPEN FOR WRITING
+
+CHNRNM: ADD AB,[2,,2] ; NEXT ARG
+ JUMPGE AB,TFA
+ MOVE B,-1(AB) ; GET CHANNEL
+ SKIPN CHANNO(B) ; SKIP IF OPEN
+ JRST BADCHN
+ MOVE A,DIRECT-1(B) ; CHECK DIRECTION
+ MOVE B,DIRECT(B)
+ PUSHJ P,STRTO6 ; TO 6 BIT
+ POP P,A
+ CAME A,[SIXBIT /PRINT/]
+ CAMN A,[SIXBIT /PRINTB/]
+ JRST CHNRN1
+ CAMN A,[SIXBIT /PRINAO/]
+ JRST CHNRM1
+ CAME A,[SIXBIT /PRINTO/]
+ JRST WRONGD
+
+; SET UP .FDELE BLOCK
+
+CHNRN1: PUSH P,[0]
+ PUSH P,[0]
+ MOVEM P,T.SPDL+1(TB)
+ PUSH P,[0]
+ PUSH P,[SIXBIT /_MUDL_/]
+ PUSH P,[SIXBIT />/]
+ PUSH P,[0]
+
+ PUSHJ P,RGPRS ; PARSE THESE
+ JRST TMA
+
+ SUB P,[1,,1] ; SNAME/DEV IGNORED
+ MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER
+ MOVE B,1(AB)
+ MOVE A,CHANNO(B) ; ITS CHANNEL #
+ DOTCAL RENMWO,[A,[17,,-1],(P)]
+ JRST FDLST
+ MOVE A,CHANNO(B) ; ITS CHANNEL #
+ DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]]
+ JFCL
+ MOVE A,-3(P) ; UPDATE CHANNEL
+ PUSHJ P,6TOCHS ; GET A STRING
+ MOVE C,1(AB)
+ MOVEM A,RNAME1-1(C)
+ MOVEM B,RNAME1(C)
+ MOVE A,-2(P)
+ PUSHJ P,6TOCHS
+ MOVE C,1(AB)
+ MOVEM A,RNAME2-1(C)
+ MOVEM B,RNAME2(C)
+ MOVE B,1(AB)
+ MOVSI A,TCHAN\b
+ JRST FINIS
+]
+IFE ITS,[
+ PUSH P,A
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,ADDNUL
+ MOVE A,(TP) ; PBASE BACK
+ PUSH A,[400000,,0]
+ MOVEI A,(A)
+ GTJFN
+ JRST TDLLOS
+ POP P,B
+ EXCH A,B
+ MOVEI C,(A) ; FOR RELEASE ATTEMPT
+ RNAMF
+ JRST RNMLOS
+ MOVEI A,(B)
+ RLJFN ; FLUSH JFN
+ JFCL
+ MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED
+ RLJFN
+ JFCL
+ JRST FDLWON
+
+
+ADDNUL: PUSH TP,A
+ PUSH TP,B
+ MOVEI A,(A) ; LNTH OF STRING
+ IDIVI A,5
+ JUMPN B,NONUAD ; DONT NEED TO ADD ONE
+
+ PUSH TP,$TCHRS
+ PUSH TP,[0]
+ MOVEI A,2
+ PUSHJ P,CISTNG ; COPY OF STRING
+ POPJ P,
+
+NONUAD: POP TP,B
+ POP TP,A
+ POPJ P,
+]
+; HERE FOR LOSING .FDELE
+
+IFN ITS,[
+FDLST: .STATUS 0,A ; GET STATUS
+FDLST1: MOVEI B,0
+ PUSHJ P,GFALS ; ANALYZE IT
+ JRST FINIS
+]
+
+; SOME .FDELE ERRORS
+
+DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS
+
+\f; HERE TO RESET A READ CHANNEL
+
+MFUNCTION FRESET,SUBR,RESET
+
+ ENTRY 1
+ GETYP A,(AB)
+ CAIE A,TCHAN
+ JRST WTYP1
+ MOVE B,1(AB) ;GET CHANNEL
+ SKIPN IOINS(B) ; OPEN?
+ JRST REOPE1 ; NO, IGNORE CHECKS
+IFN ITS,[
+ MOVE A,STATUS(B) ;GET STATUS
+ ANDI A,77
+ JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE?
+ CAILE A,2 ;SKIPS IF TTY FLAVOR
+ JRST REOPEN
+]
+IFE ITS,[
+ MOVE A,CHANNO(B)
+ CAIE A,100 ; TTY-IN
+ CAIN A,101 ; TTY-OUT
+ JRST .+2
+ JRST REOPEN
+]
+ CAME B,TTICHN+1
+ CAMN B,TTOCHN+1
+ JRST REATTY
+REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION
+ PUSHJ P,CHRWRD ;CONVERT TO A WORD
+ JFCL
+ CAME B,[ASCII /READ/]
+ JRST TTYOPN
+ MOVE B,1(AB) ;RESTORE CHANNEL
+ PUSHJ P,RRESET" ;DO REAL RESET
+ JRST TTYOPN
+
+REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT
+ PUSH TP,(AB)+1
+ MCALL 1,FCLOSE
+ MOVE B,1(AB) ;RESTORE CHANNEL
+
+; SET UP TEMPS FOR OPNCH
+
+REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE
+ PUSH TP,$TPDL
+ PUSH TP,P
+ IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS]
+ PUSH TP,A-1(B)
+ PUSH TP,A(B)
+ TERMIN
+
+ PUSH TP,$TCHAN
+ PUSH TP,1(AB)
+
+ MOVE A,T.DIR(TB)
+ MOVE B,T.DIR+1(TB) ; GET DIRECTION
+ PUSHJ P,CHMOD ; CHECK THE MODE
+ MOVEM A,(P) ; AND STORE IT
+
+; NOW SET UP OPEN BLOCK IN SIXBIT
+
+IFN ITS,[
+ MOVSI E,-4 ; AOBN PNTR
+FRESE2: MOVE B,T.CHAN+1(TB)
+ MOVEI A,@RDTBL(E) ; GET ITEM POINTER
+ GETYP 0,-1(A) ; GET ITS TYPE
+ CAIE 0,TCHSTR
+ JRST FRESE1
+ MOVE B,(A) ; GET STRING
+ MOVE A,-1(A)
+ PUSHJ P,STRTO6
+FRESE3: AOBJN E,FRESE2
+]
+IFE ITS,[
+ MOVE B,T.CHAN+1(TB)
+ MOVE A,RDEVIC-1(B)
+ MOVE B,RDEVIC(B)
+ PUSHJ P,STRTO6 ; RESULT ON STACK
+ HLRZS (P)
+]
+
+ PUSH P,[0] ; PUSH UP SOME DUMMIES
+ PUSH P,[0]
+ PUSH P,[0]
+ PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN
+ GETYP 0,A
+ CAIE 0,TCHAN
+ JRST FINIS ; LEAVE IF FALSE OR WHATEVER
+
+DRESET: MOVE A,(AB)
+ MOVE B,1(AB)
+ SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS
+ SETZM LINPOS(B)
+ SETZM ACCESS(B)
+ JRST FINIS
+
+TTYOPN:
+IFN ITS,[
+ MOVE B,1(AB)
+ CAME B,TTOCHN+1
+ CAMN B,TTICHN+1
+ PUSHJ P,TTYOP2
+ PUSHJ P,DOSTAT
+ DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]]
+ .LOSE %LSSYS
+ MOVEM C,PAGLN(B)
+ MOVEM D,LINLN(B)
+]
+ JRST DRESET
+
+IFN ITS,[
+FRESE1: CAIE 0,TFIX
+ JRST BADCHN
+ PUSH P,(A)
+ JRST FRESE3
+]
+
+; INTERFACE TO REOPEN CLOSED CHANNELS
+
+OPNCHN: PUSH TP,$TCHAN
+ PUSH TP,B
+ MCALL 1,FRESET
+ POPJ P,
+
+REATTY: PUSHJ P,TTYOP2
+IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON
+ SKIPE NOTTY
+ JRST DRESET
+ MOVE B,1(AB)
+ JRST REATT1
+\f
+; FUNCTION TO LIST ALL CHANNELS
+
+MFUNCTION CHANLIST,SUBR
+
+ ENTRY 0
+
+ MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS
+ MOVEI C,0
+ MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL
+
+CHNLP: SKIPN 1(B) ;OPEN?
+ JRST NXTCHN ;NO, SKIP
+ HRRE E,(B) ; ABOUT TO FLUSH?
+ JUMPL E,NXTCHN ; YES, FORGET IT
+ MOVE D,1(B) ; GET CHANNEL
+ HRRZ E,CHANNO-1(D) ; GET REF COUNT
+ PUSH TP,(B)
+ PUSH TP,1(B)
+ ADDI C,1 ;COUNT WINNERS
+ SOJGE E,.-3 ; COUNT THEM
+NXTCHN: ADDI B,2
+ SOJN A,CHNLP
+
+ SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS
+ JRST MAKLST
+CHNLS: PUSH TP,(B)
+ PUSH TP,(B)+1
+ ADDI C,1
+ HRRZ B,(B)
+ JUMPN B,CHNLS
+
+MAKLST: ACALL C,LIST
+ JRST FINIS
+
+\f; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE
+
+
+REOPN: PUSH TP,$TCHAN
+ PUSH TP,B
+ SKIPN CHANNO(B) ; ONLY REAL CHANNELS
+ JRST PSUEDO
+
+IFN ITS,[
+ MOVSI E,-4 ; SET UP POINTER FOR NAMES
+
+GETOPB: MOVE B,(TP) ; GET CHANNEL
+ MOVEI A,@RDTBL(E) ; GET POINTER
+ MOVE B,(A) ; NOW STRING
+ MOVE A,-1(A)
+ PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK
+ AOBJN E,GETOPB
+]
+IFE ITS,[
+ MOVE A,RDEVIC-1(B)
+ MOVE B,RDEVIC(B)
+ PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT
+]
+ MOVE B,(TP) ; RESTORE CHANNEL
+ MOVE A,DIRECT-1(B)
+ MOVE B,DIRECT(B)
+ PUSHJ P,CHMOD ; CHECK FOR A VALID MODE
+
+IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE
+IFE ITS, HLRZS E,(P)
+ MOVE B,(TP) ; RESTORE CHANNEL
+IFN ITS, CAMN E,[SIXBIT /DSK /]
+IFE ITS,[
+ CAIE E,(SIXBIT /PS /)
+ CAIN E,(SIXBIT /DSK/)
+ JRST DISKH ; DISK WINS IMMEIDATELY
+ CAIE E,(SIXBIT /SS /)
+ CAIN E,(SIXBIT /SRC/)
+ JRST DISKH ; DISK WINS IMMEIDATELY
+]
+IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY
+IFE ITS, CAIN E,(SIXBIT /TTY/)
+ JRST REOPD1
+IFN ITS,[
+ AND E,[777700,,0] ; COULD BE "UTn"
+ MOVE D,CHANNO(B) ; GET CHANNEL
+ ASH D,1
+ ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN
+ SETZM 1(D)
+ SETZM CHANNO(B)
+ CAMN E,[SIXBIT /UT /]
+ JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES
+ CAMN E,[SIXBIT /AI /]
+ JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS
+ CAMN E,[SIXBIT /ML /]
+ JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS
+ CAMN E,[SIXBIT /DM /]
+ JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS
+]
+ PUSH TP,$TCHAN ; TRY TO RESET IT
+ PUSH TP,B
+ MCALL 1,FRESET
+
+IFN ITS,[
+REOPD1: AOS -4(P)
+REOPD: SUB P,[4,,4]
+]
+IFE ITS,[
+REOPD1: AOS -1(P)
+REOPD: SUB P,[1,,1]
+]
+REOPD0: SUB TP,[2,,2]
+ POPJ P,
+
+IFN ITS,[
+DISKH: MOVE C,(P) ; SNAME
+ .SUSET [.SSNAM,,C]
+]
+IFE ITS,[
+DISKH: MOVEM A,(P) ; SAVE MODE WORD
+ PUSHJ P,STSTK ; STRING TO STACK
+ MOVE A,(E) ; RESTORE MODE WORD
+ PUSH TP,$TPDL
+ PUSH TP,E ; SAVE PDL BASE
+ MOVE B,-2(TP) ; CHANNEL BACK TO B
+]
+ MOVE C,ACCESS(B) ; GET CHANNELS ACCESS
+ TRNN A,2 ; SKIP IF NOT ASCII CHANNEL
+ JRST DISKH1
+ HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT
+ IMULI C,5 ; TO CHAR ACCESS
+ JUMPE D,DISKH1 ; NO SWEAT
+ ADDI C,(D)
+ SUBI C,5
+DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER
+ JUMPE D,DISKH2
+ TRNN A,1 ; SKIP IF OUTPUT CHANNEL
+ JRST DISKH2
+ PUSH P,A
+ PUSH P,C
+ MOVEI C,BUFSTR-1(B)
+ PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER
+ HLRZ D,(A) ; LENGTH + 2 TO D
+ SUBI D,2
+ IMULI D,5 ; TO CHARS
+ SUB D,BUFSTR-1(B)
+ POP P,C
+ POP P,A
+DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS
+ IDIVI C,5 ; BACK TO WORD ACCESS
+IFN ITS,[
+ IORI A,6 ; BLOCK IMAGE
+ TRNE A,1
+ IORI A,100000 ; WRITE OVER BIT
+ PUSHJ P,DOOPN
+ JRST REOPD
+ MOVE A,C ; ACCESS TO A
+ PUSHJ P,GETFLN ; CHECK LENGTH
+ CAIGE 0,(A) ; CHECK BOUNDS
+ JRST .+3 ; COMPLAIN
+ PUSHJ P,DOACCS ; AND ACESS
+ JRST REOPD1 ; SUCCESS
+
+ MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL
+ PUSHJ P,MCLOSE
+ JRST REOPD
+
+DOACCS: PUSH P,A
+ HRRZ A,CHANNO(B)
+ DOTCAL ACCESS,[A,(P)]
+ JFCL
+ POP P,A
+ POPJ P,
+
+DOIOTO:
+DOIOTI:
+DOIOT:
+ PUSH P,0
+ MOVSI 0,TCHAN
+ MOVE PVP,PVSTOR+1
+ MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT
+ ENABLE
+ HRRZ 0,CHANNO(B)
+ DOTCAL IOT,[0,A]
+ JFCL
+ DISABLE
+ MOVE PVP,PVSTOR+1
+ SETZM BSTO(PVP)
+ POP P,0
+ POPJ P,
+
+GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL
+ .CALL FILBLK ; READ LNTH
+ .VALUE
+ POPJ P,
+
+FILBLK: SETZ
+ SIXBIT /FILLEN/
+ 0
+ 402000,,0 ; STUFF RESULT IN 0
+]
+IFE ITS,[
+ MOVEI A,CHNL0
+ ADD A,CHANNO(B)
+ ADD A,CHANNO(B)
+ SETZM 1(A) ; MAY GET A DIFFERENT JFN
+ HRROI B,1(E) ; TENEX STRING POINTER
+ MOVSI A,400001 ; MAKE SURE
+ GTJFN ; GO GET IT
+ JRST RGTJL ; COMPLAIN
+ MOVE D,-2(TP)
+ HRRZM A,CHANNO(D) ; COULD HAVE CHANGED
+ MOVE P,(TP) ; RESTORE P
+ MOVEI B,CHNL0
+ ASH A,1 ; MUNG ITS SLOT
+ ADDI A,(B)
+ MOVEM D,1(A)
+ HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT
+ MOVE A,(P) ; MODE WORD BACK
+ MOVE B,[440000,,200000] ; FLAG BITS
+ TRNE A,1 ; SKIP FOR INPUT
+ TRC B,300000 ; CHANGE TO WRITE
+ MOVE A,CHANNO(D) ; GET JFN
+ OPENF
+ JRST ROPFLS
+ MOVE E,C ; LENGTH TO E
+ SIZEF ; GET CURRENT LENGTH
+ JRST ROPFLS
+ CAMGE B,E ; STILL A WINNER
+ JRST ROPFLS
+ MOVE A,CHANNO(D) ; JFN
+ MOVE B,C
+ SFPTR
+ JRST ROPFLS
+ SUB TP,[2,,2] ; FLUSH PDL POINTER
+ JRST REOPD1
+
+ROPFLS: MOVE A,-2(TP)
+ MOVE A,CHANNO(A)
+ CLOSF ; ATTEMPT TO CLOSE
+ JFCL ; IGNORE FAILURE
+ SKIPA
+
+RGTJL: MOVE P,(TP)
+ SUB TP,[2,,2]
+ JRST REOPD
+
+DOACCS: PUSH P,B
+ EXCH A,B
+ MOVE A,CHANNO(A)
+ SFPTR
+ JRST ACCFAI
+ POP P,B
+ POPJ P,
+]
+PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW
+ MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS
+ PUSHJ P,CHRWRD
+ JFCL
+ JRST REOPD0 ; NO, RETURN HAPPY
+IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ?
+ CAMN B,[ASCII /DIS/]
+ SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE
+ JRST REOPD0 ; NO, RETURN HAPPY
+ PUSHJ P,DISROP
+ SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS
+ JRST REOPD0]
+
+\f;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL
+
+MFUNCTION FCLOSE,SUBR,[CLOSE]
+
+ ENTRY 1 ;ONLY ONE ARG
+ GETYP A,(AB) ;CHECK ARGS
+ CAIE A,TCHAN ;IS IT A CHANNEL
+ JRST WTYP1
+ MOVE B,1(AB) ;PICK UP THE CHANNEL
+ HRRZ A,CHANNO-1(B) ; GET REF COUNT
+ SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE
+ CAME B,TTICHN+1 ; CHECK FOR TTY
+ CAMN B,TTOCHN+1
+ JRST CLSTTY
+ MOVE A,[JRST CHNCLS]
+ MOVEM A,IOINS(B) ;CLOBBER THE IO INS
+ MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE
+ MOVE B,RDEVIC(B)
+ PUSHJ P,STRTO6
+IFN ITS, MOVE A,(P)
+IFE ITS, HLRZS A,(P)
+ MOVE B,1(AB) ; RESTORE CHANNEL
+IFN 0,[
+ CAME A,[SIXBIT /E&S /]
+ CAMN A,[SIXBIT /DIS /]
+ PUSHJ P,DISCLS]
+ MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS
+ SKIPN A,CHANNO(B) ;ANY REAL CHANNEL?
+ JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL
+
+ MOVE A,DIRECT-1(B) ; POINT TO DIRECTION
+ MOVE B,DIRECT(B)
+ PUSHJ P,STRTO6 ; CONVERT TO WORD
+ POP P,A
+IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME
+IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME
+ CAIE E,'T ; SKIP IF TTY
+ JRST CFIN4
+ CAME A,[SIXBIT /READ/] ; SKIP IF WINNER
+ JRST CFIN1
+IFN ITS,[
+ MOVE B,1(AB) ; IN ITS CHECK STATUS
+ LDB A,[600,,STATUS(B)]
+ CAILE A,2
+ JRST CFIN1
+]
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE CHAR
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ MCALL 2,OFF ; TURN OFF INTERRUPT
+CFIN1: MOVE B,1(AB)
+ MOVE A,CHANNO(B)
+IFN ITS,[
+ PUSHJ P,MCLOSE
+]
+IFE ITS,[
+ TLZ A,400000 ; FOR JFN RELEASE
+ CLOSF ; CLOSE THE FILE AND RELEASE THE JFN
+ JFCL
+ MOVE A,CHANNO(B)
+]
+CFIN: LSH A,1
+ ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT
+ SETZM CHANNO(B)
+ SETZM (A) ;AND CLOBBER IT
+ HLLZS BUFSTR-1(B)
+ SETZM BUFSTR(B)
+ HLLZS ACCESS-1(B)
+CFIN2: HLLZS -2(B)
+ MOVSI A,TCHAN ;RETURN THE CHANNEL
+ JRST FINIS
+
+CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL
+
+
+REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST
+REMOV0: SKIPN C,D ;FOUND ON LIST ?
+ JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL
+ HRRZ D,(C) ;GET POINTER TO NEXT
+ CAME B,(D)+1 ;FOUND ?
+ JRST REMOV0
+ HRRZ D,(D) ;YES, SPLICE IT OUT
+ HRRM D,(C)
+ JRST CFIN2
+
+
+; CLOSE UP ANY LEFTOVER BUFFERS
+
+CFIN4:
+; CAME A,[SIXBIT /PRINTO/]
+; CAMN A,[SIXBIT /PRINTB/]
+; JRST .+3
+; CAME A,[SIXBIT /PRINT/]
+; JRST CFIN1
+ MOVE B,1(AB) ; GET CHANNEL
+ HRRZ A,-2(B) ;GET MODE BITS
+ TRNN A,C.PRIN
+ JRST CFIN1
+ GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER
+ SKIPN BUFSTR(B)
+ JRST CFIN1
+ CAIE 0,TCHSTR
+ JRST CFINX1
+ PUSHJ P,BFCLOS
+IFE ITS,[
+ MOVE A,CHANNO(B)
+ MOVEI B,7
+ SFBSZ
+ JFCL
+ CLOSF
+ JFCL
+]
+ HLLZS BUFSTR-1(B)
+ SETZM BUFSTR(B)
+CFINX1: HLLZS ACCESS-1(B)
+ JRST CFIN1
+
+CFIN5: HRRM A,CHANNO-1(B)
+ JRST CFIN2
+\f;SUBR TO DO .ACCESS ON A READ CHANNEL
+;FORM: <ACCESS CHANNEL FIX-NUMBER>
+;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER
+;H. BRODIE 7/26/72
+
+MFUNCTION MACCESS,SUBR,[ACCESS]
+ ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER
+
+;CHECK ARGUMENT TYPES
+ GETYP A,(AB)
+ CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL
+ JRST WTYP1
+ GETYP A,2(AB) ;TYPE OF SECOND
+ CAIE A,TFIX ;SHOULD BE FIX
+ JRST WTYP2
+
+;CHECK DIRECTION OF CHANNEL
+ MOVE B,1(AB) ;B GETS PNTR TO CHANNEL
+; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL
+; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG
+; JFCL
+; CAME B,[<ASCII /PRINT/>+1]
+ HRRZ A,-2(B) ; GET MODE BITS
+ TRNN A,C.PRIN
+ JRST MACCA
+ MOVE B,1(AB)
+ SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER
+ PUSHJ P,BFCLOS
+ JRST MACC
+MACCA:
+; CAMN B,[ASCIZ /READ/]
+; JRST .+4
+; CAME B,[ASCIZ /READB/] ; READB CHANNEL?
+; JRST WRONGD
+; AOS (P) ; SET INDICATOR FOR BINARY MODE
+
+;CHECK THAT THE CHANNEL IS OPEN
+MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL
+ HRRZ E,-2(B)
+ TRNN E,C.OPN
+ JRST CHNCLS ;IF CHNL CLOSED => ERROR
+
+;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN
+;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER
+ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN
+ ERRUUO EQUOTE NEGATIVE-ARGUMENT
+MACC1: MOVEI D,0
+ TRNN E,C.BIN ; SKIP FOR BINARY FILE
+ IDIVI C,5
+
+;SETUP THE .ACCESS
+ TRNN E,C.PRIN
+ JRST NLSTCH
+ HRRZ 0,LSTCH-1(B)
+ MOVE A,ACCESS(B)
+ TRNN E,C.BIN
+ JRST LSTCH1
+ IMULI A,5
+ ADD A,ACCESS-1(B)
+ ANDI A,-1
+LSTCH1: CAIG 0,(A)
+ MOVE 0,A
+ MOVE A,C
+ IMULI A,5
+ ADDI A,(D)
+ CAML A,0
+ MOVE 0,A
+ HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST"
+NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER
+IFN ITS,[
+ DOTCAL ACCESS,[A,C]
+ .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
+]
+
+IFE ITS,[
+ MOVE B,C
+ SFPTR ; DO IT IN TENEX
+ JRST ACCFAI
+ MOVE B,1(AB) ; RESTORE CHANNEL
+]
+; POP P,E ; CHECK FOR READB MODE
+ TRNN E,C.READ
+ JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT
+ SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH
+ JRST .+3
+ SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR
+ JRST DONADV
+
+;NOW FORCE GETCHR TO DO A .IOT FIRST THING
+ MOVEI C,BUFSTR-1(B) ; FIND END OF STRING
+ PUSHJ P,BYTDOP"
+ SUBI A,2 ; LAST REAL WORD
+ HRLI A,010700
+ MOVEM A,BUFSTR(B)
+ HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT
+ SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER
+
+;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS
+ JUMPLE D,DONADV
+ADVPTR: PUSHJ P,GETCHR
+ MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED
+ SOJG D,ADVPTR
+
+DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL
+ HLLZS ACCESS-1(B)
+ MOVEM C,ACCESS(B)
+ MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL"
+ JRST FINIS ;DONE...B CONTAINS CHANNEL
+
+IFE ITS,[
+ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE
+]
+ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER?
+ JRST ACCOU1
+ HRRZ F,BUFSTR-1(B)
+ ADD F,[-BUFLNT*5-4]
+ IDIVI F,5
+ ADD F,BUFSTR(B)
+ HRLI F,010700
+ MOVEM F,BUFSTR(B)
+ MOVEI F,BUFLNT*5
+ HRRM F,BUFSTR-1(B)
+ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS
+ JRST DONADV
+
+ JUMPE D,DONADV ; THIS CASE OK
+IFE ITS,[
+ MOVE A,CHANNO(B) ; GET LAST WORD
+ RFPTR
+ JFCL
+ PUSH P,B
+ MOVNI C,1
+ MOVE B,[444400,,E] ; READ THE WORD
+ SIN
+ JUMPL C,ACCFAI
+ POP P,B
+ SFPTR
+ JFCL
+ MOVE B,1(AB) ; CHANNEL BACK
+ MOVE C,[440700,,E]
+ ILDB 0,C
+ IDPB 0,BUFSTR(B)
+ SOS BUFSTR-1(B)
+ SOJG D,.-3
+ JRST DONADV
+]
+IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS
+
+
+;WRONG TYPE OF DEVICE ERROR
+WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE
+\f
+; BINARY READ AND PRINT ROUTINES
+
+MFUNCTION PRINTB,SUBR
+
+ ENTRY
+
+PBFL: PUSH P,. ; PUSH NON-ZERONESS
+ MOVEI A,-7
+ JRST BINI1
+
+MFUNCTION READB,SUBR
+
+ ENTRY
+
+ PUSH P,[0]
+ MOVEI A,-11
+BINI1: HLRZ 0,AB
+ CAILE 0,-3
+ JRST TFA
+ CAIG 0,(A)
+ JRST TMA
+
+ GETYP 0,(AB) ; SHOULD BE UVEC OR STORE
+ CAIE 0,TSTORAGE
+ CAIN 0,TUVEC
+ JRST BINI2
+ CAIE 0,TCHSTR
+ CAIN 0,TBYTE
+ JRST BYTOK
+ JRST WTYP1 ; ELSE LOSE
+BINI2: MOVE B,1(AB) ; GET IT
+ HLRE C,B
+ SUBI B,(C) ; POINT TO DOPE
+ GETYP A,(B)
+ PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE
+ CAIE A,S1WORD
+ JRST WTYP1
+BYTOK: GETYP 0,2(AB)
+ CAIE 0,TCHAN ; BETTER BE A CHANNEL
+ JRST WTYP2
+ MOVE B,3(AB) ; GET IT
+; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF
+; PUSHJ P,CHRWRD ; INTO 1 WORD
+; JFCL
+; MOVNI E,1
+; CAMN B,[ASCII /READB/]
+; MOVEI E,0
+; CAMN B,[<ASCII /PRINT/>+1]
+ HRRZ A,-2(B) ; MODE BITS
+ TRNN A,C.BIN ; IF NOT BINARY
+ JRST WRONGD
+ MOVEI E,0
+ TRNE A,C.PRIN
+ MOVE E,PBFL
+; JUMPL E,WRONGD ; LOSER
+ CAME E,(P) ; CHECK WINNGE
+ JRST WRONGD
+ MOVE B,3(AB) ; GET CHANNEL BACK
+ SKIPN A,IOINS(B) ; OPEN?
+ PUSHJ P,OPENIT ; LOSE
+ CAMN A,[JRST CHNCLS]
+ JRST CHNCLS ; LOSE, CLOSED
+ JUMPN E,BUFOU1 ; JUMP FOR OUTPUT
+ MOVEI C,0
+ CAML AB,[-5,,] ; SKIP IF EOF GIVEN
+ JRST BINI5
+ MOVE 0,4(AB)
+ MOVEM 0,EOFCND-1(B)
+ MOVE 0,5(AB)
+ MOVEM 0,EOFCND(B)
+ CAML AB,[-7,,]
+ JRST BINI5
+ GETYP 0,6(AB)
+ CAIE 0,TFIX
+ JRST WTYP
+ MOVE C,7(AB)
+BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT
+ JRST BINEOF
+ GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE
+ CAIE 0,TCHSTR
+ CAIN 0,TBYTE
+ JRST BYTI
+ MOVE A,1(AB) ; GET VECTOR
+ PUSHJ P,PGBIOI ; READ IT
+ HLRE C,A ; GET COUNT DONE
+ HLRE D,1(AB) ; AND FULL COUNT
+ SUB C,D ; C=> TOTAL READ
+ ADDM C,ACCESS(B)
+ JUMPGE A,BINIOK ; NOT EOF YET
+ SETOM LSTCH(B)
+BINIOK: MOVE B,C
+ MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ
+ JRST FINIS
+
+BYTI:
+IFE ITS,[
+ MOVE A,1(B)
+ RFBSZ
+ FATAL RFBSZ-LOST
+ PUSH P,B
+ LDB B,[300600,,1(AB)]
+ SFBSZ
+ FATAL SFBSZ-LOST
+ MOVE B,3(AB)
+ HRRZ A,(AB) ; GET BYTE STRING LENGTH
+ MOVNS A
+ MOVSS A ; MAKE FUNNY BYTE POINTER
+ HRR A,1(AB)
+ ADDI A,1
+ PUSH P,C
+ HLL C,1(AB) ; GET START OF BPTR
+ MOVE D,[SIN]
+ PUSHJ P,PGBIOT
+ HLRE C,A ; GET COUNT DONE
+ POP P,D
+ SKIPN D
+ HRRZ D,(AB) ; AND FULL COUNT
+ ADD D,C ; C=> TOTAL READ
+ LDB E,[300600,,1(AB)]
+ MOVEI A,36.
+ IDIVM A,E
+ IDIVM D,E
+ ADDM E,ACCESS(B)
+ SKIPGE C ; NOT EOF YET
+ SETOM LSTCH(B)
+ MOVE A,1(B)
+ POP P,B
+ SFBSZ
+ FATAL SFBSZ-LOST
+ MOVE C,D
+ JRST BINIOK
+]
+BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND?
+ PUSHJ P,BFCLS1 ; GET RID OF SAME
+ MOVEI C,0
+ CAML AB,[-5,,]
+ JRST BINO5
+ GETYP 0,4(AB)
+ CAIE 0,TFIX
+ JRST WTYP
+ MOVE C,5(AB)
+BINO5: MOVE A,1(AB)
+ GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE
+ CAIE 0,TCHSTR
+ CAIN 0,TBYTE
+ JRST BYTO
+ PUSHJ P,PGBIOO
+ HLRE C,1(AB)
+ MOVNS C
+ ADDM C,ACCESS(B)
+BYTO1: MOVE A,(AB) ; RET VECTOR ETC.
+ MOVE B,1(AB)
+ JRST FINIS
+
+BYTO:
+IFE ITS,[
+ MOVE A,1(B)
+ RFBSZ
+ FATAL RFBSZ-FAILURE
+ PUSH P,B
+ LDB B,[300600,,1(AB)]
+ SFBSZ
+ FATAL SFBSZ-FAILURE
+ MOVE B,3(AB)
+ HRRZ A,(AB) ; GET BYTE SIZE
+ MOVNS A
+ MOVSS A ; MAKE FUNNY BYTE POINTER
+ HRR A,1(AB)
+ ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING
+ HLL C,1(AB) ; GET START OF BPTR
+ MOVE D,[SOUT]
+ PUSHJ P,PGBIOT
+ LDB D,[300600,,1(AB)]
+ MOVEI C,36.
+ IDIVM C,D
+ HRRZ C,(AB)
+ IDIVI C,(D)
+ ADDM C,ACCESS(B)
+ MOVE A,1(B)
+ POP P,B
+ SFBSZ
+ FATAL SFBSZ-FAILURE
+ JRST BYTO1
+]
+
+BINEOF: PUSH TP,EOFCND-1(B)
+ PUSH TP,EOFCND(B)
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MCALL 1,FCLOSE ; CLOSE THE LOSER
+ MCALL 1,EVAL
+ JRST FINIS
+
+OPENIT: PUSH P,E
+ PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER
+ JUMPE B,CHNCLS ;FAIL
+ POP P,E
+ POPJ P,
+\f; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE
+; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF
+; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS.
+
+R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY
+ PUSHJ P,RXCT
+ TLO A,200000 ; ^@ BUG
+ MOVEM A,LSTCH(B)
+ TLZ A,200000
+ JUMPL A,.+2 ; IN CASE OF -1 ON STY
+ TRZN A,400000 ; EXCL HACKER
+ JRST .+4
+ MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR
+ MOVEI A,"!
+ JRST .+2
+ SETZM LSTCH(B)
+ PUSH P,C
+ HRRZ C,DIRECT-1(B)
+ CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB
+ JRST R1CH1
+ AOS C,ACCESS-1(B)
+ CAMN C,[TFIX,,1]
+ AOS ACCESS(B) ; EVERY FIFTY INCREMENT
+ CAMN C,[TFIX,,5]
+ HLLZS ACCESS-1(B)
+ JRST .+2
+R1CH1: AOS ACCESS(B)
+ POP P,C
+ POPJ P,
+
+W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR
+ JRST .+3
+ SETOM CHRPOS(B)
+ AOSA LINPOS(B)
+ CAIE A,12 ; TEST FOR LF
+ AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION
+ CAIE A,14 ; TEST FOR FORM FEED
+ JRST .+3
+ SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION
+ SETZM LINPOS(B) ; AND LINE POSITION
+ CAIE A,11 ; IS THIS A TAB?
+ JRST .+6
+ MOVE C,CHRPOS(B)
+ ADDI C,7
+ IDIVI C,8.
+ IMULI C,8. ; FIX UP CHAR POS FOR TAB
+ MOVEM C,CHRPOS(B) ; AND SAVE
+ PUSH P,C
+ HRRZ C,-2(B) ; GET BITS
+ TRNN C,C.BIN ; SIX LONG MUST BE PRINTB
+ JRST W1CH1
+ AOS C,ACCESS-1(B)
+ CAMN C,[TFIX,,1]
+ AOS ACCESS(B)
+ CAMN C,[TFIX,,5]
+ HLLZS ACCESS-1(B)
+ JRST .+2
+W1CH1: AOS ACCESS(B)
+ PUSH P,A
+ PUSHJ P,WXCT
+ POP P,A
+ POP P,C
+ POPJ P,
+
+R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF
+; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT
+; PUSH TP,B
+; MOVEI B,DIRECT-1(B)
+; PUSHJ P,CHRWRD
+; JFCL
+; CAME B,[ASCIZ /READ/]
+; CAMN B,[ASCII /READB/]
+; JRST .+2
+; JRST BADCHN
+ HRRZ A,-2(B) ; GET MODE BITS
+ TRNN A,C.READ
+ JRST BADCHN
+ SKIPN IOINS(B) ; IS THE CHANNEL OPEN
+ PUSHJ P,OPENIT ; NO, GO DO IT
+ PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER
+ PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER
+ JRST MPOPJ ; THATS ALL FOLKS
+
+W1C: SUBM M,(P)
+ PUSHJ P,W1CI
+ JRST MPOPJ
+
+W1CI:
+; PUSH TP,$TCHAN
+; PUSH TP,B
+ PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR
+; MOVEI B,DIRECT-1(B)
+; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR
+; JFCL
+; CAME B,[ASCII /PRINT/]
+; CAMN B,[<ASCII /PRINT/>+1]
+; JRST .+2
+; JRST BADCHN
+; POP TP,B
+; POP TP,(TP)
+ HRRZ A,-2(B)
+ TRNN A,C.PRIN
+ JRST BADCHN
+ SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN
+ PUSHJ P,OPENIT
+ PUSHJ P,GWB
+ POP P,A ; GET THE CHAR TO DO
+ JRST W1CHAR
+
+; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT
+; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH.
+
+
+WXCT:
+RXCT: XCT IOINS(B) ; READ IT
+ SKIPN SCRPTO(B)
+ POPJ P,
+
+DOSCPT: PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH P,A ; AND SAVE THE CHAR AROUND
+
+ SKIPN SCRPTO(B) ; IF ZERO FORGET IT
+ JRST SCPTDN ; THATS ALL THERE IS TO IT
+ PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS
+ GETYP C,SCRPTO-1(B) ; IS IT A LIST
+ CAIE C,TLIST
+ JRST BADCHN
+ PUSH TP,$TLIST
+ PUSH TP,[0] ; SAVE A SLOT FOR THE LIST
+ MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS
+SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN
+ CAIE B,TCHAN
+ JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN
+ HRRZ B,(C) ; GET THE REST OF THE LIST IN B
+ MOVEM B,(TP) ; AND STORE ON STACK
+ MOVE B,1(C) ; GET THE CHANNEL IN B
+ MOVE A,-1(P) ; AND THE CHARACTER IN A
+ PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES
+ SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS
+ JRST SCPT1 ; AND CYCLE THROUGH
+ SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS
+ POP P,C ; AND RESTORE ACCUMULATOR C
+SCPTDN: POP P,A ; RESTORE THE CHARACTER
+ POP TP,B ; AND THE ORIGINAL CHANNEL
+ POP TP,(TP)
+ POPJ P, ; AND THATS ALL
+
+
+; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT
+; ON THE INPUT CHANNEL
+; CALL IS <FILECOPY IN OUT> WHERE DEFAULTS ARE INCHAN AND OUTCHAN
+
+ MFUNCTION FCOPY,SUBR,[FILECOPY]
+
+ ENTRY
+ HLRE 0,AB
+ CAMGE 0,[-4]
+ JRST WNA ; TAKES FROM 0 TO 2 ARGS
+
+ JUMPE 0,.+4 ; NO FIRST ARG?
+ PUSH TP,(AB)
+ PUSH TP,1(AB) ; SAVE IN CHAN
+ JRST .+6
+ MOVE A,$TATOM
+ MOVE B,IMQUOTE INCHAN
+ PUSHJ P,IDVAL
+ PUSH TP,A
+ PUSH TP,B
+ HLRE 0,AB ; CHECK FOR SECOND ARG
+ CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG?
+ JRST .+4
+ PUSH TP,2(AB) ; SAVE SECOND ARG
+ PUSH TP,3(AB)
+ JRST .+6
+ MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT
+ MOVE B,IMQUOTE OUTCHAN
+ PUSHJ P,IDVAL
+ PUSH TP,A
+ PUSH TP,B ; AND SAVE IT
+
+ MOVE A,-3(TP)
+ MOVE B,-2(TP) ; INPUT CHANNEL
+ MOVEI 0,C.READ ; INDICATE INPUT
+ PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL
+ MOVE A,-1(TP)
+ MOVE B,(TP) ; GET OUT CHAN
+ MOVEI 0,C.PRIN ; INDICATE OUT CHAN
+ PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN
+
+ PUSH P,[0] ; COUNT OF CHARS OUTPUT
+
+ MOVE B,-2(TP)
+ PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF
+ MOVE B,(TP)
+ PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF
+
+FCLOOP: INTGO
+ MOVE B,-2(TP)
+ PUSHJ P,R1CHAR ; GET A CHAR
+ JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF
+ MOVE B,(TP) ; GET OUT CHAN
+ PUSHJ P,W1CHAR ; SPIT IT OUT
+ AOS (P) ; INCREMENT COUNT
+ JRST FCLOOP
+
+FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN
+ MCALL 1,FCLOSE ; CLOSE INCHAN
+ MOVE A,$TFIX
+ POP P,B ; GET CHAR COUNT TO RETURN
+ JRST FINIS
+
+CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL
+ PUSH TP,A
+ PUSH TP,B
+ GETYP C,A
+ CAIE C,TCHAN
+ JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY
+; MOVEI B,DIRECT-1(B)
+; PUSHJ P,CHRWRD
+; JRST CHKBDC
+; MOVE C,(P) ; GET CHAN DIRECT
+ HRRZ C,-2(B) ; MODE BITS
+ TDNN C,0
+ JRST CHKBDC
+; CAMN B,CHKT(C)
+; JRST .+4
+; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO
+; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT
+; JRST CHKBDC
+ MOVE B,(TP)
+ SKIPN IOINS(B) ; MAKE SURE IT IS OPEN
+ PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT
+ SUB TP,[2,,2]
+ POP P, ; CLEAN UP STACKS
+ POPJ P,
+
+CHKT: ASCIZ /READ/
+ ASCII /PRINT/
+ ASCII /READB/
+ <ASCII /PRINT/>+1
+
+CHKBDC: POP P,E
+ MOVNI D,2
+ IMULI D,1(E)
+ HLRE 0,AB
+ CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT
+ JRST BADCHN
+ JUMPE E,WTYP1
+ JRST WTYP2
+
+\f; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB,
+; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT
+; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF
+; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING.
+
+; FORMAT IS <READSTRING .STRING .INCHANNEL .EOFCOND .MAXCHARS>
+; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN
+
+; FORMAT FOR PRINTSTRING IS <PRINTSTRING .STRING .OUTCHANNEL .MAXCHARS>
+
+; THESE WERE CODED 9/16/73 BY NEAL D. RYAN
+
+ MFUNCTION RSTRNG,SUBR,READSTRING
+
+ ENTRY
+ PUSH P,[0] ; FLAG TO INDICATE READING
+ HLRE 0,AB
+ CAMG 0,[-1]
+ CAMG 0,[-9]
+ JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS
+ JRST STRIO1
+
+ MFUNCTION PSTRNG,SUBR,PRINTSTRING
+
+ ENTRY
+ PUSH P,[1] ; FLAG TO INDICATE WRITING
+ HLRE 0,AB
+ CAMG 0,[-1]
+ CAMG 0,[-7]
+ JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS
+
+STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK
+ PUSH TP,[0]
+ GETYP 0,(AB)
+ CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING
+ JRST WTYP1
+ HRRZ 0,(AB) ; CHECK FOR EMPTY STRING
+ SKIPN (P)
+ JUMPE 0,MTSTRN
+ HLRE 0,AB
+ CAML 0,[-2] ; WAS A CHANNEL GIVEN
+ JRST STRIO2
+ GETYP 0,2(AB)
+ SKIPN (P) ; SKIP IF PRINT
+ JRST TESTIN
+ CAIN 0,TTP ; SEE IF FLATSIZE HACK
+ JRST STRIO9
+TESTIN: CAIE 0,TCHAN
+ JRST WTYP2 ; SECOND ARG NOT CHANNEL
+ MOVE B,3(AB)
+ HRRZ B,-2(B)
+ MOVNI E,1 ; CHECKING FOR GOOD DIRECTION
+ TRNE B,C.READ ; SKIP IF NOT READ
+ MOVEI E,0
+ TRNE B,C.PRIN ; SKIP IF NOT PRINT
+ MOVEI E,1
+ CAME E,(P)
+ JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE
+STRIO9: PUSH TP,2(AB)
+ PUSH TP,3(AB) ; PUSH ON CHANNEL
+ JRST STRIO3
+STRIO2: MOVE B,IMQUOTE INCHAN
+ MOVSI A,TCHAN
+ SKIPE (P)
+ MOVE B,IMQUOTE OUTCHAN
+ PUSHJ P,IDVAL
+ GETYP 0,A
+ SKIPN (P) ; SKIP IF PRINTSTRING
+ JRST TESTI2
+ CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK
+ JRST STRIO8
+TESTI2: CAIE 0,TCHAN
+ JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL
+STRIO8: PUSH TP,A
+ PUSH TP,B
+STRIO3: MOVE B,(TP) ; GET CHANNEL
+ SKIPN E,IOINS(B)
+ PUSHJ P,OPENIT ; IF NOT GO OPEN
+ MOVE E,IOINS(B)
+ CAMN E,[JRST CHNCLS]
+ JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED
+STRIO4: HLRE 0,AB
+ CAML 0,[-4]
+ JRST STRIO5 ; NO COUNT TO WORRY ABOUT
+ GETYP 0,4(AB)
+ MOVE E,4(AB)
+ MOVE C,5(AB)
+ CAIE 0,TCHSTR
+ CAIN 0,TFIX ; BETTER BE A FIXED NUMBER
+ JRST .+2
+ JRST WTYP3
+ HRRZ D,(AB) ; GET ACTUAL STRING LENGTH
+ CAIN 0,TFIX
+ JRST .+7
+ SKIPE (P) ; TEST FOR WRITING
+ JRST .-7 ; IF WRITING WE GOT TROUBLE
+ PUSH P,D ; ACTUAL STRING LENGTH
+ MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING
+ MOVEM C,1(TB)
+ JRST STRIO7
+ CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH
+ JRST .+2 ; WIN
+ ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE
+ PUSH P,C ; PUSH ON MAX COUNT
+ JRST STRIO7
+STRIO5:
+STRIO6: HRRZ C,(AB) ; GET CHAR COUNT
+ PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN
+STRIO7: HLRE 0,AB
+ CAML 0,[-6]
+ JRST .+6
+ MOVE B,(TP) ; GET THE CHANNEL
+ MOVE 0,6(AB)
+ MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN
+ MOVE 0,7(AB)
+ MOVEM 0,EOFCND(B)
+ PUSH TP,(AB) ; PUSH ON STRING
+ PUSH TP,1(AB)
+ PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE
+ MOVE 0,-2(P) ; GET READ OR WRITE FLAG
+ JUMPN 0,OUTLOP ; GO WRITE STUFF
+
+ MOVE B,-2(TP) ; GET CHANNEL
+ PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF
+ SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY
+ JRST SRDOEF ; GO DOES HIS EOF HACKING
+INLOP: INTGO
+ MOVE B,-2(TP) ; GET CHANNEL
+ MOVE C,-1(P) ; MAX COUNT
+ CAMG C,(P) ; COMPARE WITH COUNT DONE
+ JRST STREOF ; WE HAVE FINISHED
+ PUSHJ P,R1CHAR ; GET A CHAR
+ JUMPL A,INEOF ; EOF HIT
+ MOVE C,1(TB)
+ HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US?
+ SOJL E,INLNT ; GO FINISH STUFFING
+ ILDB D,C
+ CAME D,A
+ JRST .-3
+ JRST INEOF
+INLNT: IDPB A,(TP) ; STUFF IN STRING
+ SOS -1(TP) ; DECREMENT STRING COUNT
+ AOS (P) ; INCREMENT CHAR COUNT
+ JRST INLOP
+
+INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE
+ JRST .+3 ; YES
+ MOVEM A,LSTCH(B) ; NO SAVE THE CHAR
+ JRST .+3
+ ADDI C,400000
+ MOVEM C,LSTCH(B)
+ MOVSI C,200000
+ IORM C,LSTCH(B)
+ HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN
+ CAIN C,5 ; IS IT READB?
+ JRST .+3
+ SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL
+ JRST STREOF ; AND THATS IT
+ HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE
+ MOVEI D,5
+ SKIPG C
+ HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE
+ SOS C,ACCESS-1(B)
+ CAMN C,[TFIX,,0]
+ SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE
+ JRST STREOF
+
+SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT
+ AOJE A,INLOP ; SKIP OVER -1 ON PTY'S
+ SUB TP,[6,,6]
+ SUB P,[3,,3] ; POP JUNK OFF STACKS
+ PUSH TP,EOFCND-1(B)
+ PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL
+ MCALL 1,EVAL ; EVAL HIS EOF JUNK
+ JRST FINIS
+
+OUTLOP: MOVE B,-2(TP)
+OUTLP1: INTGO
+ MOVE A,-3(TP) ; GET CHANNEL
+ MOVE B,-2(TP)
+ MOVE C,-1(P) ; MAX COUNT TO DO
+ CAMG C,(P) ; HAVE WE DONE ENOUGH
+ JRST STREOF
+ ILDB D,(TP) ; GET THE CHAR
+ SOS -1(TP) ; SUBTRACT FROM STRING LENGTH
+ AOS (P) ; INC COUNT OF CHARS DONE
+ PUSHJ P,CPCH1 ; GO STUFF CHAR
+ JRST OUTLP1
+
+STREOF: MOVE A,$TFIX
+ POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE
+ SUB P,[2,,2]
+ SUB TP,[6,,6]
+ JRST FINIS
+
+
+GWB: SKIPE BUFSTR(B)
+ POPJ P,
+ PUSH TP,$TCHAN
+ PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN
+ MOVEI A,BUFLNT
+ PUSHJ P,IBLOCK
+ MOVSI A,TWORD+.VECT.
+ MOVEM A,BUFLNT(B)
+ SETOM (B)
+ MOVEI C,1(B)
+ HRLI C,(B)
+ BLT C,BUFLNT-1(B)
+ MOVEI C,-1(B)
+ HRLI C,010700
+ MOVE B,(TP)
+ MOVEI 0,C.BUF
+ IORM 0,-2(B)
+ MOVEM C,BUFSTR(B)
+ MOVE C,[TCHSTR,,BUFLNT*5]
+ MOVEM C,BUFSTR-1(B)
+ SUB TP,[2,,2]
+ POPJ P,
+
+
+GRB: SKIPE BUFSTR(B)
+ POPJ P,
+ PUSH TP,$TCHAN
+ PUSH TP,B ; GET US A READ BUFFER
+ MOVEI A,BUFLNT
+ PUSHJ P,IBLOCK
+ MOVEI C,BUFLNT-1(B)
+ POP TP,B
+ MOVEI 0,C.BUF
+ IORM 0,-2(B)
+ HRLI C,010700
+ MOVEM C,BUFSTR(B)
+ MOVSI C,TCHSTR
+ MOVEM C,BUFSTR-1(B)
+ SUB TP,[1,,1]
+ POPJ P,
+
+MTSTRN: ERRUUO EQUOTE EMPTY-STRING
+
+\f; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING
+; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO
+; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE.
+
+; H. BRODIE 7/19/72
+
+; CALLING SEQ:
+; PUSHJ P,GETCHR
+; B/ AOBJN PNTR TO CHANNEL VECTOR
+; RETURNS NEXT CHARACTER IN AC A.
+; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND
+; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS
+
+
+GETCHR:
+; FIRST GRAB THE BUFFER
+; GETYP A,BUFSTR-1(B) ; GET TYPE WORD
+; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER)
+; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN
+GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING
+ SOJGE A,GTGCHR ; JUMP IF STILL MORE
+
+; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS)
+; GENERATE AN .IOT POINTER
+;FIRST SAVE C AND D AS I WILL CLOBBER THEM
+NEWBUF: PUSH P,C
+ PUSH P,D
+IFN ITS,[
+ LDB C,[600,,STATUS(B)] ; GET TYPE
+ CAIG C,2 ; SKIP IF NOT TTY
+]
+IFE ITS,[
+ SKIPE BUFRIN(B)
+]
+ JRST GETTTY ; GET A TTY BUFFER
+
+ PUSHJ P,PGBUFI ; RE-FILL BUFFER
+
+IFE ITS, MOVEI C,-1
+ JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL
+ MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT
+ ANDCAM C,-1(A)
+ MOVSI C,014000 ; GET A ^C
+ MOVEM C,(A) ;FAKE AN EOF
+
+IFE ITS,[
+ HLRE C,A ; HOW MUCH LEFT
+ ADDI C,BUFLNT ; # OF WORDS TO C
+ IMULI C,5 ; TO CHARS
+ MOVE A,-2(B) ; GET BITS
+ TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL
+ JRST BUFGOO
+ MOVE A,CHANNO(B)
+ PUSH P,B
+ PUSH P,D
+ PUSH P,C
+ PUSH P,[0]
+ PUSH P,[0]
+ MOVEI C,-1(P)
+ MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE
+ GTFDB
+ LDB D,[300600,,-1(P)] ; GET BYTE SIZE
+ MOVE B,(P)
+ SUB P,[2,,2]
+ POP P,C
+ CAIE D,7 ; SEVEN BIT BYTES?
+ JRST BUFGO1 ; NO, DONT HACK
+ MOVE D,C
+ IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN
+ SKIPN C
+ MOVEI C,5
+ ADDI C,-5(D) ; FIXUP C FOR WINNAGE
+BUFGO1: POP P,D
+ POP P,B
+]
+; RESET THE BYTE POINTER IN THE CHANNEL.
+; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D
+BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH
+ SUBI D,1
+
+ MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT
+IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT
+ MOVEI A,BUFLNT*5-1
+BUFROK: POP P,D ;RESTORE D
+ POP P,C ;RESTORE C
+
+
+; HERE IF THERE ARE CHARS IN BUFFER
+GTGCHR: HRRM A,BUFSTR-1(B)
+ ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER
+
+IFN ITS,[
+ CAIE A,3 ; EOF?
+ POPJ P, ; AND RETURN
+ LDB A,[600,,STATUS(B)] ; CHECK FOR TTY
+ CAILE A,2 ; SKIP IF TTY
+]
+IFE ITS,[
+ PUSH P,0
+ HRRZ 0,LSTCH-1(B)
+ SOJL 0,.+4
+ HRRM 0,LSTCH-1(B)
+ POP P,0
+ POPJ P,
+
+ POP P,0
+ MOVSI A,-1
+ SKIPN BUFRIN(B)
+]
+ JRST .+3
+RETEO1: HRRI A,3
+ POPJ P,
+
+ HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON
+ HRRZ A,(A)
+ TRNN A,1
+ MOVSI A,-1
+ JRST RETEO1
+
+IFN ITS,[
+PGBUFO:
+PGBUFI:
+]
+IFE ITS,[
+PGBUFO: SKIPA D,[SOUT]
+PGBUFI: MOVE D,[SIN]
+]
+ SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT
+ SUBI A,1 ; FOR 440700 AND 010700 START
+ SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER
+ HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A
+ MOVSI C,004400
+IFN ITS,[
+PGBIOO:
+PGBIOI: MOVE D,A ; COPY FOR LATER
+ MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS
+ MOVE PVP,PVSTOR+1
+ MOVEM C,DSTO(PVP)
+ MOVEM C,ASTO(PVP)
+ MOVSI C,TCHAN
+ MOVEM C,BSTO(PVP)
+
+; BUILD .IOT INSTR
+ MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C
+ ROT C,23. ; MOVE INTO AC FIELD
+ IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT
+
+; DO THE .IOT
+ ENABLE ; ALLOW INTS
+ XCT C ; EXECUTE THE .IOT INSTR
+ DISABLE
+ MOVE PVP,PVSTOR+1
+ SETZM BSTO(PVP)
+ SETZM ASTO(PVP)
+ SETZM DSTO(PVP)
+ POPJ P,
+]
+
+IFE ITS,[
+PGBIOT: PUSH P,D
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH P,C
+ HRRZS (P)
+ HRRI C,-1(A) ; POINT TO BUFFER
+ HLRE D,A ; XTRA POINTER
+ MOVNS D
+ HRLI D,TCHSTR
+ MOVE PVP,PVSTOR+1
+ MOVEM D,BSTO(PVP)
+ MOVE D,[PUSHJ P,FIXACS]
+ MOVEM D,ONINT
+ MOVSI D,TUVEC
+ MOVEM D,DSTO(PVP)
+ MOVE D,A
+ MOVE A,CHANNO(B) ; FILE JFN
+ MOVE B,C
+ HLRE C,D ; - COUNT TO C
+ SKIPE (P)
+ MOVN C,(P) ; REAL DESIRED COUNT
+ SUB P,[1,,1]
+ ENABLE
+ XCT (P) ; DO IT TO IT
+ DISABLE
+ MOVE PVP,PVSTOR+1
+ SETZM BSTO(PVP)
+ SETZM DSTO(PVP)
+ SETZM ONINT
+ MOVEI A,1(B)
+ MOVE B,(TP)
+ SUB TP,[2,,2]
+ SUB P,[1,,1]
+ JUMPGE C,CPOPJ ; NO EOF YET
+ HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR
+ POPJ P,
+
+FIXACS: PUSH P,PVP
+ MOVE PVP,PVSTOR+1
+ MOVNS C
+ HRRM C,BSTO(PVP)
+ MOVNS C
+ POP P,PVP
+ POPJ P,
+
+PGBIOO: SKIPA D,[SOUT]
+PGBIOI: MOVE D,[SIN]
+ HRLI C,004400
+ JRST PGBIOT
+DOIOTO: PUSH P,[SOUT]
+DOIOTC: PUSH P,B
+ PUSH P,C
+ EXCH A,B
+ MOVE A,CHANNO(A)
+ HLRE C,B
+ HRLI B,444400
+ XCT -2(P)
+ HRL B,C
+ MOVE A,B
+DOIOTE: POP P,C
+ POP P,B
+ SUB P,[1,,1]
+ POPJ P,
+DOIOTI: PUSH P,[SIN]
+ JRST DOIOTC
+]
+\f
+; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE
+
+PUTCHR: PUSH P,A
+ GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG
+ CAIE A,TCHSTR ; MUST BE STRING
+ JRST BDCHAN
+
+ HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT
+ JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME
+
+PUTCH1: POP P,A ; RESTORE CHAR
+ CAMN A,[-1] ; SPECIAL HACK?
+ JRST PUTCH2 ; YES GO HANDLE
+ IDPB A,BUFSTR(B) ; STUFF IT
+PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING
+ TRNE A,-1 ; SKIP IF FULL
+ POPJ P,
+
+; HERE TO FLUSH OUT A BUFFER
+
+ PUSH P,C
+ PUSH P,D
+ PUSHJ P,PGBUFO ; SETUP AND DO IOT
+ HRLI D,010700 ; POINT INTO BUFFER
+ SUBI D,1
+ MOVEM D,BUFSTR(B) ; STORE IT
+ MOVEI A,BUFLNT*5 ; RESET COUNT
+ HRRM A,BUFSTR-1(B)
+ POP P,D
+ POP P,C
+ POPJ P,
+
+;HERE TO DA ^C AND TURN ON MAGIC BIT
+
+PUTCH2: MOVEI A,3
+ IDPB A,BUFSTR(B) ; ZAP OUT THE ^C
+ MOVEI A,1 ; GET BIT
+IFE ITS,[
+ PUSH P,C
+ HRRZ C,BUFSTR(B)
+ IORM A,(C)
+ POP P,C
+]
+IFN ITS,[
+ IORM A,@BUFSTR(B) ; ON GOES THE BIT
+]
+ JRST PUTCH3
+
+; RESET A FUNNY BUF
+
+REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT
+ HRRM A,BUFSTR-1(B)
+ HRRZ A,BUFSTR(B) ; NOW POINTER
+ SUBI A,BUFLNT+1
+ HRLI A,010700
+ MOVEM A,BUFSTR(B) ; STORE BACK
+ JRST PUTCH1
+
+
+; HERE TO FLUSH FINAL BUFFER
+
+BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR
+ MOVEI A,0
+ TRNE C,C.TTY
+ POPJ P,
+ TRNE C,C.DISK
+ MOVEI A,1
+ PUSH P,A ; SAVE THE RESULT OF OUR TEST
+ JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE
+ PUSH TP,$TCHAN
+ PUSH TP,B ; SAVE CHANNEL
+ PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE
+ MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE
+ POP TP,B ; RESTORE B
+ POP TP,
+ CAIE A,5 ; IS NET IN OPEN STATE?
+ CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE
+ JRST BFCLNN ; IF SO TO THE IOT
+ POP P, ; ELSE FLUSH CRUFT AND DONT IOT
+ POPJ P, ; RETURN DOING NO IOT
+BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR
+ HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT
+ SUBI C,(D) ; GET NUMBER OF CHARS
+ IDIVI C,5 ; NUMBER OF FULL WORDS AND REST
+ PUSH P,D ; SAVE NUMBER OF ODD CHARS
+ SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION
+ SUBI A,1 ; FIX FOR 440700 BYTE POINTER
+IFE ITS,[
+ HRRO D,A
+ PUSH P,(D)
+]
+IFN ITS,[
+ PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER
+]
+ MOVEI D,BUFLNT
+ SUBI D,(C)
+ SKIPE -1(P)
+ SUBI A,1
+ ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS
+ PUSH TP,$TUVEC
+ PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK
+ JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO
+ HRL A,C
+ TLO A,400000
+ MOVE E,[SETZ BUFLNT(A)]
+ SUBI E,(C) ; FIX UP FOR BACKWARDS BLT
+ POP A,@E ; AMAZING GRACE
+ TLNE A,377777
+ JRST .-2
+ HRRO A,D ; SET UP AOBJN POINTER
+ SUBI A,(C)
+ TLC A,-1(C)
+ PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS
+BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK
+ SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS
+ POP P,0 ; GET BACK ODD WORD
+ POP P,C ; GET BACK ODD CHAR COUNT
+ POP P,D ; FLAG FOR NET OR DSK
+ JUMPN D,BFCDSK ; GO FINISH OFF DSK
+ JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP
+ MOVEI D,7
+ IMULI D,(C) ; FIND NO OF BITS TO SHIFT
+ LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE
+ MOVEM 0,(A) ; STORE IN STRING
+ SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP
+ MOVNI C,(C) ; MAKE C POSITIVE
+ LSH C,17
+ TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE
+ PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS
+ MOVEI C,0
+BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD
+ SUBI A,BUFLNT+1
+ JUMPLE C,.+3
+ SKIPE ACCESS(B)
+ MOVEM 0,1(A) ; LAST WORD BACK IN BFR
+ HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER
+ MOVEM A,BUFSTR(B)
+ MOVEI A,BUFLNT*5
+ HRRM A,BUFSTR-1(B)
+ SKIPN ACCESS(B)
+ JRST BFCLSY
+ JUMPL C,BFCLSY
+ JUMPE C,BFCLSZ
+ IBP BUFSTR(B)
+ SOS BUFSTR-1(B)
+ SOJG C,.-2
+BFCLSY: MOVE A,CHANNO(B)
+ MOVE C,B
+IFE ITS,[
+ RFPTR
+ FATAL RFPTR FAILED
+ HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH
+ MOVE G,C ; SAVE CHANNEL
+ MOVE C,B
+ CAML F,B
+ MOVE C,F
+ MOVE F,B
+ HRLI A,400000
+ CLOSF
+ JFCL
+ MOVNI B,1
+ HRLI A,12
+ CHFDB
+ MOVE B,STATUS(G)
+ ANDI A,-1
+ OPENF
+ FATAL OPENF LOSES
+ MOVE C,F
+ IDIVI C,5
+ MOVE B,C
+ SFPTR
+ FATAL SFPTR FAILED
+ MOVE B,G
+]
+IFN ITS,[
+ DOTCAL RFPNTR,[A,[2000,,B]]
+ .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
+ SUBI B,1
+ DOTCAL ACCESS,[A,B]
+ .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
+ MOVE B,C
+]
+BFCLSZ: SUB TP,[2,,2]
+ POPJ P,
+
+BFCDSK: TRZ 0,1
+ PUSH P,C
+IFE ITS,[
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH P,0 ; WORD OF CHARS
+ MOVE A,CHANNO(B)
+ MOVEI B,7 ; MAKE BYTE SIZE 7
+ SFBSZ
+ JFCL
+ HRROI B,(P)
+ MOVNS C
+ SKIPE C
+ SOUT
+ MOVE B,(TP)
+ SUB P,[1,,1]
+ SUB TP,[2,,2]
+]
+IFN ITS,[
+ MOVE D,[440700,,A]
+ DOTCAL SIOT,[CHANNO(B),D,C]
+ .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
+]
+ POP P,C
+ JUMPN C,BFCLSD
+BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER
+ JRST BFCLSD
+
+BFCLS1: HRRZ C,DIRECT-1(B)
+ MOVSI 0,(JFCL)
+ CAIE C,6
+ MOVE 0,[AOS ACCESS(B)]
+ PUSH P,0
+ HRRZ C,BUFSTR-1(B)
+ IDIVI C,5
+ JUMPE D,BCLS11
+ MOVEI A,40 ; PAD WITH SPACES
+ PUSHJ P,PUTCHR
+ XCT (P) ; AOS ACCESS IF NECESSARY
+ SOJG D,.-3 ; TO END OF WORD\r
+BCLS11: POP P,0
+ HLLZS ACCESS-1(B)
+ HRRZ C,BUFSTR-1(B)
+ CAIE C,BUFLNT*5
+ PUSHJ P,BFCLOS
+ POPJ P,
+
+\f
+; HERE TO GET A TTY BUFFER
+
+GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP
+ JRST TTYWAI
+ HRRZ D,(C) ; CDR THE LIST
+ GETYP A,(C) ; CHECK TYPE
+ CAIE A,TDEFER ; MUST BE DEFERRED
+ JRST BDCHAN
+ MOVE C,1(C) ; GET DEFERRED GOODIE
+ GETYP A,(C) ; BETTER BE CHSTR
+ CAIE A,TCHSTR
+ JRST BDCHAN
+ MOVE A,(C) ; GET FULL TYPE WORD
+ MOVE C,1(C)
+ MOVEM D,EXBUFR(B) ; STORE CDR'D LIST
+ MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER
+ MOVEM C,BUFSTR(B)
+ HRRM A,LSTCH-1(B)
+ SOJA A,BUFROK
+
+TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O
+ JRST GETTTY ; SHOULD ONLY RETURN HAPPILY
+
+\f;INTERNAL DEVICE READ ROUTINE.
+
+;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,
+;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER,
+;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE"
+
+;H. BRODIE 8/31/72
+
+GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B
+ PUSH TP,B
+ PUSH P,C ;AND SAVE THE OTHER ACS
+ PUSH P,D
+ PUSH P,E
+ PUSH P,0
+ PUSH TP,INTFCN-1(B)
+ PUSH TP,INTFCN(B)
+ MCALL 1,APPLY
+ GETYP A,A
+ CAIE A,TCHRS
+ JRST BADRET
+ MOVE A,B
+INTRET: POP P,0 ;RESTORE THE ACS
+ POP P,E
+ POP P,D
+ POP P,C
+ POP TP,B ;RESTORE THE CHANNEL
+ SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT
+ POPJ P,
+
+
+BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT
+
+;INTERNAL DEVICE PRINT ROUTINE.
+
+;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR)
+;TO THE CURRENT CHARACTER BEING "PRINTED".
+
+PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B
+ PUSH TP,B
+ PUSH P,C ;AND SAVE THE OTHER ACS
+ PUSH P,D
+ PUSH P,E
+ PUSH P,0
+ PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER"
+ PUSH TP,A ;PUSH THE CHAR
+ PUSH TP,$TCHAN ;PUSH THE CHANNEL
+ PUSH TP,B
+ MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR
+ JRST INTRET
+
+
+\f
+; ROUTINE TO FLUSH OUT A PRINT BUFFER
+
+MFUNCTION BUFOUT,SUBR
+
+ ENTRY 1
+
+ GETYP 0,(AB)
+ CAIE 0,TCHAN
+ JRST WTYP1
+
+ MOVE B,1(AB)
+; MOVEI B,DIRECT-1(B)
+; PUSHJ P,CHRWRD ; GET DIR NAME
+; JFCL
+; CAMN B,[ASCII /PRINT/]
+; JRST .+3
+; CAME B,[<ASCII /PRINT/>+1]
+; JRST WRONGD
+; TRNE B,1 ; SKIP IF PRINT
+; PUSH P,[JFCL]
+; TRNN B,1 ; SKIP IF PRINTB
+; PUSH P,[AOS ACCESS(B)]
+ HRRZ 0,-2(B)
+ TRNN 0,C.PRIN
+ JRST WRONGD
+; TRNE 0,C.BIN ; SKIP IF PRINT
+; PUSH P,[JFCL]
+; TRNN 0,C.BIN ; SKIP IF PRINTB
+; PUSH P,[AOS ACCESS(B)]
+; MOVE B,1(AB)
+; GETYP 0,BUFSTR-1(B)
+; CAIN 0,TCHSTR
+; SKIPN A,BUFSTR(B) ; BYTE POINTER?
+; JRST BFIN1
+; HRRZ C,BUFSTR-1(B) ; CHARS LEFT
+; IDIVI C,5 ; MULTIPLE OF 5?
+; JUMPE D,BFIN2 ; YUP NO EXTRAS
+
+; MOVEI A,40 ; PAD WITH SPACES
+; PUSHJ P,PUTCHR ; OUT IT GOES
+; XCT (P) ; MAYBE BUMP ACCESS
+; SOJG D,.-3 ; FILL
+
+BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER
+
+BFIN1: MOVSI A,TCHAN
+ JRST FINIS
+
+
+
+; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL
+
+MFUNCTION FILLNT,SUBR,[FILE-LENGTH]
+ ENTRY 1
+
+ GETYP 0,(AB)
+ CAIE 0,TCHAN
+ JRST WTYP1
+ MOVE B,1(AB)
+ PUSHJ P,CFILLE
+ JRST FINIS
+
+CFILLE:
+IFN 0,[
+ MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE
+ PUSHJ P,CHRWRD
+ JFCL
+ CAME B,[ASCIZ /READ/]
+ JRST .+3
+ PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ
+ JRST .+4
+ CAME B,[ASCII /READB/]
+ JRST WRONGD
+ PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ
+]
+ MOVE C,-2(B) ; GET BITS
+ MOVEI D,5 ; ASSUME ASCII
+ TRNE C,C.BIN ; SKIP IF NOT BINARY
+ MOVEI D,1
+ PUSH P,D
+ MOVE C,B
+IFN ITS,[
+ .CALL FILL1
+ JRST FILLOS ; GIVE HIM A NICE FALSE
+]
+IFE ITS,[
+ MOVE A,CHANNO(C)
+ PUSH P,[0]
+ MOVEI C,(P)
+ MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE
+ GTFDB
+ LDB D,[300600,,(P)] ; GET BYTE SIZE
+ JUMPN D,.+2
+ MOVEI D,36. ; HANDLE "0" BYTE SIZE
+ SUB P,[1,,1]
+ SIZEF
+ JRST FILLOS
+]
+ POP P,C
+IFN ITS, IMUL B,C
+IFE ITS,[
+ CAIN C,5
+ CAIE D,7
+ JRST NOTASC
+]
+YESASC: MOVE A,$TFIX
+ POPJ P,
+
+IFE ITS,[
+NOTASC: MOVEI 0,36.
+ IDIV 0,D ; BYTES PER WORD
+ IDIVM B,0
+ IMUL C,0
+ MOVE B,C
+ JRST YESASC
+]
+
+IFN ITS,[
+FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN
+ SIXBIT /FILLEN/
+ CHANNO (C)
+ SETZM B
+
+FILLOS: MOVE A,CHANNO(C)
+ MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON
+ LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE
+ IOR B,A ;FIX UP .STATUS
+ XCT B
+ MOVE B,C
+ PUSHJ P,GFALS
+ POP P,
+ POPJ P,
+]
+IFE ITS,[
+FILLOS: MOVE B,C
+ PUSHJ P,TGFALS
+ POP P,
+ POPJ P,
+]
+
+
+\f; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS
+
+;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data
+; DIR ? DEV ? FNM1 ? FNM2 ? SNM
+;RETURNED VALUE : AC-A = <channel #, or -1 if no channel available>
+IFN ITS,[
+MOPEN: PUSH P,B
+ PUSH P,C
+ MOVE C,FRSTCH ; skip gc and tty channels
+CNLP: DOTCAL STATUS,[C,[2000,,B]]
+ .LOSE %LSFIL
+ ANDI B,77
+ JUMPE B,CHNFND ; found unused channel ?
+ ADDI C,1 ; try another channel
+ CAIG C,17 ; are all the channels used ?
+ JRST CNLP
+ SETO C, ; all channels used so C = -1
+ JRST CHNFUL
+CHNFND: MOVEI B,(C)
+ HLL B,(A) ; M.DIR slot
+ DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)]
+ SKIPA
+ AOS -2(P) ; successful skip when returning
+CHNFUL: MOVE A,C
+ POP P,C
+ POP P,B
+ POPJ P,
+
+MIOT: DOTCAL IOT,[A,B]
+ JFCL
+ POPJ P,
+
+MCLOSE: DOTCAL CLOSE,[A]
+ JFCL
+ POPJ P,
+
+IMPURE
+
+FRSTCH: 1
+
+PURE
+]
+\f;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O
+
+NOTNET:
+BADCHN: ERRUUO EQUOTE BAD-CHANNEL
+BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER
+
+WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL
+
+CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED
+
+BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME
+
+DISLOS: MOVE C,$TCHSTR
+ MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE]
+ PUSHJ P,INCONS
+ MOVSI A,TFALSE
+ JRST OPNRET
+
+NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED
+
+MODE1: 232020,,202020
+MODE2: 232023,,330320
+
+END
+
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff