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