TITLE OPEN - CHANNEL OPENER FOR MUDDLE
RELOCATABLE
;C. REEVE MARCH 1973
.INSRT MUDDLE >
SYSQ
IFE ITS,[
IF1, .INSRT MUDSYS;STENEX >
]
;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING,
; PRINTSTRING, NETSTATE, NETACC, NETS, AND ACCESS.
;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 (
,,,,)
;
; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ
; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT.
; - SECOND FILE NAME. DEFAULT MUDDLE.
; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK.
; - 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
;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
.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS
.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO
.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,BYTDOP,TNXIN
.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO
.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS
.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL
.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
.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
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
RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR
]
; TABLE OF LEGAL MODES
MODES: IRP A,,[READ,PRINT,READB,PRINTB,DISPLAY]
SIXBIT /A/
TERMIN
NMODES==.-MODES
; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS
IFN ITS,[
DEVS: IRP A,,[DSK,TPL,SYS,COM,TTY,USR,STY,[ST ],NET,DIS,E&S,INT,PTP,PTR
[P ],[DK ],[UT ],[T ],NUL,[AI ]
[ML ],[DM ],[AR ],ARC]B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OUSR,OSTY,OSTY,ONET,ODIS,ODIS
OINT,OPTP,OPTP,ODSK,ODSK,OUTN,OTTY,ONUL,ODSK,ODSK,ODSK,ODSK,ODSK]
B,,(SIXBIT /A/)
TERMIN
]
IFE ITS,[
DEVS: IRP A,,[DSK,TTY,INT,NET]B,,[ODSK,OTTY,OINT,ONET]
B,,(SIXBIT /A/)
TERMIN
]
NDEVS==.-DEVS
;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
JRST FINIS
; SUBR TO JUST CREATE A CHANNEL
MFUNCTION CHANNEL,SUBR
ENTRY
PUSHJ P,MAKCHN
MOVSI A,TCHAN
JRST FINIS
; 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)
HLRZS 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)
]
CAIE D,(SIXBIT /INT/); INTERNAL?
JRST CHNET ; NO, MAYBE NET
SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED?
JRST TFA
; FALLS TROUGH IF SKIP
; NOW BUILD THE CHANNEL
ARGSOK: MOVEI A,CHANLNT ; GET LENGTH
PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF
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
MOVEM 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)
POPJ P,
; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN
CHNET: CAIE D,(SIXBIT /NET/) ; IS IT NET
IFN ITS, JRST MAKCH1
IFE ITS,[
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,
]
; 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
CAME B,[SIXBIT /PRINTO/] ; KLUDGE TO MAKE PRINTO AS PRINTB
JRST .+3
MOVEI A,3 ; CODE FOR PRINTB
POPJ P,
MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE
CAME B,MODES(A)
AOBJN A,.-1
JUMPGE A,WRONGD ; ILLEGAL MODE NAME
POPJ P,
IFN ITS,[
; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES
RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE
RGPARS: 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)
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," ; FILE NAME QUOTE?
JRST NOCNTQ
HRRZ 0,-1(TP)
JUMPE 0,PARSD
SOS -1(TP)
ILDB 0,(TP) ; USE THIS
JRST GOTCNQ
NOCNTQ: CAIG 0,40 ; SPACE?
JRST NDFLD ; YES, TERMINATE THIS FIELD
CAIN 0,": ; DEVICE ENDED?
JRST GOTDEV
CAIN 0,"; ; SNAME ENDED
JRST GOTSNM
GOTCNQ: 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
PUSHJ P,6TOCHS ; CONVERT TO STRING
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,
; 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
HLRZ A,S.DEV(C) ; GET DEVICE
CAIE 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
]
; 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
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: S.NM1(D)
S.NM2(D)
S.DEV(D)
S.SNM(D)
S.X1(D)
]
RDTBL: RDEVIC(B)
RNAME1(B)
RNAME2(B)
RSNAME(B)
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,[-7,,] ; 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 ">"
JUMPE B,ILLNAM ; RAN OUT
CAIE A,"> ; SKIP IF WINS
JRST ILLNAM
PUSHJ P,TN.CPS ; COPY TO NEW STRING
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," ; 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,440700
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: PUSH TP,$TATOM
PUSH TP,EQUOTE ILLEGAL-TENEX-FILE-NAME
JRST CALER1
TN.MLT: MOVEI A,(AB)
HRLI A,-10
TN.ML1: GETYP 0,(A)
CAIE 0,TFIX
CAIN 0,TCHSTR
JRST .+2
JRST RGPRSS ; ASSUME SINGLE STRING
ADD A,[2,,2]
JUMPL A,TN.ML1
MOVEI A,T.NM1(TB)
HRLI A,(AB)
BLT A,T.SNM+1(TB) ; BLT 'EM IN
ADD AB,[10,,10] ; SKIP THESE GUYS
JRST CHKLST
]
; 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
HRLM A,S.DEV(C)
; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS
; JRST TRLOST ; COMPLAIN
HRRZ A,S.DEV(C) ; GET SIXBIT DEVICE CODE
MOVEI E,(A) ; COPY TO E
ANDI E,777700 ; WITHOUT LAST
MOVEI D,(E) ; AND D
ANDI D,770000 ; WITH JUST LETTER
MOVSI B,-NDEVS ; AOBJN COUNTER
DEVLP: HRRZ 0,DEVS(B) ; GET ONE
CAIN 0,(A) ; FULL DEV?
JRST DISPA
CAIN 0,(D) ; ONE LETTER
JRST CH2DIG
CAIN 0,(E) ; 2 LTTERS
JRST CH1DIG
NXTDEV: AOBJN B,DEVLP ; LOOP THRU
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.DEV(C)
IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT)
HRLM A,S.DEV(C)
JRST OUSR
]
IFE ITS,[
PUSH TP,$TATOM
PUSH TP,EQUOTE NO-SUCH-DEVICE?
JRST CALER1
]
; MAKE SURE DIGITS EXIST
CH2DIG: LDB 0,[60600,,A]
CAIG 0,'9 ; CHECK DIGITNESS
CAIGE 0,'0
JRST NXTDEV ; LOSER
CH1DIG: LDB 0,[600,,A] ; LAST CHAR
CAIG 0,'9
CAIGE 0,'0
JRST NXTDEV
; HERE TO DISPATCH IF SUCCESSFUL
DISPA: HLRZ B,DEVS(B)
IFN ITS,[
HRRZ A,S.DIR(C) ; GET DIR OF OPEN
CAIN A,5 ; IS IT DISPLAY
CAIN B,ODIS ; BETTER BE OPENING DISPLAY
JRST (B) ; GO TO HANDLER
JRST WRONGD
]
IFE ITS, JRST (B)
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
POP P,C
MOVE D,T.SPDL+1(TB)
HRRZ D,S.DIR(D)
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 NEW VERSION
TLO A,400000 ; FORCE OLD
HRROI B,1(E) ; POIT TO STRING
GTJFN
TDZA 0,0 ; SAVE FACT OF NO SKIP
MOVEI 0,1 ; INDICATE SKIPPED
MOVE P,E ; RESTORE PSTACK
JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED
MOVE B,T.CHAN+1(TB) ; GET CHANNEL
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
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
OPENF
JRST OPFLOS
MOVEI 0,C.OPN+C.READ
TRNE D,1 ; SKIP FOR READ
MOVEI 0,C.OPN+C.PRIN
MOVE B,T.CHAN+1(TB)
HRRM 0,-4(B) ; MUNG THOSE BITS
ASH A,1 ; POINT TO SLOT
ADDI A,CHNL0(TVP) ; 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: 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
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
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
MOVEI A,":
IDPB A,D
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
MOVEI A,RNAME1-1(B)
PUSHJ P,MOVSTR
MOVEI A,".
IDPB A,D
ST.NM1: MOVEI A,RNAME2-1(B)
PUSHJ P,MOVSTR
SUB TP,[2,,2]
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 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: SUB P,[1,,1] ; FLUSH ERROR CODE SLOT
MOVE C,A
MOVE D,B
PUSHJ P,INCONS ; BUILD LIST
MOVSI A,TFALSE ; MAKE IT FALSE
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
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 C,(P) ; RET ADDR
SUB P,[S.X3+2,,S.X3+2]
SUB TP,[T.CHAN+2,,T.CHAN+2]
JRST (C)
; 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(B) ; REST BYTE POINTER
OPASCA: HRLI D,440700
MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK
MOVEI 0,C.BUF
IORM 0,-4(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,(B) ; START MAKING STRING POINTER
HRRI A,BUFLNT*5 ; SET UP CHAR COUNT
JRST OPASCA
; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.)
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
; OPEN THE DISPLAY DEVICE
ODIS: MOVEI B,T.DIR(TB) ; GET CHANNEL
PUSHJ P,CHRWRD ; TO ASCII
JFCL
MOVE E,B ; DIR TO E
MOVE B,T.CHAN+1(TB) ; CHANNEL
MOVE 0,[PUSHJ P,DCHAR] ; IOINS
CAIN A,1
MOVEM 0,IOINS(B)
PUSHJ P,DISOPN
JRST DISLOS ; LOSER
MOVE D,T.CHAN+1(TB) ; GET CHANNEL
MOVEI 0,C.OPN+C.PRIN
HRRM 0,-4(D)
MOVEM A,DISINF-1(D) ; AND STORE
MOVEM B,DISINF(D)
SETZM CHANNO(D) ; NO REAL CHANNEL
MOVEI 0,DISLNL
MOVEM 0,LINLN(D)
MOVEI 0,DISPGL
MOVEM 0,PAGLN(D)
MOVEI 0,10. ; SET RADIX
MOVEM 0,RADX(D)
JRST SAVCHN ; ADD TO CHANNEL LIST
; 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,-4(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(TVP) ; POINT TO CURRENT LIST
MOVSI C,TCHAN
PUSHJ P,ICONS ; CONS IT ON
HRRZM B,CHNL0+1(TVP)
JRST OPNWIN
; INT DEVICE I/O INS
INTINS: PUSHJ P,GTINTC
PUSHJ P,PTINTC
; 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: PUSH TP,$TATOM ; CALL ERROR
PUSH TP,EQUOTE BYTE-SIZE-BAD
JRST CALER1
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.DEV(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)
MOVEM 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,
; 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
MOVEI D,S.DEV(C) ; SETUP FOR .RCHST
HRL D,CHANNO(B)
.RCHST D, ; GET THE GOODS
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,
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)
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(TVP) ; TO REAL SLOT
MOVEM B,1(A) ; SAVE CHANNEL
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
MOVEM 0,BUFRIN-1(B)
MOVE A,CHANNO(B) ; GET JFN
GDSTS ; GET STATE
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 A,CHANNO(E)
GDSTS
LSH B,-32.
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,
ITSTRN: MOVEI B,0
JRST NLOSS
JRST NLOSS
MOVEI B,1
MOVEI B,2
JRST NLOSS
MOVEI B,4
PUSHJ P,NOPND
MOVEI B,0
JRST NLOSS
JRST NLOSS
PUSHJ P,NCLSD
MOVEI B,0
JRST NLOSS
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
]
; 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(TVP)
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.DEV(C) ; STORE IN OPEN BLOCK
PUSHJ P,OPEN2 ; OPEN THE TTY
HRLZ 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]]
FATAL .CALL FAILURE
DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D]
FATAL .CALL FAILURE
MOVE A,[PUSHJ P,GMTYO]
MOVEM A,IOINS(B)
DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]]
FATAL .CALL FAILURE
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,
; 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]
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,
]
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,MTYO]
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
HRRM E,-4(B)
MOVEM B,CHNL0+2*100+1(TVP)
JRST TNXTY2
TNXTY1: MOVEM B,CHNL0+2*101+1(TVP)
MOVEI A,101 ; PRIM OUTPUT JFN
MOVEI E,C.OPN+C.PRIN
HRRM E,-4(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
MOVEM A,BUFRIN-1(D)
IFN ITS, MOVEI A,177 ;SET ERASER TO RUBOUT
IFE ITS, MOVEI A,1 ; TRY ^A FOR TENEX
MOVEM A,ERASCH(B)
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,-4(D)
HRLI B,440700
MOVSI A,TCHSTR
MOVEM A,BUFSTR-1(D)
MOVEM B,BUFSTR(D)
MOVEI A,0
MOVE B,D ; CHANNEL TO B
JRST MAKION
; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST
OPEN2: MOVEI A,S.DEV(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 /PRINTO/]
JRST OPEN9 ; WELL NOT THIS TIME
IORI A,100000 ; WRITEOVER BIT
HRRZ 0,FSAV(TB)
CAIN 0,NFOPEN
IOR A,4 ; DON'T CHANGE REF DATE
OPEN9: HRLM A,S.DEV(C) ; AND STORE IT
; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL
OPEN1: MOVEI A,S.DEV(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
MOVSI A,(A) ; SET UP READ CHAN STATUS
HRRI A,S.DEV(C)
.RCHST A, ; GET THE GOODS
; 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,-4(B)
MOVE A,CHANNO(B) ; GET CHANNEL #
ASH A,1
ADDI A,CHNL0(TVP) ; POINT TO SLOT
MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP
; NOW GET STATUS WORD
DOSTAT: HRLZ A,CHANNO(B) ; NOW GET STATUS WORD
ROT A,5
IOR A,[.STATUS STATUS(B)] ; GET INS
XCT A ; AND DO IT
POPJ P,
; 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
PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE
SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED
JRST OPNRET ; AND RETURN
; ROUTINE TO CONS UP FALSE WITH REASON
GFALS: 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
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: 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
MOVE C,A
MOVE D,B ; COPY STRING
PUSHJ P,INCONS ; CONS TO NIL
MOVSI A,TFALSE ; MAKEIT A FALSE
POPJ P,
; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL
FIXREA: 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,
DOOPN: PUSH P,A
HRLZ A,CHANNO(B) ; GET CHANNEL
ASH A,5
HRR A,(P) ; POINT
TLO A,(.OPEN)
XCT A
SKIPA
AOS -1(P)
POP P,A
POPJ P,
;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
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
JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED
PUSHJ P,A0TO6 ; CONVERT TO SIXBIT
IDPB 0,D ;DEPOSIT INTO SIX BIT
TRNN A,77 ;IS OUTPUT FULL
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,
; 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,,0]
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,B ; PUSH BYTE POINTER
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: MOVEI A,0 ; SETUP FDELE
EXCH A,(P) ; AND GET SNAME
.SUSET [.SSNAM,,A]
HLRZS -3(P) ; FIXUP DEVICE
.FDELE -3(P) ; DO IT TO IT
JRST FDLST ; ANALYSE ERROR
FDLWON: MOVSI A,TATOM
MOVE B,MQUOTE T
JRST FINIS
]
IFE ITS,[
MOVE A,(TP) ; GET BASE OF PDL
MOVEI A,1(A) ; POINT TO CRAP
MOVE B,1(AB) ; STRING POINTER
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,MQUOTE 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: 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: IMQUOTE DEV
IMQUOTE SNM
IMQUOTE NM1
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,MQUOTE 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
HLRZS A,-7(P) ; FIX AND GET DEV1
HLRZS B,-3(P) ; SAME FOR DEV2
CAIE 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)
.FDELE -4(P) ; TRY THE RENAME
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
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 #
MOVEM A,-2(P)
.FDELE -4(P)
JRST FDLST
MOVEI A,-4(P) ; SET UP FOR RDCHST
HRL A,CHANNO(B)
.RCHST A,
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
JRST FINIS
]
IFE ITS,[
PUSH P,A
MOVE A,(TP) ; PBASE BACK
PUSH A,[400000,,0]
MOVEI A,(A)
MOVE B,1(AB)
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
]
; HERE FOR LOSING .FDELE
FDLST: .STATUS 0,A ; GET STATUS
PUSHJ P,GFALS ; ANALYZE IT
JRST FINIS
; SOME .FDELE ERRORS
DEVDIF: PUSH TP,$TATOM
PUSH TP,EQUOTE DEVICE-OR-SNAME-DIFFERS
JRST CALER1
; 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(TVP)
CAMN B,TTOCHN+1(TVP)
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
HLRZS -3(P) ; FIX DEVICE SPEC
]
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: MOVE B,1(AB)
CAME B,TTOCHN+1(TVP)
CAMN B,TTICHN+1(TVP)
PUSHJ P,TTYOP2
PUSHJ P,DOSTAT
DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]]
FATAL .CALL FAILURE
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
SKIPE NOTTY
JRST DRESET
MOVE B,1(AB)
JRST REATT1
; 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(TVP) ;POINT TO FIRST REAL CHANNEL
CHNLP: SKIPN 1(B) ;OPEN?
JRST NXTCHN ;NO, SKIP
HRRZ E,(B) ; ABOUT TO FLUSH?
JUMPN 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(TVP)+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
; 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, HLRZS E,-3(P) ; GET DEVICE IN PROPER PLACE
IFE ITS, HLRZS E,(P)
MOVE B,(TP) ; RESTORE CHANNEL
CAIN E,(SIXBIT /DSK/)
JRST DISKH ; DISK WINS IMMEIDATELY
CAIN E,(SIXBIT /TTY/) ; NO NEED TO RE-OPEN THE TTY
JRST REOPD1
IFN ITS,[
ANDI E,777700 ; COULD BE "UTn"
MOVE D,CHANNO(B) ; GET CHANNEL
ASH D,1
ADDI D,CHNL0(TVP) ; DON'T SEEM TO BE OPEN
SETZM 1(D)
SETZM CHANNO(B)
CAIN E,(SIXBIT /UT /)
JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES
CAIN E,(SIXBIT /AI /)
JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS
CAIN E,(SIXBIT /ML /)
JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS
CAIN 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
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
POP P,C
POP P,A
DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS
IDIVI C,5 ; BACK TO WORD ACCESS
IORI A,6 ; BLOCK IMAGE
IFN ITS,[
TRNE A,1
IORI A,100000 ; WRITE OVER BIT
HRLM A,-3(P)
MOVEI A,-3(P)
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
HRLZ A,CHANNO(B)
ASH A,5
IOR A,[.ACCESS (P)]
XCT A
POP P,A
POPJ P,
DOIOTO:
DOIOTI:
DOIOT:
PUSH P,0
MOVSI 0,TCHAN
MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT
ENABLE
HRLZ 0,CHANNO(B)
ASH 0,5
IOR 0,[.IOT A]
XCT 0
DISABLE
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,[
HRROI B,1(E) ; TENEX STRING POINTER
MOVEI A,1(P) ; A POINT TO BLOCK OF INFO
PUSH P,[100400,,0] ; FORCE JFN REUSE AND ONLY ACCEPT EXISTING FILE
PUSH P,[377777,,377777] ; NO I/O FOR CORRECTIONS ETC.
REPEAT 6,PUSH P,[0] ; OTHER SLOTS
MOVE D,-2(TP) ; CHANNEL BACK
PUSH P,CHANNO(D) ; AND DESIRED JFN
GTJFN ; GO GET IT
JRST RGTJL ; COMPLAIN
MOVE P,(TP) ; RESTORE P
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,-2(TP) ; CHANNEL
MOVE A,CHANNO(A) ; 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
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
;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(TVP) ; CHECK FOR TTY
CAMN B,TTOCHN+1(TVP)
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
HLRZS A,(P)
MOVE B,1(AB) ; RESTORE CHANNEL
CAIE A,(SIXBIT /E&S/)
CAIN 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
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(TVP) ;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 -4(B)
MOVSI A,TCHAN ;RETURN THE CHANNEL
JRST FINIS
CLSTTY: PUSH TP,$TATOM
PUSH TP,EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL
JRST CALER1
REMOV: MOVEI D,CHNL0(TVP)+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
GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER
SKIPN BUFSTR(B)
JRST CFIN1
CAIE 0,TCHSTR
JRST CFINX1
IFE ITS, PUSH P,A ; SAVE MODE
PUSHJ P,BFCLOS
IFE ITS,[
POP P,A ; RESTORE MODE
MOVE 0,RDEVIC(B)
ILDB 0,0
CAIN 0,"D
CAME A,[SIXBIT /PRINT/]
JRST CFINX1
MOVE A,CHANNO(B) ; GET JFN
TLO A,400000 ; BIT MEANS DONT RELEASE JFN
CLOSF ; CLOSE THE FILE
FATAL CLOSF LOST?
MOVE E,B ; SAVE CHANNEL
MOVE A,CHANNO(B)
HRLI A,11
MOVSI B,7700 ; MASK
MOVSI C,700 ; MAKE NEW SIZE 7
CHFDB
HRLI A,12
SETOM B
MOVE C,ACCESS(E) ; LENGTH IN CHARS
CHFDB
]
HLLZS BUFSTR-1(B)
SETZM BUFSTR(B)
CFINX1: HLLZS ACCESS-1(B)
JRST CFIN1
CFIN5: HRRM A,CHANNO-1(B)
JRST CFIN2
;SUBR TO DO .ACCESS ON A READ CHANNEL
;FORM:
;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,[+1]
JRST MACCA
PUSH P,[2] ;ACCESS ON PRINTB CHANNEL
MOVE B,1(AB)
SKIPE BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER
PUSHJ P,BFCLS1
JRST MACC
MACCA: PUSH P,[0] ; READ RATHER THAN READB INDICATOR
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
SKIPN CHANNO(B) ;CLOSED CHANNELS HAVE CHANNO ZEROED OUT
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...ALL NEGS = -5
MOVNI C,-5
;BUT .ACCESS -1 ISN'T IMPLEMENTED ON ITS YET, SO TELL HIM
JUMPGE C,MACC1
PUSH TP,$TATOM
PUSH TP,EQUOTE NEGATIVE-ACCESS-NOT-ON-ITS
JRST CALER1
MACC1: SKIPN (P)
IDIVI C,5
;SETUP THE .ACCESS
MOVE B,1(AB) ;GET BACK PTR TO CHANNEL
MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER
IFN ITS,[
ROT A,23. ;SET UP IN AC FIELD
IOR A,[.ACCESS 0,C] ;C CONTAINS PLACE TO ACCESS TO
;DO IT TO IT!
XCT A
]
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
CAIN E,2
JRST DONADV ; PRINTB CHANNEL
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
MOVEM A,BUFSTR(B)
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
MOVEM C,ACCESS(B)
MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL"
JRST FINIS ;DONE...B CONTAINS CHANNEL
IFE ITS,[
ACCFAI: PUSH TP,$TATOM
PUSH TP,EQUOTE ACCESS-FAILURE
JRST CALER1
]
;WRONG TYPE OF DEVICE ERROR
WRDEV: PUSH TP,$TATOM
PUSH TP,EQUOTE NON-DSK-DEVICE
JRST CALER1
; BINARY READ AND PRINT ROUTINES
MFUNCTION PRINTB,SUBR
ENTRY 2
PBFL: PUSH P,. ; PUSH NON-ZERONESS
JRST BINI1
MFUNCTION READB,SUBR
ENTRY
PUSH P,[0]
HLRZ 0,AB
CAIG 0,-3
CAIG 0,-7
JRST WNA
BINI1: GETYP 0,(AB) ; SHOULD BE UVEC OR STORE
CAIN 0,TUVEC
JRST BINI2
CAIE 0,TSTORAGE
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
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,[+1]
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
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)
BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT
JRST BINEOF
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
BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND?
PUSHJ P,BFCLS1 ; GET RID OF SAME
MOVE A,1(AB)
PUSHJ P,PGBIOO
HLRE C,1(AB)
MOVNS C
addm c,ACCESS(B)
MOVE A,(AB) ; RET VECTOR ETC.
MOVE B,1(AB)
JRST FINIS
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,
; 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
MOVEM A,LSTCH(B)
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,DIRECT-1(B)
CAIE C,6 ; 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)
PUSHJ P,WXCT
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
POP TP,B
POP TP,(TP)
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,[+1]
JRST .+2
JRST BADCHN
POP TP,B
POP TP,(TP)
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: PUSH P,A ; SAVE THE CHAR TO WRITE
PUSH TP,$TCHAN ; AND SAVE THE CHANNEL TOO
PUSH TP,B
XCT IOINS(B) ; DO THE REAL ONE
JRST DOSCPT ; AND CHECK OUT SCRIPTAGE
RXCT: PUSH TP,$TCHAN
PUSH TP,B ; DO IT FOR READS, SAVE THE CHAN
XCT IOINS(B) ; READ IT
PUSH P,A ; AND SAVE THE CHAR AROUND
JRST DOSCPT ; AND CHECK OUT SCRIPTAGE
DOSCPT: MOVE B,(TP) ;CHECK FOR SCRIPTAGE
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 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,0 ; INDICATE INPUT
PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL
MOVE A,-1(TP)
MOVE B,(TP) ; GET OUT CHAN
MOVEI 0,1 ; 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: 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
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/
+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
; 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
; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN
; FORMAT FOR PRINTSTRING IS
; 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)
CAIE 0,TCHAN
JRST WTYP2 ; SECOND ARG NOT CHANNEL
MOVE B,3(AB)
MOVEI B,DIRECT-1(B)
PUSHJ P,CHRWRD
JFCL
MOVNI E,1 ; CHECKING FOR GOOD DIRECTION
CAMN B,[ASCII /READ/]
MOVEI E,0
CAMN B,[ASCII /PRINT/]
MOVEI E,1
CAMN B,[+1]
MOVEI E,1
CAMN B,[ASCII /READB/]
MOVEI E,0
CAME E,(P)
JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE
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
TLZ A,TYPMSK#777777
CAME A,$TCHAN
JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL
PUSH TP,A
PUSH TP,B
STRIO3: MOVE B,(TP) ; GET CHANNEL
SKIPN E,IOINS(B) ; MAKE SURE HE IS OPEN
PUSHJ P,OPENIT ; IF NOT GO OPEN
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 .+4 ; WIN
PUSH TP,$TATOM ; LOSAGE, COUNT TOO GREAT
PUSH TP,EQUOTE COUNT-GREATER-THAN-STRING-SIZE
JRST CALER1
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)
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)
PUSHJ P,GWB ; MAKE SURE WE HAVE BUFF
OUTLP1: INTGO
MOVE B,-2(TP)
MOVE C,-1(P) ; MAX COUNT TO DO
CAMG C,(P) ; HAVE WE DONE ENOUGH
JRST STREOF
ILDB A,(TP) ; GET THE CHAR
SOS -1(TP) ; SUBTRACT FROM STRING LENGTH
AOS (P) ; INC COUNT OF CHARS DONE
PUSHJ P,W1CHAR ; 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)
MOVE C,B
HRLI C,440700
MOVE B,(TP)
MOVEI 0,C.BUF
IORM 0,-4(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(B)
POP TP,B
MOVEI 0,C.BUF
IORM 0,-4(B)
HRLI C,440700
MOVEM C,BUFSTR(B)
MOVSI C,TCHSTR
MOVEM C,BUFSTR-1(B)
SUB TP,[1,,1]
POPJ P,
MTSTRN: PUSH TP,$TATOM
PUSH TP,EQUOTE EMPTY-STRING
JRST CALER1
; 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
BDCHAN: PUSH TP,$TATOM ; ERROR RETURN
PUSH TP,EQUOTE BAD-INPUT-BUFFER
JRST CALER1
; BUFFER WAS GOOD
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
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
; RESET THE BYTE POINTER IN THE CHANNEL.
; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D
BUFGOO: HRLI D,440700 ; GENERATE VIRGIN LH
MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT
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
IFE ITS,[
CAIN A,32 ; TENEX EOF?
JRST .+3
]
CAIE A,3 ; EOF?
POPJ P, ; AND RETURN
IFN ITS,[
LDB A,[600,,STATUS(B)] ; CHECK FOR TTY
CAILE A,2 ; SKIP IF TTY
]
IFE ITS, SKIPN BUFRIN(B)
JRST .+3
RETEO1: HRRI A,3
POPJ P,
HRRZ A,@BUFSTR(B) ; SEE IF RSUBR START BIT IS ON
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
IFN ITS,[
PGBIOO:
PGBIOI: MOVE D,A ; COPY FOR LATER
MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS
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
SETZM BSTO(PVP)
SETZM ASTO(PVP)
SETZM DSTO(PVP)
POPJ P,
]
IFE ITS,[
PGBIOT: PUSH P,D
PUSH TP,$TCHAN
PUSH TP,B
MOVEI C,(A) ; POINT TO BUFFER
HRLI C,444400
MOVE D,A ; XTRA POINTER
MOVE A,CHANNO(B) ; FILE JFN
MOVE B,C
HLRE C,D ; - COUNT TO C
XCT (P) ; DO IT TO IT
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,
PGBIOO: SKIPA D,[SOUT]
PGBIOI: MOVE D,[SIN]
JRST PGBIOT
DOIOTO: PUSH P,D
PUSH P,C
PUSHJ P,PGBIOO
DOIOTE: POP P,C
POP P,D
POPJ P,
DOIOTI: PUSH P,D
PUSH P,C
PUSHJ P,PGBIOI
JRST DOIOTE
]
; 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,440700 ; POINT INTO BUFFER
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
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
HRLI A,440700
MOVEM A,BUFSTR(B) ; STORE BACK
JRST PUTCH1
; HERE TO FLUSH FINAL BUFFER
BFCLOS: HLLZS ACCESS-1(B) ; CLEAR OUT KLUDGE PRINTB PART ACCESS COUNT
MOVE C,B ; THIS BUFFER FLUSHER THE WORK OF NDR
MOVEI B,RDEVIC-1(B) ; FIND OUT IF THIS IS NET
PUSHJ P,CHRWRD
JFCL
TRZ B,77777 ; LEAVE ONLY HIGH 3 CHARS
MOVEI A,0 ; FLAG 0=NET 1=DSK
CAME B,[ASCIZ /NET/] ; IS THIS NET?
AOS A
PUSH P,A ; SAVE THE RESULT OF OUR TEST
MOVE B,C ; RESTORE CHANNEL IN B
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
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
MOVE E,[A,,BUFLNT]
SUBI E,(C) ; FIX UP FOR BACKWARDS BLT
POP A,@E ; AMAZING GRACE
TLNE A,-1
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
JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP
JUMPN D,BFCDSK ; GO FINISH OFF DSK
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
BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD
SUBI A,BUFLNT
HRLI A,440700 ; AOBJN POINTER TO FIRST OF BUFFER
MOVEM A,BUFSTR(B)
MOVEI A,BUFLNT*5
HRRM A,BUFSTR-1(B)
SUB TP,[2,,2]
POPJ P,
BFCDSK: MOVE C,A ; FOR FUNNY AOBJN PTR
HLL C,BUFSTR(B) ; POINT INTO WORD AFTER LAST CHAR
TRZ 0,1
MOVEM 0,(A)
IFN ITS, MOVEI 0,3 ; CONTROL C
IFE ITS, MOVEI 0,32 ; CNTL Z
IDPB 0,C
PUSHJ P,PGBIOO
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
BCLS11: POP P,0
HLLZS ACCESS-1(B)
HRRZ C,BUFSTR-1(B)
CAIE C,BUFLNT*5
PUSHJ P,BFCLOS
POPJ P,
; 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)
SOJA A,BUFROK
TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O
JRST GETTTY ; SHOULD ONLY RETURN HAPPILY
;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: PUSH TP,$TATOM
PUSH TP,EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT
JRST CALER1
;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,INTFCN-1(B) ;PUSH TYPE OF GIVEN OBJ
PUSH TP,INTFCN(B) ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.)
PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER"
PUSH TP,A ;PUSH THE CHAR
MCALL 2,APPLY ;APPLY THE FUNCTION TO THE CHAR
JRST INTRET
; 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,[+1]
JRST WRONGD
TRNE B,1 ; SKIP IF PRINT
PUSH P,[JFCL]
TRNN B,1 ; SKIP IF PRINTB
PUSH P,[AOS ACCESS(B)]
MOVE B,1(AB)
GETYP 0,BUFSTR-1(B)
CAIN 0,TCHSTR
SKIPN C,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)
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,1(AB)
IFN ITS,[
.CALL FILL1
JRST FILLOS ; GIVE HIM A NICE FALSE
]
IFE ITS,[
MOVE A,CHANNO(C)
SIZEF
JRST FILLOS
]
POP P,C
IMUL B,C
MOVE A,$TFIX
JRST FINIS
IFN ITS,[
FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN
SIXBIT /FILLEN/
CHANNO (C)
SETZM B
FILLOS: MOVE A,CHANNO(C)
PUSHJ P,GFALS
JRST FINIS
]
IFE ITS,[
FILLOS: PUSHJ P,TGFALS
JRST FINIS
]
;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O
NOTNET:
BADCHN: PUSH TP,$TATOM
PUSH TP,EQUOTE BAD-CHANNEL
JRST CALER1
WRONGD: PUSH TP,$TATOM
PUSH TP,EQUOTE WRONG-DIRECTION-CHANNEL
JRST CALER1
CHNCLS: PUSH TP,$TATOM
PUSH TP,EQUOTE CHANNEL-CLOSED
JRST CALER1
BAD6: PUSH TP,$TATOM
PUSH TP,EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME
JRST CALER1
DISLOS: MOVE C,$TCHSTR
MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE]
PUSHJ P,INCONS
MOVSI A,TFALSE
JRST OPNRET
NOCHAN: PUSH TP,$TATOM
PUSH TP,EQUOTE ITS-CHANNELS-EXHAUSTED
JRST CALER1
MODE1: 232020,,202020
MODE2: 232023,,332320
END