sumex/fopen.mcr352

   1 TITLE OPEN - CHANNEL OPENER FOR MUDDLE\r
   2 \r
   3 RELOCATABLE\r
   4 \r
   5 ;C. REEVE  MARCH 1973\r
   6 \r
   7 .INSRT MUDDLE >\r
   8 \r
   9 SYSQ\r
  10 \r
  11 IFE ITS,[\r
  12 IF1,    .INSRT MUDSYS;STENEX >\r
  13 ]\r
  14 ;THIS PROGRAM HAS ENTRIES:  FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING,\r
  15 ;                           PRINTSTRING, NETSTATE, NETACC, NETS, AND ACCESS.\r
  16 \r
  17 ;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM.\r
  18 \r
  19 ;       FOPEN   - OPENS A FILE FOR EITHER READING OR WRITING.  IT TAKES\r
  20 ;               FIVE OPTINAL ARGUMENTS AS FOLLOWS:\r
  21 \r
  22 ;               FOPEN (<DIR>,<FILE NAME1>,<FILE NAME2>,<DEVICE>,<SYSTEM NAME>)\r
  23 ;\r
  24 ;               <DIR> - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ\r
  25 \r
  26 ;               <FILE NAME1> - FIRST FILE NAME.  DEFAULT INPUT OR OUTPUT.\r
  27 \r
  28 ;               <FILE NAME2> - SECOND FILE NAME.  DEFAULT MUDDLE.\r
  29 \r
  30 ;               <DEVICE> - DEVICE FROM WHICH TO OPEN.  DEFAULT IS DSK.\r
  31 \r
  32 ;               <SNAME> - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME.\r
  33 \r
  34 ;       FOPEN   RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL\r
  35 \r
  36 \r
  37 ;       FCLOSE  - CLOSES A FILE.  TAKES A CHANNEL OBJECT AS ITS ARGUMENT.  IT ALSO TAKES\r
  38 ;       ACCESS  - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES\r
  39 \r
  40 \r
  41 ; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION\r
  42 \r
  43 ;       CHANNO  ;ITS I/O CHANNEL NUMBER.  0 MEANS NOT A REAL CHANNEL.\r
  44 ;       DIRECT  ;DIRECTION (EITHER READ OR PRINT)\r
  45 ;       NAME1   ;FIRST NAME OF FILE AS OPENED.\r
  46 ;       NAME2   ;SECOND NAME OF FILE\r
  47 ;       DEVICE  ;DEVICE UPON WHICH THE CHANNEL IS OPEN\r
  48 ;       SNAME   ;DIRECTORY NAME\r
  49 ;       RNAME1  ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS)\r
  50 ;       RNAME2  ;REAL SECOND NAME\r
  51 ;       RDEVIC  ;REAL DEVICE\r
  52 ;       RSNAME  ;SYSTEM OR DIRECTORY NAME\r
  53 ;       STATUS  ;VARIOUS STATUS BITS\r
  54 ;       IOINS   ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER\r
  55 ;       ACCESS  ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO)\r
  56 ;       RADX    ;RADIX FOR CHANNELS NUMBER CONVERSION\r
  57 \r
  58 ;       *** THE FOLLOWING FIELDS FOR OUTPUT ONLY ***\r
  59 ;       LINLN   ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE\r
  60 ;       CHRPOS  ;CURRENT POSITION ON CURRENT LINE\r
  61 ;       PAGLN   ;LENGTH OF A PAGE\r
  62 ;       LINPOS  ;CURRENT LINE BEING WRITTEN ON\r
  63 \r
  64 ;       *** THE FOLLOWING FILEDS FOR INPUT ONLY ***\r
  65 ;       EOFCND  ;GETS EVALUATED  ON EOF\r
  66 ;       LSTCH   ;BACKUP CHARACTER\r
  67 ;       WAITNS  ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING\r
  68 ;       EXBUFR  ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST\r
  69 ;       BUFSTR  ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES\r
  70 \r
  71 ; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER\r
  72 BUFLNT==100\r
  73 \r
  74 ;THIS DEFINES BLOCK MODE BIT FOR OPENING\r
  75 BLOCKM==2               ;DEFINED IN THE LEFT HALF\r
  76 IMAGEM==4\r
  77 \r
  78 \f\r
  79 ;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME\r
  80 \r
  81         CHANLNT==4                      ;INITIAL CHANNEL LENGTH\r
  82 \r
  83 ; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS\r
  84 BUFRIN==-1      ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER\r
  85 SCRPTO==-3      ;SPECIAL HACK FOR SCRIPT CHANNELS\r
  86 PROCHN:\r
  87 \r
  88 IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR]\r
  89 [NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR]\r
  90 [RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR]\r
  91 [STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX]\r
  92 [ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]]\r
  93 \r
  94         IRP     B,C,[A]\r
  95                 B==CHANLNT-3\r
  96                 T!C,,0\r
  97                 0\r
  98                 .ISTOP\r
  99                 TERMIN\r
 100         CHANLNT==CHANLNT+2\r
 101 TERMIN\r
 102 \r
 103 \r
 104 ; EQUIVALANCES FOR CHANNELS\r
 105 \r
 106 EOFCND==LINLN\r
 107 LSTCH==CHRPOS\r
 108 WAITNS==PAGLN\r
 109 EXBUFR==LINPOS\r
 110 DISINF==BUFSTR  ;DISPLAY INFO\r
 111 INTFCN==BUFSTR  ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS\r
 112 \r
 113 \r
 114 ;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS\r
 115 \r
 116 IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR]\r
 117 A==.IRPCNT\r
 118 TERMIN\r
 119 \r
 120 EXTBFR==BYTPTR+1+<100./5>       ;LENGTH OF ADD'L BUFFER\r
 121 \r
 122 \r
 123 \r
 124 \r
 125 .GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS\r
 126 .GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR\r
 127 .GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR\r
 128 .GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS\r
 129 .GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO\r
 130 .GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,BYTDOP,TNXIN\r
 131 .GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO\r
 132 .GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS\r
 133 .GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL\r
 134 .GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1\r
 135 .GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT\r
 136 .GLOBAL TMTNXS,TNXSTR,RDEVIC\r
 137 \r
 138 \f\r
 139 .VECT.==40000\r
 140 \r
 141 ; PAIR MOVING MACRO\r
 142 \r
 143 DEFINE PMOVEM A,B\r
 144         MOVE    0,A\r
 145         MOVEM   0,B\r
 146         MOVE    0,A+1\r
 147         MOVEM   0,B+1\r
 148         TERMIN\r
 149 \r
 150 ; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN\r
 151 \r
 152 T.SPDL==0               ; SAVES P STACK BASE\r
 153 T.DIR==2                ; CONTAINS DIRECTION AND MODE\r
 154 T.NM1==4                ; NAME 1 OF FILE\r
 155 T.NM2==6                ; NAME 2 OF FILE\r
 156 T.DEV==10               ; DEVICE NAME\r
 157 T.SNM==12               ; SNAME\r
 158 T.XT==14                ; EXTRA CRUFT IF NECESSARY\r
 159 T.CHAN==16              ; CHANNEL AS GENERATED\r
 160 \r
 161 ; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES)\r
 162 \r
 163 S.DIR==0                ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY\r
 164 IFN ITS,[\r
 165 S.DEV==1                ; SIXBIT DEVICE RIGHT JUSTIFIED\r
 166 S.NM1==2                ; SIXBIT NAME1\r
 167 S.NM2==3                ; SIXBIT NAME2\r
 168 S.SNM==4                ; SIXBIT SNAME\r
 169 S.X1==5                 ; TEMPS\r
 170 S.X2==6\r
 171 S.X3==7\r
 172 ]\r
 173 \r
 174 IFE ITS,[\r
 175 S.DEV==1\r
 176 S.X1==2\r
 177 S.X2==3\r
 178 S.X3==4\r
 179 ]\r
 180 \r
 181 \r
 182 ; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES\r
 183 \r
 184 NOSTOR==400000          ; ON MEANS DONT BUILD NEW STRINGS\r
 185 MSTNET==200000          ; ON MEANS ONLY THE "NET" DEVICE CAN WIN\r
 186 SNSET==100000           ; FLAG, SNAME SUPPLIED\r
 187 DVSET==040000           ; FLAG, DEV SUPPLIED\r
 188 N2SET==020000           ; FLAG, NAME2 SET\r
 189 N1SET==010000           ; FLAG, NAME1 SET\r
 190 \r
 191 RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR\r
 192 ]\r
 193 \r
 194 \r
 195 ; TABLE OF LEGAL MODES\r
 196 \r
 197 MODES:  IRP A,,[READ,PRINT,READB,PRINTB,DISPLAY]\r
 198         SIXBIT /A/\r
 199         TERMIN\r
 200 NMODES==.-MODES\r
 201 \r
 202 ; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS\r
 203 \r
 204 IFN ITS,[\r
 205 \r
 206 DEVS:   IRP A,,[DSK,TPL,SYS,COM,TTY,USR,STY,[ST ],NET,DIS,E&S,INT,PTP,PTR\r
 207 [P  ],[DK ],[UT ],[T  ],NUL,[AI ]\r
 208 [ML ],[DM ],[AR ],ARC]B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OUSR,OSTY,OSTY,ONET,ODIS,ODIS\r
 209 OINT,OPTP,OPTP,ODSK,ODSK,OUTN,OTTY,ONUL,ODSK,ODSK,ODSK,ODSK,ODSK]\r
 210         B,,(SIXBIT /A/)\r
 211         TERMIN\r
 212 ]\r
 213 IFE ITS,[\r
 214 DEVS:   IRP A,,[DSK,TTY,INT,NET]B,,[ODSK,OTTY,OINT,ONET]\r
 215         B,,(SIXBIT /A/)\r
 216         TERMIN\r
 217 ]\r
 218 NDEVS==.-DEVS\r
 219 \r
 220 \r
 221 \f\r
 222 ;SUBROUTINE TO DO OPENING BEGINS HERE\r
 223 \r
 224 MFUNCTION NFOPEN,SUBR,[OPEN-NR]\r
 225 \r
 226         JRST    FOPEN1\r
 227 \r
 228 MFUNCTION FOPEN,SUBR,[OPEN]\r
 229 \r
 230 FOPEN1: ENTRY\r
 231         PUSHJ   P,MAKCHN        ;MAKE THE CHANNEL\r
 232         PUSHJ   P,OPNCH ;NOW OPEN IT\r
 233         JRST    FINIS\r
 234 \r
 235 ; SUBR TO JUST CREATE A CHANNEL\r
 236 \r
 237 MFUNCTION CHANNEL,SUBR\r
 238 \r
 239         ENTRY\r
 240         PUSHJ   P,MAKCHN\r
 241         MOVSI   A,TCHAN\r
 242         JRST    FINIS\r
 243 \r
 244 \r
 245 \f\r
 246 \r
 247 ; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT\r
 248 \r
 249 MAKCHN: PUSH    TP,$TPDL\r
 250         PUSH    TP,P            ; POINT AT CURRENT STACK BASE\r
 251         PUSH    TP,$TCHSTR\r
 252         PUSH    TP,CHQUOTE READ\r
 253         MOVEI   E,10            ; SLOTS OF TP NEEDED\r
 254         PUSH    TP,[0]\r
 255         SOJG    E,.-1\r
 256         MOVEI   E,0\r
 257         EXCH    E,(P)           ; GET RET ADDR IN E\r
 258 IFE ITS,        PUSH    P,[0]\r
 259 IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]]\r
 260         MOVE    B,IMQUOTE ATM\r
 261 IFN ITS,        PUSH    P,E\r
 262         PUSHJ   P,IDVAL1\r
 263         GETYP   0,A\r
 264         CAIN    0,TCHSTR\r
 265         JRST    MAK!ATM\r
 266 \r
 267         MOVE    A,$TCHSTR\r
 268 IFN ITS,        MOVE    B,CHQUOTE MDF\r
 269 IFE ITS,        MOVE    B,CHQUOTE TMDF\r
 270 MAK!ATM:\r
 271         MOVEM   A,T.!ATM(TB)\r
 272         MOVEM   B,T.!ATM+1(TB)\r
 273 IFN ITS,[\r
 274         POP     P,E\r
 275         PUSHJ   P,STRTO6        ; RESULT LEFT ON P STACK AS DESIRED\r
 276 ]\r
 277         TERMIN\r
 278         PUSH    TP,[0]          ; PUSH SLOTS\r
 279         PUSH    TP,[0]\r
 280 \r
 281         PUSH    P,[0]           ; EXT SLOTS\r
 282         PUSH    P,[0]\r
 283         PUSH    P,[0]\r
 284         PUSH    P,E             ; PUSH RETURN ADDRESS\r
 285         MOVEI   A,0\r
 286 \r
 287         JUMPGE  AB,MAKCH0       ; NO ARGS, ALREADY DONE\r
 288         GETYP   0,(AB)          ; 1ST ARG MUST BE A STRING\r
 289         CAIE    0,TCHSTR\r
 290         JRST    WTYP1\r
 291         MOVE    A,(AB)          ; GET ARG\r
 292         MOVE    B,1(AB)\r
 293         PUSHJ   P,CHMODE        ; CHECK OUT OPEN MODE\r
 294 \r
 295         PMOVEM  (AB),T.DIR(TB)  ; SAVE MODE NAME IN TEMPS\r
 296         ADD     AB,[2,,2]       ; BUMP PAST DIRECTION\r
 297         MOVEI   A,0\r
 298         JUMPGE  AB,MAKCH0       ; CHECK NAME1 BASED ON JUST MODE\r
 299 \r
 300         MOVEI   0,0             ; FLAGS PRESET\r
 301         PUSHJ   P,RGPARS        ; PARSE THE STRING(S)\r
 302         JRST    TMA\r
 303 \r
 304 ; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL\r
 305 \r
 306 MAKCH0:\r
 307 IFN ITS,[\r
 308         MOVE    C,T.SPDL+1(TB)\r
 309         HLRZS   D,S.DEV(C)      ; GET DEV\r
 310 ]\r
 311 IFE ITS,[\r
 312         MOVE    A,T.DEV(TB)\r
 313         MOVE    B,T.DEV+1(TB)\r
 314         PUSHJ   P,STRTO6\r
 315         POP     P,D\r
 316         HLRZS   D\r
 317         MOVE    C,T.SPDL+1(TB)\r
 318         MOVEM   D,S.DEV(C)\r
 319 ]\r
 320         CAIE    D,(SIXBIT /INT/); INTERNAL?\r
 321         JRST    CHNET           ; NO, MAYBE NET\r
 322         SKIPN   T.XT+1(TB)      ; WAS FCN SUPPLIED?\r
 323         JRST    TFA\r
 324 \r
 325 ; FALLS TROUGH IF SKIP\r
 326 \r
 327 \f\r
 328 \r
 329 ; NOW BUILD THE CHANNEL\r
 330 \r
 331 ARGSOK: MOVEI   A,CHANLNT       ; GET LENGTH\r
 332         PUSHJ   P,GIBLOK        ; GET A BLOCK OF STUFF\r
 333         ADD     B,[4,,4]        ; HIDE THE TTY BUFFER SLOT\r
 334         PUSH    TP,$TCHAN\r
 335         PUSH    TP,B\r
 336         HRLI    C,PROCHN        ; POINT TO PROTOTYPE\r
 337         HRRI    C,(B)           ; AND NEW ONE\r
 338         BLT     C,CHANLN-5(B)   ; CLOBBER\r
 339         MOVSI   C,TLIST         ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS\r
 340         MOVEM   C,SCRPTO-1(B)\r
 341 \r
 342 ; NOW BLT IN STUFF FROM THE STACK\r
 343 \r
 344         MOVSI   C,T.DIR(TB)     ; DIRECTION\r
 345         HRRI    C,DIRECT-1(B)\r
 346         BLT     C,SNAME(B)\r
 347         MOVEI   C,RNAME1-1(B)   ; NOW "REAL" SLOTS\r
 348         HRLI    C,T.NM1(TB)\r
 349         BLT     C,RSNAME(B)\r
 350         POPJ    P,\r
 351 \r
 352 ; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN\r
 353 \r
 354 CHNET:  CAIE    D,(SIXBIT /NET/)        ; IS IT NET\r
 355 IFN ITS,        JRST    MAKCH1\r
 356 IFE ITS,[\r
 357         JRST    ARGSOK\r
 358 ]\r
 359         MOVSI   D,TFIX          ; FOR TYPES\r
 360         MOVEI   B,T.NM1(TB)     ; MAKE SURE ALL ARE FIXED\r
 361         PUSHJ   P,CHFIX\r
 362         MOVEI   B,T.NM2(TB)\r
 363         PUSHJ   P,CHFIX\r
 364         MOVEI   B,T.SNM(TB)\r
 365         LSH     A,-1            ; SKIP DEV FLAG\r
 366         PUSHJ   P,CHFIX\r
 367         JRST    ARGSOK\r
 368 \r
 369 MAKCH1: TRNN    A,MSTNET        ; CANT HAVE SEEN A FIX\r
 370         JRST    ARGSOK\r
 371         JRST    WRONGT\r
 372 \r
 373 IFN ITS,[\r
 374 CHFIX:  TRNE    A,N1SET         ; SKIP IF NOT SPECIFIED\r
 375         JRST    CHFIX1\r
 376 ]\r
 377         SETOM   1(B)            ; SET TO -1\r
 378         SETOM   S.NM1(C)\r
 379         MOVEM   D,(B)           ; CORRECT TYPE\r
 380 IFE ITS,CHFIX:\r
 381         GETYP   0,(B)\r
 382         CAIE    0,TFIX\r
 383         JRST    PARSQ\r
 384 CHFIX1: ADDI    C,1             ; POINT TO NEXT FIELD\r
 385         LSH     A,-1            ; AND NEXT FLAG\r
 386         POPJ    P,\r
 387 PARSQ: CAIE     0,TCHSTR\r
 388         JRST    WRONGT\r
 389 IFE ITS,        POPJ    P,\r
 390 IFN ITS,[\r
 391         PUSH    P,A\r
 392         PUSH    P,C\r
 393         PUSH    TP,(B)\r
 394         PUSH    TP,1(B)\r
 395         SUBI    B,(TB)\r
 396         PUSH    P,B\r
 397         MCALL   1,PARSE\r
 398         GETYP   0,A\r
 399         CAIE    0,TFIX\r
 400         JRST    WRONGT\r
 401         POP     P,C\r
 402         ADDI    C,(TB)\r
 403         MOVEM   A,(C)\r
 404         MOVEM   B,1(C)\r
 405         POP     P,C\r
 406         POP     P,A\r
 407         POPJ    P,\r
 408 ]\r
 409 \f\r
 410 \r
 411 ; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE\r
 412 \r
 413 CHMODE: PUSHJ   P,CHMOD         ; DO IT\r
 414         MOVE    C,T.SPDL+1(TB)\r
 415         HRRZM   A,S.DIR(C)\r
 416         POPJ    P,\r
 417 \r
 418 CHMOD:  PUSHJ   P,STRTO6        ; TO SIXBIT\r
 419         POP     P,B             ; VALUE ENDSUP ON STACK, RESTORE IT\r
 420 \r
 421         CAME    B,[SIXBIT /PRINTO/]     ; KLUDGE TO MAKE PRINTO AS PRINTB\r
 422         JRST    .+3\r
 423         MOVEI   A,3             ; CODE FOR PRINTB\r
 424         POPJ    P,\r
 425 \r
 426         MOVSI   A,-NMODES       ; SCAN TO SEE IF LEGAL MODE\r
 427         CAME    B,MODES(A)\r
 428         AOBJN   A,.-1\r
 429         JUMPGE  A,WRONGD        ; ILLEGAL MODE NAME\r
 430         POPJ    P,\r
 431 \f\r
 432 IFN ITS,[\r
 433 ; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES\r
 434 \r
 435 RGPRS:  MOVEI   0,NOSTOR        ; DONT STORE STRINGS IF ENTER HERE\r
 436 \r
 437 RGPARS: HRLM    0,(P)           ; LH IS FLAGS FOR THIS PROG\r
 438         MOVSI   E,-4            ; FIELDS TO FILL\r
 439 \r
 440 RPARGL: GETYP   0,(AB)          ; GET TYPE\r
 441         CAIE    0,TCHSTR        ; STRING?\r
 442         JRST    ARGCLB          ; NO, JUST CLOBBER IT IN RAW\r
 443         JUMPGE  E,CPOPJ         ; DON'T DO ANY MORE\r
 444         PUSH    TP,(AB)         ; GET AN ARG\r
 445         PUSH    TP,1(AB)\r
 446 \r
 447 FPARS:  PUSH    TP,-1(TP)       ; ANOTHER COPY\r
 448         PUSH    TP,-1(TP)\r
 449         PUSHJ   P,FLSSP         ; NO LEADING SPACES\r
 450         MOVEI   A,0             ; WILL HOLD SIXBIT\r
 451         MOVEI   B,6             ; CHARS PER 6BIT WORD\r
 452         MOVE    C,[440600,,A]   ; BYTE POINTER INTO A\r
 453 \r
 454 FPARSL: HRRZ    0,-1(TP)        ; GET COUNT\r
 455         JUMPE   0,PARSD         ; DONE\r
 456         SOS     -1(TP)          ; COUNT\r
 457         ILDB    0,(TP)          ; CHAR TO 0\r
 458 \r
 459         CAIE    0,"\11            ; FILE NAME QUOTE?\r
 460         JRST    NOCNTQ\r
 461         HRRZ    0,-1(TP)\r
 462         JUMPE   0,PARSD\r
 463         SOS     -1(TP)\r
 464         ILDB    0,(TP)          ; USE THIS\r
 465         JRST    GOTCNQ\r
 466 \r
 467 NOCNTQ: CAIG    0,40            ; SPACE?\r
 468         JRST    NDFLD           ; YES, TERMINATE THIS FIELD\r
 469         CAIN    0,":            ; DEVICE ENDED?\r
 470         JRST    GOTDEV\r
 471         CAIN    0,";            ; SNAME ENDED\r
 472         JRST    GOTSNM\r
 473 \r
 474 GOTCNQ: PUSHJ   P,A0TO6         ; CONVERT TO 6BIT AND CHECK\r
 475 \r
 476         JUMPE   B,FPARSL        ; IGNORE IF AREADY HAVE 6\r
 477         IDPB    0,C\r
 478         SOJA    B,FPARSL\r
 479 \r
 480 ; HERE IF SPACE ENCOUNTERED\r
 481 \r
 482 NDFLD:  MOVEI   D,(E)           ; COPY GOODIE\r
 483         PUSHJ   P,FLSSP         ; FLUSH REDUNDANT SPACES\r
 484         JUMPE   0,PARSD         ; NO CHARS LEFT\r
 485 \r
 486 NFL0:   PUSH    P,A             ; SAVE SIXBIT WORD\r
 487         PUSHJ   P,6TOCHS        ; CONVERT TO STRING\r
 488         HRRZ    0,-1(TP)        ; RESTORE CHAR COUNT\r
 489 \r
 490 NFL2:   MOVEI   C,(D)           ; COPY REL PNTR\r
 491         SKIPGE  -1(P)           ; SKIP IF STRINGS TO BE STORED\r
 492         JRST    NFL3\r
 493         ASH     D,1             ; TIMES 2\r
 494         ADDI    D,T.NM1(TB)\r
 495         MOVEM   A,(D)           ; STORE\r
 496         MOVEM   B,1(D)\r
 497 NFL3:   MOVSI   A,N1SET         ; FLAG IT\r
 498         LSH     A,(C)\r
 499         IORM    A,-1(P)         ; AND CLOBBER\r
 500         MOVE    D,T.SPDL+1(TB)  ; GET P BASE\r
 501         POP     P,@SIXTBL(C)    ; AND STORE SIXBIT OF IT\r
 502 \r
 503         POP     TP,-2(TP)       ; MAKE NEW STRING POINTER\r
 504         POP     TP,-2(TP)\r
 505         JUMPE   0,.+3           ; SKIP IF NO MORE CHARS\r
 506         AOBJN   E,FPARS         ; MORE TO PARSE?\r
 507 CPOPJ:  POPJ    P,              ; RETURN, ALL DONE\r
 508 \r
 509         SUB     TP,[2,,2]       ; FLUSH OLD STRING\r
 510         ADD     E,[1,,1]\r
 511         ADD     AB,[2,,2]       ; BUMP ARG\r
 512         JUMPL   AB,RPARGL       ; AND GO ON\r
 513 CPOPJ1: AOS     A,(P)           ; PREPARE TO WIN\r
 514         HLRZS   A\r
 515         POPJ    P,\r
 516 \r
 517 \f\r
 518 \r
 519 ; HERE IF STRING HAS ENDED\r
 520 \r
 521 PARSD:  PUSH    P,A             ; SAVE 6 BIT\r
 522         MOVE    A,-3(TP)        ; CAN USE ARG STRING\r
 523         MOVE    B,-2(TP)\r
 524         MOVEI   D,(E)\r
 525         JRST    NFL2            ; AND CONTINUE\r
 526 \r
 527 ; HERE IF JUST READ DEV\r
 528 \r
 529 GOTDEV: MOVEI   D,2             ; CODE FOR DEVICE\r
 530         JRST    GOTFLD          ; GOT A FIELD\r
 531 \r
 532 ; HERE IF  JUST READ SNAME\r
 533 \r
 534 GOTSNM: MOVEI   D,3\r
 535 GOTFLD: PUSHJ   P,FLSSP\r
 536         SOJA    E,NFL0\r
 537 \r
 538 \r
 539 ; HERE FOR NON STRING ARG ENCOUNTERED\r
 540 \r
 541 ARGCLB: SKIPGE  (P)             ; IF NOT STORING, CONSIDER THIS THE END\r
 542 \r
 543         POPJ    P,\r
 544         MOVE    C,T.SPDL+1(TB)  ; GET P-BASE\r
 545         HLRZ    A,S.DEV(C)      ; GET DEVICE\r
 546         CAIE    A,(SIXBIT /INT/)        ; IS IT THE INTERNAL DEVICE\r
 547         JRST    TRYNET          ; NO, COUD BE NET\r
 548         MOVE    A,0             ; OFFNEDING TYPE TO A\r
 549         PUSHJ   P,APLQ          ; IS IT APPLICABLE\r
 550         JRST    NAPT            ; NO, LOSE\r
 551         PMOVEM  (AB),T.XT(TB)\r
 552         ADD     AB,[2,,2]       ; MUST BE LAST ARG\r
 553         JUMPL   AB,TMA\r
 554         JRST    CPOPJ1          ; ELSE SUCCESSFUL RETURN\r
 555 TRYNET: CAIE    0,TFIX          ; FOR NET DEV, ARGS MUST BE FIX\r
 556         JRST    WRONGT          ; TREAT AS WRONG TYPE\r
 557         MOVSI   A,MSTNET        ; BETTER BE NET EVENTUALLY\r
 558         IORM    A,(P)           ; STORE FLAGS\r
 559         MOVSI   A,TFIX\r
 560         MOVE    B,1(AB)         ; GET NUMBER\r
 561         MOVEI   0,(E)           ; MAKE SURE NOT DEVICE\r
 562         CAIN    0,2\r
 563         JRST    WRONGT\r
 564         PUSH    P,B             ; SAVE NUMBER\r
 565         MOVEI   D,(E)           ; SET FOR TABLE OFFSETS\r
 566         MOVEI   0,0\r
 567         ADD     TP,[4,,4]\r
 568         JRST    NFL2            ; GO CLOBBER IT AWAY\r
 569 ]\r
 570 \f\r
 571 \r
 572 ; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD\r
 573 \r
 574 FLSSP:  HRRZ    0,-1(TP)        ; GET CHR COUNNT\r
 575         JUMPE   0,CPOPJ         ; FINISHED STRING\r
 576 FLSS1:  MOVE    B,(TP)          ; GET BYTR\r
 577         ILDB    C,B             ; GETCHAR\r
 578         CAILE   C,40\r
 579         JRST    FLSS2\r
 580         MOVEM   B,(TP)          ; UPDATE BYTE POINTER\r
 581         SOJN    0,FLSS1\r
 582 \r
 583 FLSS2:  HRRM    0,-1(TP)        ; UPDATE STRING\r
 584         POPJ    P,\r
 585 \r
 586 IFN ITS,[\r
 587 ;TABLE FOR STFUFFING SIXBITS AWAY\r
 588 \r
 589 SIXTBL: S.NM1(D)\r
 590         S.NM2(D)\r
 591         S.DEV(D)\r
 592         S.SNM(D)\r
 593         S.X1(D)\r
 594 ]\r
 595 \r
 596 RDTBL:  RDEVIC(B)\r
 597         RNAME1(B)\r
 598         RNAME2(B)\r
 599         RSNAME(B)\r
 600 \r
 601 \r
 602 \f\r
 603 IFE ITS,[\r
 604 \r
 605 ; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING)\r
 606 \r
 607 RGPRS:  MOVEI   0,NOSTOR\r
 608 \r
 609 RGPARS: HRLM    0,(P)           ; SAVE FOR STORE CHECKING\r
 610         CAMGE   AB,[-7,,]       ; MULTI-STRING CASE POSSIBLE?\r
 611         JRST    TN.MLT          ; YES, GO PROCESS\r
 612 RGPRSS: GETYP   0,(AB)          ; CHECK ARG TYPE\r
 613         CAIE    0,TCHSTR\r
 614         JRST    WRONGT          ; FOR NOW ONLY STRING ARGS WIN\r
 615         PUSH    TP,(AB)\r
 616         PUSH    TP,1(AB)\r
 617         PUSHJ   P,FLSSP         ; FLUSH LEADING SPACES\r
 618         PUSHJ   P,RGPRS1\r
 619         ADD     AB,[2,,2]\r
 620 CHKLST: JUMPGE  AB,CPOPJ1\r
 621         SKIPGE  (P)             ; IF FROM OPEN, ALLOW ONE MORE\r
 622         POPJ    P,\r
 623         PMOVEM  (AB),T.XT(TB)\r
 624         ADD     AB,[2,,2]\r
 625         JUMPL   AB,TMA\r
 626 CPOPJ1: AOS     (P)\r
 627         POPJ    P,\r
 628 \r
 629 RGPRS1: PUSH    P,[0]           ; ALLOW A DEVICE SPEC\r
 630 TN.SNM: MOVE    A,(TP)\r
 631         HRRZ    0,-1(TP)\r
 632         JUMPE   0,RPDONE\r
 633         ILDB    A,A\r
 634         CAIE    A,"<            ; START "DIRECTORY" ?\r
 635         JRST    TN.N1           ; NO LOOK FOR NAME1\r
 636         SETOM   (P)             ; DEV NOT ALLOWED\r
 637         IBP     (TP)            ; SKIP CHAR\r
 638         SOS     -1(TP)\r
 639         PUSHJ   P,TN.CNT        ; COUNT CHARS TO ">"\r
 640         JUMPE   B,ILLNAM        ; RAN OUT\r
 641         CAIE    A,">            ; SKIP IF WINS\r
 642         JRST    ILLNAM\r
 643         PUSHJ   P,TN.CPS        ; COPY TO NEW STRING\r
 644         MOVEM   A,T.SNM(TB)\r
 645         MOVEM   B,T.SNM+1(TB)\r
 646 \r
 647 TN.N1:  PUSHJ   P,TN.CNT\r
 648         JUMPE   B,RPDONE\r
 649         CAIE    A,":            ; GOT A DEVICE\r
 650         JRST    TN.N11\r
 651         SKIPE   (P)\r
 652         JRST    ILLNAM\r
 653         SETOM   (P)\r
 654         PUSHJ   P,TN.CPS\r
 655         MOVEM   A,T.DEV(TB)\r
 656         MOVEM   B,T.DEV+1(TB)\r
 657         JRST    TN.SNM          ; NOW LOOK FOR SNAME\r
 658 \r
 659 TN.N11: CAIE    A,">\r
 660         CAIN    A,"<\r
 661         JRST    ILLNAM\r
 662         MOVEM   A,(P)           ; SAVE END CHAR\r
 663         PUSHJ   P,TN.CPS        ; GEN STRING\r
 664         MOVEM   A,T.NM1(TB)\r
 665         MOVEM   B,T.NM1+1(TB)\r
 666 \r
 667 TN.N2:  SKIPN   A,(P)           ; GET CHAR BACK\r
 668         JRST    RPDONE\r
 669         CAIN    A,";            ; START VERSION?\r
 670         JRST    .+3\r
 671         CAIE    A,".            ; START NAME2?\r
 672         JRST    ILLNAM          ; I GIVE UP!!!\r
 673         HRRZ    B,-1(TP)        ; GET RMAINS OF STRING\r
 674         PUSHJ   P,TN.CPS        ; AND COPY IT\r
 675         MOVEM   A,T.NM2(TB)\r
 676         MOVEM   B,T.NM2+1(TB)\r
 677 RPDONE: SUB     P,[1,,1]        ; FLUSH TEMP\r
 678         SUB     TP,[2,,2]\r
 679 CPOPJ:  POPJ    P,\r
 680 \r
 681 TN.CNT: HRRZ    0,-1(TP)        ; CHAR COUNT\r
 682         MOVE    C,(TP)          ; BPTR\r
 683         MOVEI   B,0             ; INIT COUNT TO 0\r
 684 \r
 685 TN.CN1: MOVEI   A,0             ; IN CASE RUN OUT\r
 686         SOJL    0,CPOPJ         ; RUN OUT?\r
 687         ILDB    A,C             ; TRY ONE\r
 688         CAIE    A,"\16            ; TNEX FILE QUOTE?\r
 689         JRST    TN.CN2\r
 690         SOJL    0,CPOPJ\r
 691         IBP     C               ; SKIP QUOTED CHAT\r
 692         ADDI    B,2\r
 693         JRST    TN.CN1\r
 694 \r
 695 TN.CN2: CAIE    A,"<\r
 696         CAIN    A,">\r
 697         POPJ    P,\r
 698 \r
 699         CAIE    A,".\r
 700         CAIN    A,";\r
 701         POPJ    P,\r
 702         CAIN    A,":\r
 703         POPJ    P,\r
 704         AOJA    B,TN.CN1\r
 705 \r
 706 TN.CPS: PUSH    P,B             ; # OF CHARS\r
 707         MOVEI   A,4(B)          ; ADD 4 TO B IN A\r
 708         IDIVI   A,5\r
 709         PUSHJ   P,IBLOCK        ; GET BLOCK OF WORDS FOR STRING\r
 710 \r
 711         POP     P,C             ; CHAR COUNT BACK\r
 712         HRLI    B,440700\r
 713         MOVSI   A,TCHSTR\r
 714         HRRI    A,(C)           ; CHAR STRING\r
 715         MOVE    D,B             ; COPY BYTER\r
 716 \r
 717         JUMPE   C,CPOPJ\r
 718         ILDB    0,(TP)          ; GET CHAR\r
 719         IDPB    0,D             ; AND STROE\r
 720         SOJG    C,.-2\r
 721 \r
 722         MOVNI   C,(A)           ; - LENGTH TO C\r
 723         ADDB    C,-1(TP)        ; DECREMENT WORDS COUNT\r
 724         TRNN    C,-1            ; SKIP IF EMPTY\r
 725         POPJ    P,\r
 726         IBP     (TP)\r
 727         SOS     -1(TP)          ; ELSE FLUSH TERMINATOR\r
 728         POPJ    P,\r
 729 \r
 730 ILLNAM: PUSH    TP,$TATOM\r
 731         PUSH    TP,EQUOTE ILLEGAL-TENEX-FILE-NAME\r
 732         JRST    CALER1\r
 733 \r
 734 TN.MLT: MOVEI   A,(AB)\r
 735         HRLI    A,-10\r
 736 \r
 737 TN.ML1: GETYP   0,(A)\r
 738         CAIE    0,TFIX\r
 739         CAIN    0,TCHSTR\r
 740         JRST    .+2\r
 741         JRST    RGPRSS          ; ASSUME SINGLE STRING \r
 742         ADD     A,[2,,2]\r
 743         JUMPL   A,TN.ML1\r
 744 \r
 745         MOVEI   A,T.NM1(TB)\r
 746         HRLI    A,(AB)\r
 747         BLT     A,T.SNM+1(TB)   ; BLT 'EM IN\r
 748         ADD     AB,[10,,10]     ; SKIP THESE GUYS\r
 749         JRST    CHKLST\r
 750 \r
 751 ]\r
 752 \f\r
 753 \r
 754 ; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE.  NAMES ARE ASSUMED TO ALREADY\r
 755 ; BE ON BOTH TP STACK AND P STACK\r
 756 \r
 757 OPNCH:  MOVE    C,T.SPDL+1(TB)  ; GET PDL BASE\r
 758         HRRZ    A,S.DIR(C)\r
 759         ANDI    A,1             ; JUST WANT I AND O\r
 760         HRLM    A,S.DEV(C)\r
 761 ;       .TRANS  S.DEV(C)        ; UNDO ANY TRANSLATIONS\r
 762 ;       JRST    TRLOST          ; COMPLAIN\r
 763 \r
 764         HRRZ    A,S.DEV(C)      ; GET SIXBIT DEVICE CODE\r
 765         MOVEI   E,(A)           ; COPY TO E\r
 766         ANDI    E,777700        ; WITHOUT LAST\r
 767         MOVEI   D,(E)           ; AND D\r
 768         ANDI    D,770000        ; WITH JUST LETTER\r
 769         MOVSI   B,-NDEVS        ; AOBJN COUNTER\r
 770 \r
 771 DEVLP:  HRRZ    0,DEVS(B)       ; GET ONE\r
 772         CAIN    0,(A)           ; FULL DEV?\r
 773         JRST    DISPA\r
 774         CAIN    0,(D)           ; ONE LETTER\r
 775         JRST    CH2DIG\r
 776         CAIN    0,(E)           ; 2 LTTERS\r
 777         JRST    CH1DIG\r
 778 NXTDEV: AOBJN   B,DEVLP         ; LOOP THRU\r
 779 \r
 780 IFN ITS,[\r
 781 OUSR:   HRRZ    A,S.DIR(C)      ; BLOCK OR UNIT?\r
 782         TRNE    A,2             ; SKIP IF UNIT\r
 783         JRST    ODSK\r
 784         PUSHJ   P,OPEN1         ; OPEN IT\r
 785         PUSHJ   P,FIXREA        ; AND READCHST IT\r
 786         MOVE    B,T.CHAN+1(TB)  ; RESTORE CHANNEL\r
 787         MOVE    0,[PUSHJ P,DOIOT]       ; GET AN IOINS\r
 788         MOVEM   0,IOINS(B)\r
 789         MOVE    C,T.SPDL+1(TB)\r
 790         HRRZ    A,S.DIR(C)\r
 791         TRNN    A,1\r
 792         JRST    EOFMAK\r
 793         MOVEI   0,80.\r
 794         MOVEM   0,LINLN(B)\r
 795         JRST    OPNWIN\r
 796 \r
 797 OSTY:   HLRZ    A,S.DEV(C)\r
 798         IORI    A,10            ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT)\r
 799         HRLM    A,S.DEV(C)\r
 800         JRST    OUSR\r
 801 ]\r
 802 IFE ITS,[\r
 803         PUSH    TP,$TATOM\r
 804         PUSH    TP,EQUOTE NO-SUCH-DEVICE?\r
 805         JRST    CALER1\r
 806 ]\r
 807 \r
 808 ; MAKE SURE DIGITS EXIST\r
 809 \r
 810 CH2DIG: LDB     0,[60600,,A]\r
 811         CAIG    0,'9            ; CHECK DIGITNESS\r
 812         CAIGE   0,'0\r
 813         JRST    NXTDEV          ; LOSER\r
 814 \r
 815 CH1DIG: LDB     0,[600,,A]      ; LAST CHAR\r
 816         CAIG    0,'9\r
 817         CAIGE   0,'0\r
 818         JRST    NXTDEV\r
 819 \r
 820 ; HERE TO DISPATCH IF SUCCESSFUL\r
 821 \r
 822 DISPA:  HLRZ    B,DEVS(B)\r
 823 IFN ITS,[\r
 824         HRRZ    A,S.DIR(C)      ; GET DIR OF OPEN\r
 825         CAIN    A,5             ; IS IT DISPLAY\r
 826         CAIN    B,ODIS          ; BETTER BE OPENING DISPLAY\r
 827         JRST    (B)             ; GO TO HANDLER\r
 828         JRST    WRONGD\r
 829 ]\r
 830 IFE ITS,        JRST    (B)\r
 831 \r
 832 \f\r
 833 IFN ITS,[\r
 834 \r
 835 ; DISK DEVICE OPNER COME HERE\r
 836 \r
 837 ODSK:   MOVE    A,S.SNM(C)      ; GET SNAME\r
 838         .SUSET  [.SSNAM,,A]     ; CLOBBER IT\r
 839         PUSHJ   P,OPEN0         ; DO REAL LIVE OPEN\r
 840 ]\r
 841 IFE ITS,[\r
 842 \r
 843 ; TENEX DISK FILE OPENER\r
 844 \r
 845 ODSK:   MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL\r
 846         PUSHJ   P,STSTK         ; EXPAND STRING ONTO STACK (E POINTS TO OLD P)\r
 847         MOVE    A,DIRECT-1(B)\r
 848         MOVE    B,DIRECT(B)\r
 849         PUSHJ   P,STRTO6        ; GET DIR NAME\r
 850         POP     P,C\r
 851         MOVE    D,T.SPDL+1(TB)\r
 852         HRRZ    D,S.DIR(D)\r
 853         CAMN    C,[SIXBIT /PRINTO/]\r
 854         IORI    D,100           ; TURN ON BIT TO SAY USE OLD FILE\r
 855         MOVSI   A,101           ; START SETTING UP BITS EXTRA BIT FOR MSB\r
 856         TRNE    D,1             ; SKIP IF INPUT\r
 857         TRNE    D,100           ; WITE OVER?\r
 858         TLOA    A,100000        ; FORCE NEW VERSION\r
 859         TLO     A,400000        ; FORCE OLD\r
 860         HRROI   B,1(E)          ; POIT TO STRING\r
 861         GTJFN\r
 862         TDZA    0,0             ; SAVE FACT OF NO SKIP\r
 863         MOVEI   0,1             ; INDICATE SKIPPED\r
 864         MOVE    P,E             ; RESTORE PSTACK\r
 865         JUMPE   0,GTJLOS        ; FIND OUT WHAT HAPPENED\r
 866 \r
 867         MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL\r
 868         HRRZM   A,CHANNO(B)     ; SAVE IT\r
 869         ANDI    A,-1            ; READ Y TO DO OPEN\r
 870         MOVSI   B,440000        ; USE 36. BIT BYES\r
 871         HRRI    B,200000        ; ASSUME READ\r
 872         TRNE    D,1             ; SKIP IF READ\r
 873         HRRI    B,300000        ; WRITE BIT\r
 874         HRRZ    0,FSAV(TB)              ; SEE IF REF DATE HACK\r
 875         CAIN    0,NFOPEN\r
 876         TRO     B,400           ; SET DON'T MUNG REF DATE BIT\r
 877         OPENF\r
 878         JRST    OPFLOS\r
 879         MOVEI   0,C.OPN+C.READ\r
 880         TRNE    D,1             ; SKIP FOR READ\r
 881         MOVEI   0,C.OPN+C.PRIN\r
 882         MOVE    B,T.CHAN+1(TB)\r
 883         HRRM    0,-4(B)         ; MUNG THOSE BITS\r
 884         ASH     A,1             ; POINT TO SLOT\r
 885         ADDI    A,CHNL0(TVP)    ; TO REAL SLOT\r
 886         MOVEM   B,1(A)          ; SAVE CHANNEL\r
 887         PUSHJ   P,TMTNXS        ; GET STRING FROM TENEX\r
 888         MOVE    B,CHANNO(B)     ; JFN TO A\r
 889         HRROI   A,1(E)          ; BASE OF STRING\r
 890         MOVE    C,[111111,,140001]      ; WEIRD CONTROL BITS\r
 891         JFNS                    ; GET STRING\r
 892         MOVEI   B,1(E)          ; POINT TO START OF STRING\r
 893         SUBM    P,E             ; RELATIVIZE E\r
 894         PUSHJ   P,TNXSTR        ; MAKE INTO A STRING\r
 895         SUB     P,E             ; BACK TO NORMAL\r
 896         PUSH    TP,A\r
 897         PUSH    TP,B\r
 898         PUSHJ   P,RGPRS1        ; PARSE INTO FIELDS\r
 899         MOVE    B,T.CHAN+1(TB)\r
 900         MOVEI   C,RNAME1-1(B)\r
 901         HRLI    C,T.NM1(TB)\r
 902         BLT     C,RSNAME(B)\r
 903         JRST    OPBASC\r
 904 OPFLOS: MOVEI   C,(A)           ; SAVE ERROR CODE\r
 905         MOVE    B,T.CHAN+1(TB)\r
 906         HRRZ    A,CHANNO(B)     ; JFN BACK TO A\r
 907         RLJFN                   ; TRY TO RELEASE IT\r
 908         JFCL\r
 909         MOVEI   A,(C)           ; ERROR CODE BACK TO A\r
 910 \r
 911 GTJLOS: PUSHJ   P,TGFALS        ; GET A FALSE WITH REASON\r
 912         JRST    OPNRET\r
 913 \r
 914 STSTK:  PUSH    TP,$TCHAN\r
 915         PUSH    TP,B\r
 916         MOVEI   A,4+5           ; COUNT CHARS NEEDED (NEED LAST 0 BYTE)\r
 917         MOVE    B,(TP)\r
 918         ADD     A,RDEVIC-1(B)\r
 919         ADD     A,RNAME1-1(B)\r
 920         ADD     A,RNAME2-1(B)\r
 921         ADD     A,RSNAME-1(B)\r
 922         ANDI    A,-1            ; TO 18 BITS\r
 923         IDIVI   A,5             ; TO WORDS NEEDED\r
 924         POP     P,C             ; SAVE RET ADDR\r
 925         MOVE    E,P             ; SAVE POINTER\r
 926         PUSH    P,[0]           ; ALOCATE SLOTS\r
 927         SOJG    A,.-1\r
 928         PUSH    P,C             ; RET ADDR BACK\r
 929         INTGO                   ; IN CASE OVERFLEW\r
 930         MOVE    B,(TP)          ; IN CASE GC'D\r
 931         MOVE    D,[440700,,1(E)]        ; BYTE POINTER TO IT\r
 932         MOVEI   A,RDEVIC-1(B)\r
 933         PUSHJ   P,MOVSTR        ; FLUSH IT ON\r
 934         MOVEI   A,":\r
 935         IDPB    A,D\r
 936         HRRZ    A,RSNAME-1(B)   ; ANY SNAME AT ALL?\r
 937         JUMPE   A,ST.NM1        ; NOPE, CANT HACK WITH IT\r
 938         MOVEI   A,"<\r
 939         IDPB    A,D\r
 940         MOVEI   A,RSNAME-1(B)\r
 941         PUSHJ   P,MOVSTR        ; SNAME UP\r
 942         MOVEI   A,">\r
 943         IDPB    A,D\r
 944         MOVEI   A,RNAME1-1(B)\r
 945         PUSHJ   P,MOVSTR\r
 946         MOVEI   A,".\r
 947         IDPB    A,D\r
 948 ST.NM1: MOVEI   A,RNAME2-1(B)\r
 949         PUSHJ   P,MOVSTR\r
 950         SUB     TP,[2,,2]\r
 951         POPJ    P,\r
 952 \r
 953 MOVSTR: HRRZ    0,(A)           ; CHAR COUNT\r
 954         MOVE    A,1(A)          ; BYTE POINTER\r
 955         SOJL    0,CPOPJ\r
 956         ILDB    C,A             ; GET CHAR\r
 957         IDPB    C,D             ; MUNG IT UP\r
 958         JRST    .-3\r
 959 \r
 960 ; MAKE A TENEX ERROR MESSAGE STRING\r
 961 \r
 962 TGFALS: PUSH    P,A             ; SAVE ERROR CODE\r
 963         PUSHJ   P,TMTNXS        ; STRING ON STACK\r
 964         HRROI   A,1(E)          ; POINT TO SPACE\r
 965         MOVE    B,(E)           ; ERROR CODE\r
 966         HRLI    B,400000        ; FOR ME\r
 967         MOVSI   C,-100.         ; MAX CHARS\r
 968         ERSTR                   ; GET TENEX STRING\r
 969         JRST    TGFLS1\r
 970         JRST    TGFLS1\r
 971 \r
 972         MOVEI   B,1(E)          ; A AND B BOUND STRING\r
 973         SUBM    P,E             ; RELATIVIZE E\r
 974         PUSHJ   P,TNXSTR        ; BUILD STRING\r
 975         SUB     P,E             ; P BACK TO NORMAL\r
 976 TGFLS2: SUB     P,[1,,1]        ; FLUSH ERROR CODE SLOT\r
 977         MOVE    C,A\r
 978         MOVE    D,B\r
 979         PUSHJ   P,INCONS        ; BUILD LIST\r
 980         MOVSI   A,TFALSE        ; MAKE IT FALSE\r
 981         POPJ    P,\r
 982 \r
 983 TGFLS1: MOVE    P,E             ; RESET STACK\r
 984         MOVE    A,$TCHSTR\r
 985         MOVE    B,CHQUOTE UNKNOWN PROBLEM IN I/O\r
 986         JRST    TGFLS2\r
 987 \r
 988 ]\r
 989 ; OTHER BUFFERED DEVICES JOIN HERE\r
 990 \r
 991 OPDSK1:\r
 992 IFN ITS,[\r
 993         PUSHJ   P,FIXREA        ; STORE THE "REAL" NAMES INTO THE CHANNEL\r
 994 ]\r
 995 OPBASC: MOVE    C,T.SPDL+1(TB)  ; C WAS CLOBBERED, GET IT BACK\r
 996         HRRZ    A,S.DIR(C)      ; FIND OUT IF OPEN IS ASCII OR WORD\r
 997         TRZN    A,2             ; SKIP IF BINARY\r
 998         PUSHJ   P,OPASCI        ; DO IT FOR ASCII\r
 999 \r
1000 ; NOW SET UP IO INSTRUCTION FOR CHANNEL\r
1001 \r
1002 MAKION: MOVE    B,T.CHAN+1(TB)\r
1003         MOVEI   C,GETCHR\r
1004         JUMPE   A,MAKIO1        ; JUMP IF INPUT\r
1005         MOVEI   C,PUTCHR        ; ELSE GET INPUT\r
1006         MOVEI   0,80.           ; DEFAULT LINE LNTH\r
1007         MOVEM   0,LINLN(B)\r
1008         MOVSI   0,TFIX\r
1009         MOVEM   0,LINLN-1(B)\r
1010 MAKIO1:\r
1011         HRLI    C,(PUSHJ P,)\r
1012         MOVEM   C,IOINS(B)      ; STORE IT\r
1013         JUMPN   A,OPNWIN        ; GET AN EOF FORM FOR INPUT CHANNEL\r
1014 \r
1015 ; HERE TO CONS UP <ERROR END-OF-FILE>\r
1016 \r
1017 EOFMAK: MOVSI   C,TATOM\r
1018         MOVE    D,EQUOTE END-OF-FILE\r
1019         PUSHJ   P,INCONS\r
1020         MOVEI   E,(B)\r
1021         MOVSI   C,TATOM\r
1022         MOVE    D,IMQUOTE ERROR\r
1023         PUSHJ   P,ICONS\r
1024         MOVE    D,T.CHAN+1(TB)  ; RESTORE CHANNEL\r
1025         MOVSI   0,TFORM\r
1026         MOVEM   0,EOFCND-1(D)\r
1027         MOVEM   B,EOFCND(D)\r
1028 \r
1029 OPNWIN: MOVEI   0,10.           ; SET UP RADIX\r
1030         MOVSI   A,TCHAN         ; OPEN SUCCEEDED, RET CHANNEL\r
1031         MOVE    B,T.CHAN+1(TB)\r
1032         MOVEM   0,RADX(B)\r
1033 \r
1034 OPNRET: MOVE    C,(P)           ; RET ADDR\r
1035         SUB     P,[S.X3+2,,S.X3+2]\r
1036         SUB     TP,[T.CHAN+2,,T.CHAN+2]\r
1037         JRST    (C)\r
1038 \f\r
1039 \r
1040 ; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O\r
1041 \r
1042 OPASCI: PUSH    P,A             ; CONTAINS MODE, SAVE IT\r
1043         MOVEI   A,BUFLNT        ; GET SIZE  OF BUFFER\r
1044         PUSHJ   P,IBLOCK        ; GET STORAGE\r
1045         MOVSI   0,TWORD+.VECT.  ; SET UTYPE\r
1046         MOVEM   0,BUFLNT(B)     ; AND STORE\r
1047         MOVSI   A,TCHSTR\r
1048         SKIPE   (P)             ; SKIP IF INPUT\r
1049         JRST    OPASCO\r
1050         MOVEI   D,BUFLNT(B)     ; REST BYTE POINTER\r
1051 OPASCA: HRLI    D,440700\r
1052         MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL BACK\r
1053         MOVEI   0,C.BUF\r
1054         IORM    0,-4(B)         ; TURN ON BUFFER BIT\r
1055         MOVEM   A,BUFSTR-1(B)\r
1056         MOVEM   D,BUFSTR(B)     ; CLOBBER\r
1057         POP     P,A\r
1058         POPJ    P,\r
1059 \r
1060 OPASCO: HRROI   C,777776\r
1061         MOVEM   C,(B)           ; -1 THE BUFFER (LEAVE OFF LOW BIT)\r
1062         MOVSI   C,(B)\r
1063         HRRI    C,1(B)          ; BUILD BLT POINTER\r
1064         BLT     C,BUFLNT-1(B)   ; ZAP\r
1065         MOVEI   D,(B)           ; START MAKING STRING POINTER\r
1066         HRRI    A,BUFLNT*5      ; SET UP CHAR COUNT\r
1067         JRST    OPASCA\r
1068 \f\r
1069 \r
1070 ; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.)\r
1071 \r
1072 ONUL:\r
1073 OPTP:\r
1074 OPTR:   PUSHJ   P,OPEN0         ; SET UP MODE AND OPEN\r
1075         SETZM   S.NM1(C)        ; CLOBBER UNINTERESTING FIELDS\r
1076         SETZM   S.NM2(C)\r
1077         SETZM   S.SNM(C)\r
1078         JRST    OPDSK1\r
1079 \r
1080 ; OPEN DEVICES THAT IGNORE SNAME\r
1081 \r
1082 OUTN:   PUSHJ   P,OPEN0\r
1083         SETZM   S.SNM(C)\r
1084         JRST    OPDSK1\r
1085 \r
1086 ; OPEN THE DISPLAY DEVICE\r
1087 \r
1088 ODIS:   MOVEI   B,T.DIR(TB)     ; GET CHANNEL\r
1089         PUSHJ   P,CHRWRD        ; TO ASCII\r
1090         JFCL\r
1091         MOVE    E,B             ; DIR TO E\r
1092         MOVE    B,T.CHAN+1(TB)  ; CHANNEL\r
1093         MOVE    0,[PUSHJ P,DCHAR]       ; IOINS\r
1094         CAIN    A,1\r
1095         MOVEM   0,IOINS(B)\r
1096         PUSHJ   P,DISOPN\r
1097         JRST    DISLOS          ; LOSER\r
1098 \r
1099         MOVE    D,T.CHAN+1(TB)  ; GET CHANNEL\r
1100         MOVEI   0,C.OPN+C.PRIN\r
1101         HRRM    0,-4(D)\r
1102         MOVEM   A,DISINF-1(D)   ; AND STORE\r
1103         MOVEM   B,DISINF(D)\r
1104         SETZM   CHANNO(D)       ; NO REAL CHANNEL\r
1105         MOVEI   0,DISLNL\r
1106         MOVEM   0,LINLN(D)\r
1107         MOVEI   0,DISPGL\r
1108         MOVEM   0,PAGLN(D)\r
1109         MOVEI   0,10.           ; SET RADIX\r
1110         MOVEM   0,RADX(D)\r
1111         JRST    SAVCHN          ; ADD TO CHANNEL LIST\r
1112 \f\r
1113 \r
1114 ; INTERNAL CHANNEL OPENER\r
1115 \r
1116 OINT:   HRRZ    A,S.DIR(C)      ; CHECK DIR\r
1117         CAIL    A,2             ; READ/PRINT?\r
1118         JRST    WRONGD          ; NO, LOSE\r
1119 \r
1120         MOVE    0,INTINS(A)     ; GET INS\r
1121         MOVE    D,T.CHAN+1(TB)  ; AND CHANNEL\r
1122         MOVEM   0,IOINS(D)      ; AND CLOBBER\r
1123         MOVEI   0,C.OPN+C.READ\r
1124         TRNE    A,1\r
1125         MOVEI   0,C.OPN+C.PRIN\r
1126         HRRM    0,-4(D)\r
1127         SETOM   STATUS(D)       ; MAKE SURE NOT AA TTY\r
1128         PMOVEM  T.XT(TB),INTFCN-1(D)\r
1129 \r
1130 ; HERE TO SAVE PSEUDO CHANNELS\r
1131 \r
1132 SAVCHN: HRRZ    E,CHNL0+1(TVP)  ; POINT TO CURRENT LIST\r
1133         MOVSI   C,TCHAN\r
1134         PUSHJ   P,ICONS         ; CONS IT ON\r
1135         HRRZM   B,CHNL0+1(TVP)\r
1136         JRST    OPNWIN\r
1137 \r
1138 ; INT DEVICE I/O INS\r
1139 \r
1140 INTINS: PUSHJ   P,GTINTC\r
1141         PUSHJ   P,PTINTC\r
1142 \f\r
1143 \r
1144 ; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET)\r
1145 \r
1146 IFN ITS,[\r
1147 ONET:   HRRZ    A,S.DIR(C)      ; DIRECTION CODE\r
1148         CAILE   A,1             ; ASCII ?\r
1149         IORI    A,4             ; TURN ON IMAGE BIT\r
1150         SKIPGE  S.NM1(C)        ; NAME1 I.E. LOCAL HOST GIVEN\r
1151         IORI    A,10            ; NO, WE WILL LET ITS GIVE US ONE\r
1152         SKIPGE  S.NM2(C)        ; NORMAL OR "LISTEN"\r
1153         IORI    A,20            ; TURN ON LISTEN BIT\r
1154         MOVEI   0,7             ; DEFAULT BYTE SIZE\r
1155         TRNE    A,2             ; UNLESS\r
1156         MOVEI   0,36.           ; IMAGE WHICH IS 36\r
1157         SKIPN   T.XT(TB)        ; BYTE SIZE GIVEN?\r
1158         MOVEM   0,S.X1(C)       ; NO, STORE DEFAULT\r
1159         SKIPG   D,S.X1(C)       ; BYTE SIZE REASONABLE?\r
1160         JRST    RBYTSZ          ; NO <0, COMPLAIN\r
1161         TRNE    A,2             ; SKIP TO CHECK ASCII\r
1162         JRST    ONET2           ; CHECK IMAGE\r
1163         CAIN    D,7             ; 7-BIT WINS\r
1164         JRST    ONET1\r
1165         CAIE    D,44            ; 36-BIT INDICATES BLOCK ASCII MODE\r
1166         JRST    .+3\r
1167         IORI    A,2             ; SET BLOCK FLAG\r
1168         JRST    ONET1\r
1169         IORI    A,40            ; USE 8-BIT MODE\r
1170         CAIN    D,10            ; IS IT RIGHT\r
1171         JRST    ONET1           ; YES\r
1172 ]\r
1173 \r
1174 RBYTSZ: PUSH    TP,$TATOM       ; CALL ERROR\r
1175         PUSH    TP,EQUOTE BYTE-SIZE-BAD\r
1176         JRST    CALER1\r
1177 \r
1178 IFN ITS,[\r
1179 ONET2:  CAILE   D,36.           ; IMAGE SIZE REASONABLE?\r
1180         JRST    RBYTSZ          ; NO\r
1181         CAIN    D,36.           ; NORMAL\r
1182         JRST    ONET1           ; YES, DONT SET FIELD\r
1183 \r
1184         ASH     D,9.            ; POSITION FOR FIELD\r
1185         IORI    A,40(D)         ; SET IT AND ITS BIT\r
1186 \r
1187 ONET1:  HRLM    A,S.DEV(C)      ; CLOBBER OPEN BLOCK\r
1188         MOVE    E,A             ; SAVE BLOCK MODE INFO\r
1189         PUSHJ   P,OPEN1         ; DO THE OPEN\r
1190         PUSH    P,E\r
1191 \r
1192 ; CLOBBER REAL SLOTS FOR THE OPEN\r
1193 \r
1194         MOVEI   A,3             ; GET STATE VECTOR\r
1195         PUSHJ   P,IBLOCK\r
1196         MOVSI   A,TUVEC\r
1197         MOVE    D,T.CHAN+1(TB)\r
1198         MOVEM   A,BUFRIN-1(D)\r
1199         MOVEM   B,BUFRIN(D)\r
1200         MOVSI   A,TFIX+.VECT.   ; SET U TYPE\r
1201         MOVEM   A,3(B)\r
1202         MOVE    C,T.SPDL+1(TB)\r
1203         MOVE    B,T.CHAN+1(TB)\r
1204 \r
1205         PUSHJ   P,INETST                ; GET STATE\r
1206 \r
1207         POP     P,A             ; IS THIS BLOCK MODE\r
1208         MOVEI   0,80.           ; POSSIBLE LINE LENGTH\r
1209         TRNE    A,1             ; SKIP IF INPUT\r
1210         MOVEM   0,LINLN(B)\r
1211         TRNN    A,2             ; BLOCK MODE?\r
1212         JRST    .+3\r
1213         TRNN    A,4             ; ASCII MODE?\r
1214         JRST    OPBASC  ; GO SETUP BLOCK ASCII\r
1215         MOVE    0,[PUSHJ P,DOIOT]\r
1216         MOVEM   0,IOINS(B)\r
1217 \r
1218         JRST    OPNWIN\r
1219 \r
1220 ; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL\r
1221 \r
1222 INETST: MOVE    A,S.NM1(C)\r
1223         MOVEM   A,RNAME1(B)\r
1224         MOVE    A,S.NM2(C)\r
1225         MOVEM   A,RNAME2(B)\r
1226         LDB     A,[1100,,S.SNM(C)]\r
1227         MOVEM   A,RSNAME(B)\r
1228 \r
1229         MOVE    E,BUFRIN(B)             ; GET STATE BLOCK\r
1230 INTST1: HRRE    0,S.X1(C)\r
1231         MOVEM   0,(E)\r
1232         ADDI    C,1\r
1233         AOBJN   E,INTST1\r
1234 \r
1235         POPJ    P,\r
1236 \f\r
1237 \r
1238 ; ACCEPT A CONNECTION\r
1239 \r
1240 MFUNCTION NETACC,SUBR\r
1241 \r
1242         PUSHJ   P,ARGNET        ; CHECK THAT ARG IS AN OPEN NET CHANNEL\r
1243         MOVE    A,CHANNO(B)     ; GET CHANNEL\r
1244         LSH     A,23.           ; TO AC FIELD\r
1245         IOR     A,[.NETACC]\r
1246         XCT     A\r
1247         JRST    IFALSE          ; RETURN FALSE\r
1248 NETRET: MOVE    A,(AB)\r
1249         MOVE    B,1(AB)\r
1250         JRST    FINIS\r
1251 \r
1252 ; FORCE SYSTEM NETWORK BUFFERS TO BE SENT\r
1253 \r
1254 MFUNCTION NETS,SUBR\r
1255 \r
1256         PUSHJ   P,ARGNET\r
1257         CAME    A,MODES+1\r
1258         CAMN    A,MODES+3\r
1259         SKIPA   A,CHANNO(B)     ; GET CHANNEL\r
1260         JRST    WRONGD\r
1261         LSH     A,23.\r
1262         IOR     A,[.NETS]\r
1263         XCT     A\r
1264         JRST    NETRET\r
1265 \r
1266 ; SUBR TO RETURN UPDATED NET STATE\r
1267 \r
1268 MFUNCTION NETSTATE,SUBR\r
1269 \r
1270         PUSHJ   P,ARGNET        ; IS IT A NET CHANNEL\r
1271         PUSHJ   P,INSTAT\r
1272         JRST    FINIS\r
1273 \r
1274 ; INTERNAL NETSTATE ROUTINE\r
1275 \r
1276 INSTAT: MOVE    C,P             ; GET PDL BASE\r
1277         MOVEI   0,S.X3          ; # OF SLOTS NEEDED\r
1278         PUSH    P,[0]\r
1279         SOJN    0,.-1\r
1280 \r
1281         MOVEI   D,S.DEV(C)              ; SETUP FOR .RCHST\r
1282         HRL     D,CHANNO(B)\r
1283         .RCHST  D,              ; GET THE GOODS\r
1284 \r
1285         PUSHJ   P,INETST        ; INTO VECTOR\r
1286         SUB     P,[S.X3,,S.X3]\r
1287         MOVE    B,BUFRIN(B)\r
1288         MOVSI   A,TUVEC\r
1289         POPJ    P,\r
1290 ]\r
1291 ; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE\r
1292 \r
1293 ARGNET: ENTRY   1\r
1294         GETYP   0,(AB)\r
1295         CAIE    0,TCHAN\r
1296         JRST    WTYP1\r
1297         MOVE    B,1(AB)         ; GET CHANNEL\r
1298         SKIPN   CHANNO(B)       ; OPEN?\r
1299         JRST    CHNCLS\r
1300         MOVE    A,RDEVIC-1(B)   ; GET DEV NAME\r
1301         MOVE    B,RDEVIC(B)\r
1302         PUSHJ   P,STRTO6\r
1303         POP     P,A\r
1304         CAME    A,[SIXBIT /NET   /]\r
1305         JRST    NOTNET\r
1306         MOVE    B,1(AB)\r
1307         MOVE    A,DIRECT-1(B)   ; CHECK FOR A READ SOCKET\r
1308         MOVE    B,DIRECT(B)\r
1309         PUSHJ   P,STRTO6\r
1310         MOVE    B,1(AB)         ; RESTORE CHANNEL\r
1311         POP     P,A\r
1312         POPJ    P,\r
1313 \f\r
1314 IFE ITS,[\r
1315 \r
1316 ; TENEX NETWRK OPENING CODE\r
1317 \r
1318 ONET:   MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL\r
1319         MOVSI   C,100700\r
1320         HRRI    C,1(P)\r
1321         MOVE    E,P\r
1322         PUSH    P,[ASCII /NET:/]        ; FOR STRINGS\r
1323         GETYP   0,RNAME1-1(B)   ; CHECK TYPE\r
1324         CAIE    0,TFIX          ; SKIP IF # SUPPLIED\r
1325         JRST    ONET1\r
1326         MOVE    0,RNAME1(B)     ; GET IT\r
1327         PUSHJ   P,FIXSTK\r
1328         JFCL\r
1329         JRST    ONET2\r
1330 ONET1:  CAIE    0,TCHSTR\r
1331         JRST    WRONGT\r
1332         HRRZ    0,RNAME1-1(B)\r
1333         MOVE    B,RNAME1(B)\r
1334         JUMPE   0,ONET2\r
1335         ILDB    A,B\r
1336         JSP     D,ONETCH\r
1337         SOJA    0,.-3\r
1338 ONET2:  MOVEI   A,".\r
1339         JSP     D,ONETCH\r
1340         MOVE    B,T.CHAN+1(TB)\r
1341         GETYP   0,RNAME2-1(B)\r
1342         CAIE    0,TFIX\r
1343         JRST    ONET3\r
1344         GETYP   0,RSNAME-1(B)\r
1345         CAIE    0,TFIX\r
1346         JRST    WRONGT\r
1347         MOVE    0,RSNAME(B)\r
1348         PUSHJ   P,FIXSTK\r
1349         JRST    ONET4\r
1350         MOVE    B,T.CHAN+1(TB)\r
1351         MOVEI   A,"-\r
1352         JSP     D,ONETCH\r
1353         MOVE    0,RNAME2(B)\r
1354         PUSHJ   P,FIXSTK\r
1355         JRST    WRONGT\r
1356         JRST    ONET4\r
1357 ONET3:  CAIE    0,TCHSTR\r
1358         JRST    WRONGT\r
1359         HRRZ    0,RNAME2-1(B)\r
1360         MOVE    B,RNAME2(B)\r
1361         JUMPE   0,ONET4\r
1362         ILDB    A,B\r
1363         JSP     D,ONETCH\r
1364         SOJA    0,.-3\r
1365 \r
1366 ONET4:\r
1367 ONET5:  MOVE    B,T.CHAN+1(TB)\r
1368         GETYP   0,RNAME2-1(B)\r
1369         CAIN    0,TCHSTR\r
1370         JRST    ONET6\r
1371         MOVEI   A,";\r
1372         JSP     D,ONETCH\r
1373         MOVEI   A,"T\r
1374         JSP     D,ONETCH\r
1375 ONET6:  MOVSI   A,1\r
1376         HRROI   B,1(E)          ; STRING POINTER\r
1377         GTJFN                   ; GET THE G.D JFN\r
1378         TDZA    0,0             ; REMEMBER FAILURE\r
1379         MOVEI   0,1\r
1380         MOVE    P,E             ; RESTORE P\r
1381         JUMPE   0,GTJLOS        ; CONS UP ERROR STRING\r
1382 \r
1383         MOVE    B,T.CHAN+1(TB)\r
1384         HRRZM   A,CHANNO(B)     ; SAVE THE JFN\r
1385 \r
1386         MOVE    C,T.SPDL+1(TB)\r
1387         MOVE    D,S.DIR(C)\r
1388         MOVEI   B,10\r
1389         TRNE    D,2\r
1390         MOVEI   B,36.\r
1391         SKIPE   T.XT(TB)\r
1392         MOVE    B,T.XT+1(TB)\r
1393         JUMPL   B,RBYTSZ\r
1394         CAILE   B,36.\r
1395         JRST    RBYTSZ\r
1396         ROT     B,-6\r
1397         TLO     B,3400\r
1398         HRRI    B,200000\r
1399         TRNE    D,1             ; SKIP FOR INPUT\r
1400         HRRI    B,100000\r
1401         ANDI    A,-1            ; ISOLATE JFCN\r
1402         OPENF\r
1403         JRST    OPFLOS          ; REPORT ERROR\r
1404         MOVE    B,T.CHAN+1(TB)\r
1405         ASH     A,1             ; POINT TO SLOT\r
1406         ADDI    A,CHNL0(TVP)    ; TO REAL SLOT\r
1407         MOVEM   B,1(A)          ; SAVE CHANNEL\r
1408         MOVE    A,CHANNO(B)\r
1409         CVSKT                   ; GET ABS SOCKET #\r
1410         FATAL NETWORK BITES THE BAG!\r
1411         MOVE    D,B\r
1412         MOVE    B,T.CHAN+1(TB)\r
1413         MOVEM   D,RNAME1(B)\r
1414         MOVSI   0,TFIX\r
1415         MOVEM   0,RNAME1-1(B)\r
1416 \r
1417         MOVSI   0,TFIX\r
1418         MOVEM   0,RNAME2-1(B)\r
1419         MOVEM   0,RSNAME-1(B)\r
1420         MOVE    C,T.SPDL+1(TB)\r
1421         MOVE    C,S.DIR(C)\r
1422         MOVE    0,[PUSHJ P,DONETO]\r
1423         TRNN    C,1             ; SKIP FOR OUTPUT\r
1424         MOVE    0,[PUSHJ P,DONETI]\r
1425         MOVEM   0,IOINS(B)\r
1426         MOVEI   0,80.           ; LINELENGTH\r
1427         TRNE    C,1             ; SKIP FOR INPUT\r
1428         MOVEM   0,LINLN(B)\r
1429         MOVEI   A,3             ; GET STATE UVECTOR\r
1430         PUSHJ   P,IBLOCK\r
1431         MOVSI   0,TFIX+.VECT.\r
1432         MOVEM   0,3(B)\r
1433         MOVE    C,B\r
1434         MOVE    B,T.CHAN+1(TB)\r
1435         MOVEM   C,BUFRIN(B)\r
1436         MOVSI   0,TUVEC\r
1437         MOVEM   0,BUFRIN-1(B)\r
1438         MOVE    A,CHANNO(B)     ; GET JFN\r
1439         GDSTS                   ; GET STATE\r
1440         MOVE    E,T.CHAN+1(TB)\r
1441         MOVEM   D,RNAME2(E)\r
1442         MOVEM   C,RSNAME(E)\r
1443         MOVE    C,BUFRIN(E)\r
1444         MOVEM   B,(C)           ; INITIAL STATE STORED\r
1445         MOVE    B,E\r
1446         JRST    OPNWIN\r
1447 \r
1448 ; DOIOT FOR TENEX NETWRK\r
1449 \r
1450 DONETO: PUSH    P,0\r
1451         MOVE    0,[BOUT]\r
1452         JRST    .+3\r
1453 \r
1454 DONETI: PUSH    P,0\r
1455         MOVE    0,[BIN]\r
1456         PUSH    P,0\r
1457         PUSH    TP,$TCHAN\r
1458         PUSH    TP,B\r
1459         MOVEI   0,(A)           ; POSSIBLE OUTPUT CHAR TO 0\r
1460         MOVE    A,CHANNO(B)\r
1461         MOVE    B,0\r
1462         ENABLE\r
1463         XCT     (P)\r
1464         DISABLE\r
1465         MOVEI   A,(B)           ; RET CHAR IN A\r
1466         MOVE    B,(TP)\r
1467         MOVE    0,-1(P)\r
1468         SUB     P,[2,,2]\r
1469         SUB     TP,[2,,2]\r
1470         POPJ    P,\r
1471         \r
1472 NETPRS: MOVEI   D,0\r
1473         HRRZ    0,(C)\r
1474         MOVE    C,1(C)\r
1475 \r
1476 ONETL:  ILDB    A,C\r
1477         CAIN    A,"#\r
1478         POPJ    P,\r
1479         SUBI    A,60\r
1480         ASH     D,3\r
1481         IORI    D,(A)\r
1482         SOJG    0,ONETL\r
1483         AOS     (P)\r
1484         POPJ    P,\r
1485 \r
1486 FIXSTK: CAMN    0,[-1]\r
1487         POPJ    P,\r
1488         JFFO    0,FIXS3         ; PUT OCTAL DIGITS INTO STIRNG\r
1489         MOVEI   A,"0\r
1490         POP     P,D\r
1491         AOJA    D,ONETCH\r
1492 FIXS3:  IDIVI   A,3\r
1493         MOVEI   B,12.\r
1494         SUBI    B,(A)\r
1495         HRLM    B,(P)\r
1496         IMULI   A,3\r
1497         LSH     0,(A)\r
1498         POP     P,B\r
1499 FIXS2:  MOVEI   A,0\r
1500         ROTC    0,3             ; NEXT DIGIT\r
1501         ADDI    A,60\r
1502         JSP     D,ONETCH\r
1503         SUB     B,[1,,0]\r
1504         TLNN    B,-1\r
1505         JRST    1(B)\r
1506         JRST    FIXS2\r
1507 \r
1508 ONETCH: IDPB    A,C\r
1509         TLNE    C,760000        ; SKIP IF NEW WORD\r
1510         JRST    (D)\r
1511         PUSH    P,[0]\r
1512         JRST    (D)\r
1513 \r
1514 INSTAT: MOVE    E,B\r
1515         MOVE    A,CHANNO(E)\r
1516         GDSTS\r
1517         LSH     B,-32.\r
1518         MOVEM   D,RNAME2(E)     ; UPDATE FOREIGN SOCHKET\r
1519         MOVEM   C,RSNAME(E)     ; AND HOST\r
1520         MOVE    C,BUFRIN(E)\r
1521         XCT     ITSTRN(B)       ; XLATE TO LOOK MORE LIKE ITS\r
1522         MOVEM   B,(C)           ; STORE STATE\r
1523         MOVE    B,E\r
1524         POPJ    P,\r
1525 \r
1526 ITSTRN: MOVEI   B,0\r
1527         JRST    NLOSS\r
1528         JRST    NLOSS\r
1529         MOVEI   B,1\r
1530         MOVEI   B,2\r
1531         JRST    NLOSS\r
1532         MOVEI   B,4\r
1533         PUSHJ   P,NOPND\r
1534         MOVEI   B,0\r
1535         JRST    NLOSS\r
1536         JRST    NLOSS\r
1537         PUSHJ   P,NCLSD\r
1538         MOVEI   B,0\r
1539         JRST    NLOSS\r
1540         MOVEI   B,0\r
1541 \r
1542 NLOSS:  FATAL ILLEGAL NETWORK STATE\r
1543 \r
1544 NOPND:  MOVE    B,DIRECT(E)     ; SEE IF READ OR PRINT\r
1545         ILDB    B,B             ; GET 1ST CHAR\r
1546         CAIE    B,"R            ; SKIP FOR READ\r
1547         JRST    NOPNDW\r
1548         SIBE            ; SEE IF INPUT EXISTS\r
1549         JRST    .+3\r
1550         MOVEI   B,5\r
1551         POPJ    P,\r
1552         MOVEM   B,2(C)          ; STORE BYTES IN STATE VECTOR\r
1553         MOVEI   B,11            ; RETURN DATA PRESENT STATE\r
1554         POPJ    P,\r
1555 \r
1556 NOPNDW: SOBE                    ; SEE IF OUTPUT PRESENT\r
1557         JRST    .+3\r
1558         MOVEI   B,5\r
1559         POPJ    P,\r
1560 \r
1561         MOVEI   B,6\r
1562         POPJ    P,\r
1563 \r
1564 NCLSD:  MOVE    B,DIRECT(E)\r
1565         ILDB    B,B\r
1566         CAIE    B,"R\r
1567         JRST    RET0\r
1568         SIBE\r
1569         JRST    .+2\r
1570         JRST    RET0\r
1571         MOVEI   B,10\r
1572         POPJ    P,\r
1573 \r
1574 RET0:   MOVEI   B,0\r
1575         POPJ    P,\r
1576 \r
1577 \r
1578 MFUNCTION NETSTATE,SUBR\r
1579 \r
1580         PUSHJ   P,ARGNET\r
1581         PUSHJ   P,INSTAT\r
1582         MOVE    B,BUFRIN(B)\r
1583         MOVSI   A,TUVEC\r
1584         JRST    FINIS\r
1585 \r
1586 MFUNCTION NETS,SUBR\r
1587 \r
1588         PUSHJ   P,ARGNET\r
1589         CAME    A,MODES+1       ; PRINT OR PRINTB?\r
1590         CAMN    A,MODES+3\r
1591         SKIPA   A,CHANNO(B)\r
1592         JRST    WRONGD\r
1593         MOVEI   B,21\r
1594         MTOPR\r
1595 NETRET: MOVE    B,1(AB)\r
1596         MOVSI   A,TCHAN\r
1597         JRST    FINIS\r
1598 \r
1599 MFUNCTION NETACC,SUBR\r
1600 \r
1601         PUSHJ   P,ARGNET\r
1602         MOVE    A,CHANNO(B)\r
1603         MOVEI   B,20\r
1604         MTOPR\r
1605         JRST    NETRET\r
1606 \r
1607 ]\r
1608 \f\r
1609 ; HERE TO OPEN TELETYPE DEVICES\r
1610 \r
1611 OTTY:   HRRZ    A,S.DIR(C)      ; GET DIR CODE\r
1612         TRNE    A,2             ; SKIP IF NOT READB/PRINTB\r
1613         JRST    WRONGD          ; CANT DO THAT\r
1614 \r
1615 IFN ITS,[\r
1616         MOVE    A,S.NM1(C)      ; CHECK FOR A DIR\r
1617         MOVE    0,S.NM2(C)\r
1618         CAMN    A,[SIXBIT /.FILE./]\r
1619         CAME    0,[SIXBIT /(DIR)/]\r
1620         SKIPA   E,[-15.*2,,]\r
1621         JRST    OUTN            ; DO IT THAT WAY\r
1622 \r
1623         HRRZ    A,S.DIR(C)      ; CHECK DIR\r
1624         TRNE    A,1\r
1625         JRST    TTYLP2\r
1626         HRRI    E,CHNL1(TVP)\r
1627         PUSH    P,S.DEV(C)      ; SAVE THE SIXBIT DEV NAME\r
1628         HRLZS   (P)             ; POSTITION DEVICE NAME\r
1629 \r
1630 TTYLP:  SKIPN   D,1(E)          ; CHANNEL OPEN?\r
1631         JRST    TTYLP1          ; NO, GO TO NEXT\r
1632         MOVE    A,RDEVIC-1(D)           ; GET DEV NAME\r
1633         MOVE    B,RDEVIC(D)\r
1634         PUSHJ   P,STRTO6        ; TO 6 BIT\r
1635         POP     P,A             ; GET RESULT\r
1636         CAMN    A,(P)           ; SAME?\r
1637         JRST    SAMTYQ          ; COULD BE THE SAME\r
1638 TTYLP1: ADD     E,[2,,2]\r
1639         JUMPL   E,TTYLP\r
1640         SUB     P,[1,,1]        ; THIS ONE MUST BE UNIQUE\r
1641 TTYLP2: MOVE    C,T.SPDL+1(TB)  ; POINT TO P BASE\r
1642         HRRZ    A,S.DIR(C)      ; GET DIR OF OPEN\r
1643         SKIPE   A               ; IF OUTPUT,\r
1644         IORI    A,20            ; THEN USE DISPLAY MODE\r
1645         HRLM    A,S.DEV(C)      ; STORE IN OPEN BLOCK\r
1646         PUSHJ   P,OPEN2         ; OPEN THE TTY\r
1647         HRLZ    A,S.DEV(C)      ; GET DEVICE NAME\r
1648         PUSHJ   P,6TOCHS        ; TO A STRING\r
1649         MOVE    D,T.CHAN+1(TB)  ; POINT TO CHANNEL\r
1650         MOVEM   A,RDEVIC-1(D)\r
1651         MOVEM   B,RDEVIC(D)\r
1652         MOVE    C,T.SPDL+1(TB)  ; RESTORE PDL BASE\r
1653         MOVE    B,D             ; CHANNEL TO B\r
1654         HRRZ    0,S.DIR(C)      ; AND DIR\r
1655         JUMPE   0,TTYSPC\r
1656 TTY1:   DOTCAL  TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]]\r
1657         FATAL .CALL FAILURE\r
1658         DOTCAL  TTYSET,[CHANNO(B),MODE1,MODE2,D]\r
1659         FATAL .CALL FAILURE\r
1660         MOVE    A,[PUSHJ P,GMTYO]\r
1661         MOVEM   A,IOINS(B)\r
1662         DOTCAL  RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]]\r
1663         FATAL .CALL FAILURE\r
1664         MOVEM   D,LINLN(B)\r
1665         MOVEM   A,PAGLN(B)\r
1666         JRST    OPNWIN\r
1667 \r
1668 ; MAKE AN IOT\r
1669 \r
1670 IOTMAK: HRLZ    A,CHANNO(B)     ; GET CHANNEL\r
1671         ROT     A,5\r
1672         IOR     A,[.IOT A]      ; BUILD IOT\r
1673         MOVEM   A,IOINS(B)      ; AND STORE IT\r
1674         POPJ    P,\r
1675 \f\r
1676 \r
1677 ; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY\r
1678 \r
1679 SAMTYQ: MOVE    D,1(E)          ; RESTORE CURRENT CHANNEL\r
1680         MOVE    A,DIRECT-1(D)   ; GET DIR\r
1681         MOVE    B,DIRECT(D)\r
1682         PUSHJ   P,STRTO6\r
1683         POP     P,A             ; GET SIXBIT\r
1684         MOVE    C,T.SPDL+1(TB)\r
1685         HRRZ    C,S.DIR(C)\r
1686         CAME    A,MODES(C)      ; SKIP IF DIFFERENT DIRECTION\r
1687         JRST    TTYLP1\r
1688 \r
1689 ; HERE IF A RE-OPEN ON A TTY\r
1690 \r
1691         HRRZ    0,FSAV(TB)      ; IS IT FROM A FOPEN\r
1692         CAIN    0,FOPEN\r
1693         JRST    RETOLD          ; RET OLD CHANNEL\r
1694 \r
1695         PUSH    TP,$TCHAN\r
1696         PUSH    TP,1(E)         ; PUSH OLD CHANNEL\r
1697         PUSH    TP,$TFIX\r
1698         PUSH    TP,T.CHAN+1(TB)\r
1699         MOVE    A,[PUSHJ P,CHNFIX]\r
1700         PUSHJ   P,GCHACK\r
1701         SUB     TP,[4,,4]\r
1702         \r
1703 RETOLD: MOVE    B,1(E)          ; GET CHANNEL\r
1704         AOS     CHANNO-1(B)     ; AOS REF COUNT\r
1705         MOVSI   A,TCHAN\r
1706         SUB     P,[1,,1]        ; CLEAN UP STACK\r
1707         JRST    OPNRET          ; AND LEAVE\r
1708 \r
1709 \r
1710 ; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER\r
1711 \r
1712 CHNFIX: CAIN    C,TCHAN\r
1713         CAME    D,(TP)\r
1714         POPJ    P,\r
1715         MOVE    D,-2(TP)        ; GET REPLACEMENT\r
1716         SKIPE   B\r
1717         MOVEM   D,1(B)          ; CLOBBER IT AWAY\r
1718         POPJ    P,\r
1719 ]\f\r
1720 \r
1721 IFE ITS,[\r
1722         MOVE    C,T.SPDL+1(TB)  ; POINT TO P BASE\r
1723         HRRZ    0,S.DIR(C)      ; 0/ 0 FOR READ 0/ 1 FOR PRINT\r
1724         MOVE    A,[PUSHJ P,MTYO]\r
1725         MOVE    B,T.CHAN+1(TB)\r
1726         MOVEM   A,IOINS(B)\r
1727         MOVEI   A,100           ; PRIM INPUT JFN\r
1728         JUMPN   0,TNXTY1\r
1729         MOVEI   E,C.OPN+C.READ\r
1730         HRRM    E,-4(B)\r
1731         MOVEM   B,CHNL0+2*100+1(TVP)\r
1732         JRST    TNXTY2\r
1733 TNXTY1: MOVEM   B,CHNL0+2*101+1(TVP)\r
1734         MOVEI   A,101           ; PRIM OUTPUT JFN\r
1735         MOVEI   E,C.OPN+C.PRIN\r
1736         HRRM    E,-4(B)\r
1737 TNXTY2: MOVEM   A,CHANNO(B)\r
1738         JUMPN   0,OPNWIN\r
1739 ]\r
1740 ; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES\r
1741 \r
1742 TTYSPC: MOVEI   A,EXTBFR        ; GET EXTRA BUFFER\r
1743         PUSHJ   P,IBLOCK        ; GET BLOCK\r
1744         MOVE    D,T.CHAN+1(TB)  ;RESTORE CHANNEL POINTER\r
1745 IFN ITS,[\r
1746         MOVE    A,CHANNO(D)\r
1747         LSH     A,23.\r
1748         IOR     A,[.IOT A]\r
1749         MOVEM   A,IOIN2(B)\r
1750 ]\r
1751 IFE ITS,[\r
1752         MOVE    A,[PBIN]\r
1753         MOVEM   A,IOIN2(B)\r
1754 ]\r
1755         MOVSI   A,TLIST\r
1756         MOVEM   A,EXBUFR-1(D)   ; FOR WAITING TTY BUFFERS\r
1757         SETZM   EXBUFR(D)       ; NIL LIST\r
1758         MOVEM   B,BUFRIN(D)     ;STORE IN CHANNEL\r
1759         MOVSI   A,TUVEC         ;MAKE SURE TYPE IS UNIFORM VECTOR\r
1760         MOVEM   A,BUFRIN-1(D)\r
1761 IFN ITS,        MOVEI   A,177           ;SET ERASER TO RUBOUT\r
1762 IFE ITS,        MOVEI   A,1             ; TRY ^A FOR TENEX\r
1763         MOVEM   A,ERASCH(B)\r
1764         SETZM   KILLCH(B)       ;NO KILL CHARACTER NEEDED\r
1765         MOVEI   A,33            ;BREAKCHR TO C.R.\r
1766         MOVEM   A,BRKCH(B)\r
1767         MOVEI   A,"\            ;ESCAPER TO \\r
1768         MOVEM   A,ESCAP(B)\r
1769         MOVE    A,[010700,,BYTPTR(E)]   ;RELATIVE BYTE POINTER\r
1770         MOVEM   A,BYTPTR(B)\r
1771         MOVEI   A,14            ;BARF BACK CHARACTER FF\r
1772         MOVEM   A,BRFCHR(B)\r
1773         MOVEI   A,^D\r
1774         MOVEM   A,BRFCH2(B)\r
1775 \r
1776 ; SETUP DEFAULT TTY INTERRUPT HANDLER\r
1777 \r
1778         PUSH    TP,$TATOM\r
1779         PUSH    TP,MQUOTE CHAR,CHAR,INTRUP\r
1780         PUSH    TP,$TFIX\r
1781         PUSH    TP,[10]         ; PRIORITY OF CHAR INT\r
1782         PUSH    TP,$TCHAN\r
1783         PUSH    TP,D\r
1784         MCALL   3,EVENT         ; 1ST MAKE AN EVENT EXIST\r
1785         PUSH    TP,A\r
1786         PUSH    TP,B\r
1787         PUSH    TP,$TSUBR\r
1788         PUSH    TP,[QUITTER]    ; DEFAULT HANDLER IS QUITTER\r
1789         MCALL   2,HANDLER\r
1790 \r
1791 ; BUILD A NULL STRING\r
1792 \r
1793         MOVEI   A,0\r
1794         PUSHJ   P,IBLOCK                ; USE A BLOCK\r
1795         MOVE    D,T.CHAN+1(TB)\r
1796         MOVEI   0,C.BUF\r
1797         IORM    0,-4(D)\r
1798         HRLI    B,440700\r
1799         MOVSI   A,TCHSTR\r
1800         MOVEM   A,BUFSTR-1(D)\r
1801         MOVEM   B,BUFSTR(D)\r
1802         MOVEI   A,0\r
1803         MOVE    B,D             ; CHANNEL TO B\r
1804         JRST    MAKION\r
1805 \f\r
1806 \r
1807 ; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST\r
1808 \r
1809 OPEN2:  MOVEI   A,S.DEV(C)      ; POINT TO OPEN BLOCK\r
1810         PUSHJ   P,MOPEN         ; OPEN THE FILE\r
1811         JRST    OPNLOS\r
1812         MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL BACK\r
1813         MOVEM   A,CHANNO(B)     ; SAVE THE CHANNEL\r
1814         JRST    OPEN3\r
1815 \r
1816 ; FIX UP MODE AND FALL INTO OPEN\r
1817 \r
1818 OPEN0:  HRRZ    A,S.DIR(C)              ; GET DIR\r
1819         TRNE    A,2             ; SKIP IF NOT BLOCK\r
1820         IORI    A,4             ; TURN ON IMAGE\r
1821         IORI    A,2             ; AND BLOCK\r
1822 \r
1823         PUSH    P,A\r
1824         PUSH    TP,$TPDL\r
1825         PUSH    TP,C            ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA\r
1826         MOVE    B,T.CHAN+1(TB)\r
1827         MOVE    A,DIRECT-1(B)\r
1828         MOVE    B,DIRECT(B)     ; THIS KLUDGE THE MESS OF NDR\r
1829         PUSHJ   P,STRTO6\r
1830         MOVE    C,(TP)\r
1831         POP     P,D             ; THE SIXBIT FOR KLUDGE\r
1832         POP     P,A             ; GET BACK THE RANDOM BITS\r
1833         SUB     TP,[2,,2]\r
1834         CAME    D,[SIXBIT /PRINTO/]\r
1835         JRST    OPEN9           ; WELL NOT THIS TIME\r
1836         IORI    A,100000        ; WRITEOVER BIT\r
1837 \r
1838         HRRZ    0,FSAV(TB)\r
1839         CAIN    0,NFOPEN\r
1840         IOR     A,4             ; DON'T CHANGE REF DATE\r
1841 OPEN9:  HRLM    A,S.DEV(C)      ; AND STORE IT\r
1842 \r
1843 ; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL\r
1844 \r
1845 OPEN1:  MOVEI   A,S.DEV(C)      ; POINT TO OPEN BLOCK\r
1846         PUSHJ   P,MOPEN\r
1847         JRST    OPNLOS\r
1848         MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL BACK\r
1849         MOVEM   A,CHANNO(B)     ; CLOBBER INTO CHANNEL\r
1850         MOVSI   A,(A)           ; SET UP READ CHAN STATUS\r
1851         HRRI    A,S.DEV(C)\r
1852         .RCHST  A,              ; GET THE GOODS\r
1853 \r
1854 ; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL\r
1855 \r
1856 OPEN3:  MOVE    A,S.DIR(C)\r
1857         MOVEI   0,C.OPN+C.READ\r
1858         TRNE    A,1\r
1859         MOVEI   0,C.OPN+C.PRIN\r
1860         TRNE    A,2\r
1861         TRO     0,C.BIN\r
1862         HRRM    0,-4(B)\r
1863         MOVE    A,CHANNO(B)     ; GET CHANNEL #\r
1864         ASH     A,1\r
1865         ADDI    A,CHNL0(TVP)    ; POINT TO SLOT\r
1866         MOVEM   B,1(A)          ; NOT: TYPE ALREADY SETUP\r
1867 \r
1868 ; NOW GET STATUS WORD\r
1869 \r
1870 DOSTAT: HRLZ    A,CHANNO(B)     ; NOW GET STATUS WORD\r
1871         ROT     A,5\r
1872         IOR     A,[.STATUS STATUS(B)]   ; GET INS\r
1873         XCT     A               ; AND DO IT\r
1874         POPJ    P,\r
1875 \f\r
1876 \r
1877 ; HERE IF OPEN FAILS (CHANNEL IS IN A)\r
1878 \r
1879 OPNLOS: JUMPL   A,NOCHAN        ; ALL CHANNELS ARE IN USE\r
1880         LSH     A,23.           ; DO A .STATUS\r
1881         IOR     A,[.STATUS A]\r
1882         XCT     A               ; STATUS TO A\r
1883         PUSHJ   P,GFALS         ; GET A FALSE WITH A MESSAGE\r
1884         SUB     P,[1,,1]        ; EXTRA RET ADDR FLUSHED\r
1885         JRST    OPNRET          ; AND RETURN\r
1886 \r
1887 ; ROUTINE TO CONS UP FALSE WITH REASON\r
1888 \r
1889 GFALS:  PUSH    P,[SIXBIT /   ERR/]     ; SET UP OPEN TO ERR DEV\r
1890         PUSH    P,[3]           ; SAY ITS FOR CHANNEL\r
1891         PUSH    P,A\r
1892         .OPEN   0,-2(P)         ; USE CHANNEL 0 FOR THIS\r
1893         FATAL CAN'T OPEN ERROR DEVICE\r
1894         SUB     P,[3,,3]        ; DONT WANT OPEN BLOCK NOW\r
1895         MOVEI   A,0             ; PREPARE TO BUILD STRING ON STACK\r
1896 EL1:    PUSH    P,[0]           ; WHERE IT WILL GO\r
1897         MOVSI   B,(<440700,,(P)>)       ; BYTE POINTER TO TOP OF STACK\r
1898 EL2:    .IOT    0,0             ; GET A CHAR\r
1899         JUMPL   0,EL3           ; JUMP ON -1,,3\r
1900         CAIN    0,3             ; EOF?\r
1901         JRST    EL3             ; YES, MAKE STRING\r
1902         CAIN    0,14            ; IGNORE FORM FEEDS\r
1903         JRST    EL2             ; IGNORE FF\r
1904         CAIE    0,15            ; IGNORE CR & LF\r
1905         CAIN    0,12\r
1906         JRST    EL2\r
1907         IDPB    0,B             ; STUFF IT\r
1908         TLNE    B,760000        ; SIP IF WORD FULL\r
1909         AOJA    A,EL2\r
1910         AOJA    A,EL1           ; COUNT WORD AND GO\r
1911 \r
1912 EL3:    SKIPN   (P)             ; ANY CHARS AT END?\r
1913         SUB     P,[1,,1]        ; FLUSH XTRA\r
1914         PUSH    P,A             ; PUT UP COUNT\r
1915         .CLOSE  0,              ; CLOSE THE ERR DEVICE\r
1916         PUSHJ   P,CHMAK         ; MAKE STRING\r
1917         MOVE    C,A\r
1918         MOVE    D,B             ; COPY STRING\r
1919         PUSHJ   P,INCONS        ; CONS TO NIL\r
1920         MOVSI   A,TFALSE        ; MAKEIT A FALSE\r
1921         POPJ    P,\r
1922 \f\r
1923 \r
1924 ; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL\r
1925 \r
1926 FIXREA: HRLZS   S.DEV(C)        ; KILL MODE BITS\r
1927         MOVE    D,[-4,,S.DEV]\r
1928 \r
1929 FIXRE1: MOVEI   A,(D)           ; COPY REL POINTER\r
1930         ADD     A,T.SPDL+1(TB)  ; POINT TO SLOT\r
1931         SKIPN   A,(A)           ; SKIP IF GOODIE THERE\r
1932         JRST    FIXRE2\r
1933         PUSHJ   P,6TOCHS        ; MAKE INOT A STRING\r
1934         MOVE    C,RDTBL-S.DEV(D); GET OFFSET\r
1935         ADD     C,T.CHAN+1(TB)\r
1936         MOVEM   A,-1(C)\r
1937         MOVEM   B,(C)\r
1938 FIXRE2: AOBJN   D,FIXRE1\r
1939         POPJ    P,\r
1940 \r
1941 DOOPN:  PUSH    P,A\r
1942         HRLZ    A,CHANNO(B)     ; GET CHANNEL\r
1943         ASH     A,5\r
1944         HRR     A,(P)           ; POINT\r
1945         TLO     A,(.OPEN)\r
1946         XCT     A\r
1947         SKIPA\r
1948         AOS     -1(P)\r
1949         POP     P,A\r
1950         POPJ    P,\r
1951 \f\r
1952 ;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES\r
1953 STRTO6: PUSH    TP,A\r
1954         PUSH    TP,B\r
1955         PUSH    P,E             ;SAVE USEFUL FROB\r
1956         MOVEI   E,(A)           ; CHAR COUNT TO E\r
1957         GETYP   A,A\r
1958         CAIE    A,TCHSTR                ; IS IT ONE WORD?\r
1959         JRST    WRONGT          ;NO\r
1960 CHREAD: MOVEI   A,0             ;INITIALIZE OUTPUT WORD\r
1961         MOVE    D,[440600,,A]   ;AND BYTE POINTER TO IT\r
1962 NEXCHR: SOJL    E,SIXDON\r
1963         ILDB    0,B             ; GET NEXT CHAR\r
1964         JUMPE   0,SIXDON        ;IF NULL, WE ARE FINISHED\r
1965         PUSHJ   P,A0TO6         ; CONVERT TO SIXBIT\r
1966         IDPB    0,D             ;DEPOSIT INTO SIX BIT\r
1967         TRNN    A,77            ;IS OUTPUT FULL\r
1968         JRST    NEXCHR          ; NO, GET NEXT\r
1969 SIXDON: SUB     TP,[2,,2]       ;FIX UP TP\r
1970         POP     P,E\r
1971         EXCH    A,(P)           ;LEAVE RESULT ON P-STACK\r
1972         JRST    (A)             ;NOW RETURN\r
1973 \r
1974 \r
1975 ;SUBROUTINE TO CONVERT SIXBIT TO ATOM\r
1976 \r
1977 6TOCHS: PUSH    P,E\r
1978         PUSH    P,D\r
1979         MOVEI   B,0             ;MAX NUMBER OF CHARACTERS\r
1980         PUSH    P,[0]           ;STRING WILL GO ON P SATCK\r
1981         JUMPE   A,GETATM        ; EMPTY, LEAVE\r
1982         MOVEI   E,-1(P)         ;WILL BE BYTE POINTER\r
1983         HRLI    E,10700         ;SET IT UP\r
1984         PUSH    P,[0]           ;SECOND POSSIBLE WORD\r
1985         MOVE    D,[440600,,A]   ;INPUT BYTE POINTER\r
1986 6LOOP:  ILDB    0,D             ;START CHAR GOBBLING\r
1987         ADDI    0,40            ;CHANGET TOASCII\r
1988         IDPB    0,E             ;AND STORE IT\r
1989         TLNN    D,770000        ; SKIP IF NOT DONE\r
1990         JRST    6LOOP1\r
1991         TDNN    A,MSKS(B)       ; CHECK IF JUST SPACES LEFT\r
1992         AOJA    B,GETATM        ; YES, DONE\r
1993         AOJA    B,6LOOP         ;KEEP LOOKING\r
1994 6LOOP1: PUSH    P,[6]           ;IF ARRIVE HERE, STRING IS 2 WORDS\r
1995         JRST    .+2\r
1996 GETATM: MOVEM   B,(P)           ;SET STRING LENGTH=1\r
1997         PUSHJ   P,CHMAK         ;MAKE A MUDDLE STRING\r
1998         POP     P,D\r
1999         POP     P,E\r
2000         POPJ    P,\r
2001 \r
2002 MSKS:   7777,,-1\r
2003         77,,-1\r
2004         ,,-1\r
2005         7777\r
2006         77\r
2007 \r
2008 \r
2009 ; CONVERT ONE CHAR\r
2010 \r
2011 A0TO6:  CAIL    0,141           ;IF IT IS GREATER OR EQUAL TO LOWER A\r
2012         CAILE   0,172           ;BUT LESS THAN OR EQUAL TO LOWER Z\r
2013         JRST    .+2             ;THEN\r
2014         SUBI    0,40            ;CONVERT TO UPPER CASE\r
2015         SUBI    0,40            ;NOW TO SIX BIT\r
2016         JUMPL   0,BAD6          ;CHECK FOR A WINNER\r
2017         CAILE   0,77\r
2018         JRST    BAD6\r
2019         POPJ    P,\r
2020 \f\r
2021 ; SUBR TO DELETE AND RENAME FILES\r
2022 \r
2023 MFUNCTION RENAME,SUBR\r
2024 \r
2025         ENTRY\r
2026 \r
2027         JUMPGE  AB,TFA\r
2028         PUSH    TP,$TPDL\r
2029         PUSH    TP,P            ; SAVE P-STACK BASE\r
2030         GETYP   0,(AB)          ; GET 1ST ARG TYPE\r
2031 IFN ITS,[\r
2032         CAIN    0,TCHAN         ; CHANNEL?\r
2033         JRST    CHNRNM          ; MUST BE RENAME WHILE OPEN FOR WRITING\r
2034 ]\r
2035 IFE ITS,[\r
2036         PUSH    P,[100000,,0]\r
2037         PUSH    P,[377777,,377777]\r
2038 ]\r
2039         MOVSI   E,-4            ; 4 THINGS TO PUSH\r
2040 RNMALP: MOVE    B,@RNMTBL(E)\r
2041         PUSH    P,E\r
2042         PUSHJ   P,IDVAL1\r
2043         POP     P,E\r
2044         GETYP   0,A\r
2045         CAIE    0,TCHSTR        ; SKIP IF WINS\r
2046         JRST    RNMLP1\r
2047 \r
2048 IFN ITS,        PUSHJ   P,STRTO6        ; CONVERT TO SIXBIT\r
2049 IFE ITS,        PUSH    P,B             ; PUSH BYTE POINTER\r
2050         JRST    .+2\r
2051 \r
2052 RNMLP1: PUSH    P,RNSTBL(E)     ; USE DEFAULT\r
2053         AOBJN   E,RNMALP\r
2054 \r
2055 IFN ITS,[\r
2056         PUSHJ   P,RGPRS         ; PARSE THE ARGS\r
2057         JRST    RNM1            ; COULD BE A RENAME\r
2058 \r
2059 ; HERE TO DELETE A FILE\r
2060 \r
2061 DELFIL: MOVEI   A,0             ; SETUP FDELE\r
2062         EXCH    A,(P)           ; AND GET SNAME\r
2063         .SUSET  [.SSNAM,,A]\r
2064         HLRZS   -3(P)           ; FIXUP DEVICE\r
2065         .FDELE  -3(P)           ; DO IT TO IT\r
2066         JRST    FDLST           ; ANALYSE ERROR\r
2067 \r
2068 FDLWON: MOVSI   A,TATOM\r
2069         MOVE    B,MQUOTE T\r
2070         JRST    FINIS\r
2071 ]\r
2072 IFE ITS,[\r
2073         MOVE    A,(TP)          ; GET BASE OF PDL\r
2074         MOVEI   A,1(A)          ; POINT TO CRAP\r
2075         MOVE    B,1(AB)         ; STRING POINTER\r
2076         PUSH    P,[0]\r
2077         PUSH    P,[0]\r
2078         PUSH    P,[0]\r
2079         GTJFN                   ; GET A JFN\r
2080         JRST    TDLLOS          ; LOST\r
2081         ADD     AB,[2,,2]       ; PAST ARG\r
2082         JUMPL   AB,RNM1         ; GO TRY FOR RENAME\r
2083         MOVE    P,(TP)          ; RESTORE P STACK\r
2084         MOVEI   C,(A)           ; FOR RELEASE\r
2085         DELF                    ; ATTEMPT DELETE\r
2086         JRST    DELLOS          ; LOSER\r
2087         RLJFN                   ; MAKE SURE FLUSHED\r
2088         JFCL\r
2089 \r
2090 FDLWON: MOVSI   A,TATOM\r
2091         MOVE    B,MQUOTE T\r
2092         JRST    FINIS\r
2093 \r
2094 RNMLOS: PUSH    P,A\r
2095         MOVEI   A,(B)\r
2096         RLJFN\r
2097         JFCL\r
2098 DELLO1: MOVEI   A,(C)\r
2099         RLJFN\r
2100         JFCL\r
2101         POP     P,A             ; ERR NUMBER BACK\r
2102 TDLLOS: PUSHJ   P,TGFALS        ; GET FALSE WITH REASON\r
2103         JRST    FINIS\r
2104 \r
2105 DELLOS: PUSH    P,A             ; SAVE ERROR\r
2106         JRST    DELLO1\r
2107 ]\r
2108 \r
2109 ;TABLE OF REANMAE DEFAULTS\r
2110 IFN ITS,[\r
2111 RNMTBL: IMQUOTE DEV\r
2112         IMQUOTE NM1\r
2113         IMQUOTE NM2\r
2114         IMQUOTE SNM\r
2115 \r
2116 RNSTBL: SIXBIT /DSK   _MUDS_>           /\r
2117 ]\r
2118 IFE ITS,[\r
2119 RNMTBL: IMQUOTE DEV\r
2120         IMQUOTE SNM\r
2121         IMQUOTE NM1\r
2122         IMQUOTE NM2\r
2123 \r
2124 RNSTBL: -1,,[ASCIZ /DSK/]\r
2125         0\r
2126         -1,,[ASCIZ /_MUDS_/]\r
2127         -1,,[ASCIZ /MUD/]\r
2128 ]\r
2129 ; HERE TO DO A RENAME\r
2130 \r
2131 RNM1:   JUMPGE  AB,TMA          ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING\r
2132         GETYP   0,(AB)\r
2133         MOVE    C,1(AB)         ; GET ARG\r
2134         CAIN    0,TATOM         ; IS IT "TO"\r
2135         CAME    C,MQUOTE TO\r
2136         JRST    WRONGT          ; NO, LOSE\r
2137         ADD     AB,[2,,2]       ; BUMP PAST "TO"\r
2138         JUMPGE  AB,TFA\r
2139 IFN ITS,[\r
2140         MOVEM   P,T.SPDL+1(TB)  ; SAVE NEW P-BASE\r
2141 \r
2142         MOVEI   0,4             ; FOUR DEFAULTS\r
2143         PUSH    P,-3(P)         ; DEFAULT DEVICE IS CURRENT\r
2144         SOJN    0,.-1\r
2145 \r
2146         PUSHJ   P,RGPRS         ; PARSE THE NEXT STRING\r
2147         JRST    TMA\r
2148 \r
2149         HLRZS   A,-7(P)         ; FIX AND GET DEV1\r
2150         HLRZS   B,-3(P)         ; SAME FOR DEV2\r
2151         CAIE    A,(B)           ; SAME?\r
2152         JRST    DEVDIF\r
2153 \r
2154         POP     P,A             ; GET SNAME 2\r
2155         CAME    A,(P)-3         ; SNAME 1\r
2156         JRST    DEVDIF\r
2157         .SUSET  [.SSNAM,,A]\r
2158         POP     P,-2(P)         ; MOVE NAMES DOWN\r
2159         POP     P,-2(P)\r
2160         .FDELE  -4(P)           ; TRY THE RENAME\r
2161         JRST    FDLST\r
2162         JRST    FDLWON\r
2163 \r
2164 ; HERE FOR RENAME WHILE OPEN FOR WRITING\r
2165 \r
2166 CHNRNM: ADD     AB,[2,,2]       ; NEXT ARG\r
2167         JUMPGE  AB,TFA\r
2168         MOVE    B,-1(AB)        ; GET CHANNEL\r
2169         SKIPN   CHANNO(B)       ; SKIP IF OPEN\r
2170         JRST    BADCHN\r
2171         MOVE    A,DIRECT-1(B)   ; CHECK DIRECTION\r
2172         MOVE    B,DIRECT(B)\r
2173         PUSHJ   P,STRTO6        ; TO 6 BIT\r
2174         POP     P,A\r
2175         CAME    A,[SIXBIT /PRINT/]\r
2176         CAMN    A,[SIXBIT /PRINTB/]\r
2177         JRST    CHNRN1\r
2178         CAME    A,[SIXBIT /PRINTO/]\r
2179         JRST    WRONGD\r
2180 \r
2181 ; SET UP .FDELE BLOCK\r
2182 \r
2183 CHNRN1: PUSH    P,[0]\r
2184         PUSH    P,[0]\r
2185         MOVEM   P,T.SPDL+1(TB)\r
2186         PUSH    P,[0]\r
2187         PUSH    P,[SIXBIT /_MUDL_/]\r
2188         PUSH    P,[SIXBIT />/]\r
2189         PUSH    P,[0]\r
2190 \r
2191         PUSHJ   P,RGPRS         ; PARSE THESE\r
2192         JRST    TMA\r
2193 \r
2194         SUB     P,[1,,1]        ; SNAME/DEV IGNORED\r
2195         MOVE    AB,ABSAV(TB)    ; GET ORIG ARG POINTER\r
2196         MOVE    B,1(AB)\r
2197         MOVE    A,CHANNO(B)     ; ITS CHANNEL #\r
2198         MOVEM   A,-2(P)\r
2199         .FDELE  -4(P)\r
2200         JRST    FDLST\r
2201         MOVEI   A,-4(P)         ; SET UP FOR RDCHST\r
2202         HRL     A,CHANNO(B)\r
2203         .RCHST  A,\r
2204         MOVE    A,-3(P)         ; UPDATE CHANNEL\r
2205         PUSHJ   P,6TOCHS        ; GET A STRING\r
2206         MOVE    C,1(AB)\r
2207         MOVEM   A,RNAME1-1(C)\r
2208         MOVEM   B,RNAME1(C)\r
2209         MOVE    A,-2(P)\r
2210         PUSHJ   P,6TOCHS\r
2211         MOVE    C,1(AB)\r
2212         MOVEM   A,RNAME2-1(C)\r
2213         MOVEM   B,RNAME2(C)\r
2214         MOVE    B,1(AB)\r
2215         MOVSI   A,TCHAN\b\r
2216         JRST    FINIS\r
2217 ]\r
2218 IFE ITS,[\r
2219         PUSH    P,A\r
2220         MOVE    A,(TP)          ; PBASE BACK\r
2221         PUSH    A,[400000,,0]\r
2222         MOVEI   A,(A)\r
2223         MOVE    B,1(AB)\r
2224         GTJFN\r
2225         JRST    TDLLOS\r
2226         POP     P,B\r
2227         EXCH    A,B\r
2228         MOVEI   C,(A)           ; FOR RELEASE ATTEMPT\r
2229         RNAMF\r
2230         JRST    RNMLOS\r
2231         MOVEI   A,(B)\r
2232         RLJFN                   ; FLUSH JFN\r
2233         JFCL\r
2234         MOVEI   A,(C)           ; MAKE SURR OTHER IS FLUSHED\r
2235         RLJFN\r
2236         JFCL\r
2237         JRST    FDLWON\r
2238 ]\r
2239 ; HERE FOR LOSING .FDELE\r
2240 \r
2241 FDLST:  .STATUS 0,A             ; GET STATUS\r
2242         PUSHJ   P,GFALS         ; ANALYZE IT\r
2243         JRST    FINIS\r
2244 \r
2245 ; SOME .FDELE ERRORS\r
2246 \r
2247 DEVDIF: PUSH    TP,$TATOM\r
2248         PUSH    TP,EQUOTE DEVICE-OR-SNAME-DIFFERS\r
2249         JRST    CALER1\r
2250 \r
2251 \f; HERE TO RESET A READ CHANNEL\r
2252 \r
2253 MFUNCTION FRESET,SUBR,RESET\r
2254 \r
2255         ENTRY   1\r
2256         GETYP   A,(AB)\r
2257         CAIE    A,TCHAN\r
2258         JRST    WTYP1\r
2259         MOVE    B,1(AB)         ;GET CHANNEL\r
2260         SKIPN   IOINS(B)                ; OPEN?\r
2261         JRST    REOPE1          ; NO, IGNORE CHECKS\r
2262 IFN ITS,[\r
2263         MOVE    A,STATUS(B)     ;GET STATUS\r
2264         ANDI    A,77\r
2265         JUMPE   A,REOPE1        ;IF IT CLOSED, JUST REOPEN IT, MAYBE?\r
2266         CAILE   A,2             ;SKIPS IF TTY FLAVOR\r
2267         JRST    REOPEN\r
2268 ]\r
2269 IFE ITS,[\r
2270         MOVE    A,CHANNO(B)\r
2271         CAIE    A,100           ; TTY-IN\r
2272         CAIN    A,101           ; TTY-OUT\r
2273         JRST    .+2\r
2274         JRST    REOPEN\r
2275 ]\r
2276         CAME    B,TTICHN+1(TVP)\r
2277         CAMN    B,TTOCHN+1(TVP)\r
2278         JRST    REATTY\r
2279 REATT1: MOVEI   B,DIRECT-1(B)   ;POINT TO DIRECTION\r
2280         PUSHJ   P,CHRWRD        ;CONVERT TO A WORD\r
2281         JFCL\r
2282         CAME    B,[ASCII /READ/]\r
2283         JRST    TTYOPN\r
2284         MOVE    B,1(AB)         ;RESTORE CHANNEL\r
2285         PUSHJ   P,RRESET"       ;DO REAL RESET\r
2286         JRST    TTYOPN\r
2287 \r
2288 REOPEN: PUSH    TP,(AB)         ;FIRST CLOSE IT\r
2289         PUSH    TP,(AB)+1\r
2290         MCALL   1,FCLOSE\r
2291         MOVE    B,1(AB)         ;RESTORE CHANNEL\r
2292 \r
2293 ; SET UP TEMPS FOR OPNCH\r
2294 \r
2295 REOPE1: PUSH    P,[0]           ; WILL HOLD DIR CODE\r
2296         PUSH    TP,$TPDL\r
2297         PUSH    TP,P\r
2298         IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS]\r
2299         PUSH    TP,A-1(B)\r
2300         PUSH    TP,A(B)\r
2301         TERMIN\r
2302 \r
2303         PUSH    TP,$TCHAN\r
2304         PUSH    TP,1(AB)\r
2305 \r
2306         MOVE    A,T.DIR(TB)\r
2307         MOVE    B,T.DIR+1(TB)   ; GET DIRECTION\r
2308         PUSHJ   P,CHMOD ; CHECK THE MODE\r
2309         MOVEM   A,(P)           ; AND STORE IT\r
2310 \r
2311 ; NOW SET UP OPEN BLOCK IN SIXBIT\r
2312 IFN ITS,[\r
2313         MOVSI   E,-4            ; AOBN PNTR\r
2314 FRESE2: MOVE    B,T.CHAN+1(TB)\r
2315         MOVEI   A,@RDTBL(E)     ; GET ITEM POINTER\r
2316         GETYP   0,-1(A)         ; GET ITS TYPE\r
2317         CAIE    0,TCHSTR\r
2318         JRST    FRESE1\r
2319         MOVE    B,(A)           ; GET STRING\r
2320         MOVE    A,-1(A)\r
2321         PUSHJ   P,STRTO6\r
2322 FRESE3: AOBJN   E,FRESE2\r
2323         HLRZS   -3(P)           ; FIX DEVICE SPEC\r
2324 ]\r
2325 IFE ITS,[\r
2326         MOVE    B,T.CHAN+1(TB)\r
2327         MOVE    A,RDEVIC-1(B)\r
2328         MOVE    B,RDEVIC(B)\r
2329         PUSHJ   P,STRTO6                ; RESULT ON STACK\r
2330         HLRZS   (P)\r
2331 ]\r
2332 \r
2333         PUSH    P,[0]           ; PUSH UP SOME DUMMIES\r
2334         PUSH    P,[0]\r
2335         PUSH    P,[0]\r
2336         PUSHJ   P,OPNCH         ; ATTEMPT TO DO THEOPEN\r
2337         GETYP   0,A\r
2338         CAIE    0,TCHAN\r
2339         JRST    FINIS           ; LEAVE IF FALSE OR WHATEVER\r
2340 \r
2341 DRESET: MOVE    A,(AB)\r
2342         MOVE    B,1(AB)\r
2343         SETZM   CHRPOS(B)       ;INITIALIZE THESE PARAMETERS\r
2344         SETZM   LINPOS(B)\r
2345         SETZM   ACCESS(B)\r
2346         JRST    FINIS\r
2347 \r
2348 TTYOPN: MOVE    B,1(AB)\r
2349         CAME    B,TTOCHN+1(TVP)\r
2350         CAMN    B,TTICHN+1(TVP)\r
2351         PUSHJ   P,TTYOP2\r
2352         PUSHJ   P,DOSTAT\r
2353         DOTCAL  RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]]\r
2354         FATAL .CALL FAILURE\r
2355         MOVEM   C,PAGLN(B)\r
2356         MOVEM   D,LINLN(B)\r
2357         JRST    DRESET\r
2358 \r
2359 IFN ITS,[\r
2360 FRESE1: CAIE    0,TFIX\r
2361         JRST    BADCHN\r
2362         PUSH    P,(A)\r
2363         JRST    FRESE3\r
2364 ]\r
2365 \r
2366 ; INTERFACE TO REOPEN CLOSED CHANNELS\r
2367 \r
2368 OPNCHN: PUSH    TP,$TCHAN\r
2369         PUSH    TP,B\r
2370         MCALL   1,FRESET\r
2371         POPJ    P,\r
2372 \r
2373 REATTY: PUSHJ   P,TTYOP2\r
2374         SKIPE   NOTTY\r
2375         JRST    DRESET\r
2376         MOVE    B,1(AB)\r
2377         JRST    REATT1\r
2378 \f\r
2379 ; FUNCTION TO LIST ALL CHANNELS\r
2380 \r
2381 MFUNCTION CHANLIST,SUBR\r
2382 \r
2383         ENTRY   0\r
2384 \r
2385         MOVEI   A,N.CHNS-1      ;MAX # OF REAL CHANNELS\r
2386         MOVEI   C,0\r
2387         MOVEI   B,CHNL1(TVP)    ;POINT TO FIRST REAL CHANNEL\r
2388 \r
2389 CHNLP:  SKIPN   1(B)            ;OPEN?\r
2390         JRST    NXTCHN          ;NO, SKIP\r
2391         HRRZ    E,(B)           ; ABOUT TO FLUSH?\r
2392         JUMPN   E,NXTCHN        ; YES, FORGET IT\r
2393         MOVE    D,1(B)          ; GET CHANNEL\r
2394         HRRZ    E,CHANNO-1(D)   ; GET REF COUNT\r
2395         PUSH    TP,(B)\r
2396         PUSH    TP,1(B)\r
2397         ADDI    C,1             ;COUNT WINNERS\r
2398         SOJGE   E,.-3           ; COUNT THEM\r
2399 NXTCHN: ADDI    B,2\r
2400         SOJN    A,CHNLP\r
2401 \r
2402         SKIPN   B,CHNL0(TVP)+1  ;NOW HACK LIST OF PSUEDO CHANNELS\r
2403         JRST    MAKLST\r
2404 CHNLS:  PUSH    TP,(B)\r
2405         PUSH    TP,(B)+1\r
2406         ADDI    C,1\r
2407         HRRZ    B,(B)\r
2408         JUMPN   B,CHNLS\r
2409 \r
2410 MAKLST: ACALL   C,LIST\r
2411         JRST    FINIS\r
2412 \r
2413 \f; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE\r
2414 \r
2415 \r
2416 REOPN:  PUSH    TP,$TCHAN\r
2417         PUSH    TP,B\r
2418         SKIPN   CHANNO(B)       ; ONLY REAL CHANNELS\r
2419         JRST    PSUEDO\r
2420 \r
2421 IFN ITS,[\r
2422         MOVSI   E,-4            ; SET UP POINTER FOR NAMES\r
2423 \r
2424 GETOPB: MOVE    B,(TP)          ; GET CHANNEL\r
2425         MOVEI   A,@RDTBL(E)     ; GET POINTER\r
2426         MOVE    B,(A)           ; NOW STRING\r
2427         MOVE    A,-1(A)\r
2428         PUSHJ   P,STRTO6        ; LEAVES SIXBIT ON STACK\r
2429         AOBJN   E,GETOPB\r
2430 ]\r
2431 IFE ITS,[\r
2432         MOVE    A,RDEVIC-1(B)\r
2433         MOVE    B,RDEVIC(B)\r
2434         PUSHJ   P,STRTO6        ; GET DEV NAME IN SIXBIT\r
2435 ]\r
2436         MOVE    B,(TP)          ; RESTORE CHANNEL\r
2437         MOVE    A,DIRECT-1(B)\r
2438         MOVE    B,DIRECT(B)\r
2439         PUSHJ   P,CHMOD ; CHECK FOR A VALID MODE\r
2440 \r
2441 IFN ITS,        HLRZS   E,-3(P)         ; GET DEVICE IN PROPER PLACE\r
2442 IFE ITS,        HLRZS   E,(P)\r
2443         MOVE    B,(TP)          ; RESTORE CHANNEL\r
2444         CAIN    E,(SIXBIT /DSK/)\r
2445         JRST    DISKH           ; DISK WINS IMMEIDATELY\r
2446         CAIN    E,(SIXBIT /TTY/)        ; NO NEED TO RE-OPEN THE TTY\r
2447         JRST    REOPD1\r
2448 IFN ITS,[\r
2449         ANDI    E,777700        ; COULD BE "UTn"\r
2450         MOVE    D,CHANNO(B)     ; GET CHANNEL\r
2451         ASH     D,1\r
2452         ADDI    D,CHNL0(TVP)    ; DON'T SEEM TO BE OPEN\r
2453         SETZM   1(D)\r
2454         SETZM   CHANNO(B)\r
2455         CAIN    E,(SIXBIT /UT /)\r
2456         JRST    REOPD           ; CURRENTLY, CANT RESTORE UTAPE CHANNLES\r
2457         CAIN    E,(SIXBIT /AI /)\r
2458         JRST    REOPD           ; CURRENTLY CANT RESTORE AI CHANNELS\r
2459         CAIN    E,(SIXBIT /ML /)\r
2460         JRST    REOPD           ; CURRENTLY CANT RESTORE ML CHANNELS\r
2461         CAIN    E,(SIXBIT /DM /)\r
2462         JRST    REOPD           ; CURRENTLY CANT RESTORE DM CHANNELS\r
2463 ]\r
2464         PUSH    TP,$TCHAN       ; TRY TO RESET IT \r
2465         PUSH    TP,B\r
2466         MCALL   1,FRESET\r
2467 \r
2468 IFN ITS,[\r
2469 REOPD1: AOS     -4(P)\r
2470 REOPD:  SUB     P,[4,,4]\r
2471 ]\r
2472 IFE ITS,[\r
2473 REOPD1: AOS     -1(P)\r
2474 REOPD:  SUB     P,[1,,1]\r
2475 ]\r
2476 REOPD0: SUB     TP,[2,,2]\r
2477         POPJ    P,\r
2478 \r
2479 IFN ITS,[\r
2480 DISKH:  MOVE    C,(P)           ; SNAME\r
2481         .SUSET  [.SSNAM,,C]\r
2482 ]\r
2483 IFE ITS,[\r
2484 DISKH:  MOVEM   A,(P)           ; SAVE MODE WORD\r
2485         PUSHJ   P,STSTK         ; STRING TO STACK\r
2486         MOVE    A,(E)           ; RESTORE MODE WORD\r
2487         PUSH    TP,$TPDL\r
2488         PUSH    TP,E            ; SAVE PDL BASE\r
2489         MOVE    B,-2(TP)        ; CHANNEL BACK TO B\r
2490 ]\r
2491         MOVE    C,ACCESS(B)     ; GET CHANNELS ACCESS\r
2492         TRNN    A,2             ; SKIP IF NOT ASCII CHANNEL\r
2493         JRST    DISKH1\r
2494         HRRZ    D,ACCESS-1(B)   ; IF PARTIAL WORD OUT\r
2495         IMULI   C,5             ; TO CHAR ACCESS\r
2496         JUMPE   D,DISKH1        ; NO SWEAT\r
2497         ADDI    C,(D)\r
2498         SUBI    C,5\r
2499 DISKH1: HRRZ    D,BUFSTR-1(B)   ; ANY CHARS IN MUDDLE BUFFER\r
2500         JUMPE   D,DISKH2\r
2501         PUSH    P,A\r
2502         PUSH    P,C\r
2503         MOVEI   C,BUFSTR-1(B)\r
2504         PUSHJ   P,BYTDOP        ; FIND LENGTH OF WHOLE BUFFER\r
2505         HLRZ    D,(A)           ; LENGTH + 2 TO D\r
2506         SUBI    D,2\r
2507         IMULI   D,5             ; TO CHARS\r
2508         POP     P,C\r
2509         POP     P,A\r
2510 DISKH2: SUBI    C,(D)           ; UPDATE CHAR ACCESS\r
2511         IDIVI   C,5             ; BACK TO WORD ACCESS\r
2512         IORI    A,6             ; BLOCK IMAGE\r
2513 IFN ITS,[\r
2514         TRNE    A,1\r
2515         IORI    A,100000        ; WRITE OVER BIT\r
2516         HRLM    A,-3(P)\r
2517         MOVEI   A,-3(P)\r
2518         PUSHJ   P,DOOPN\r
2519         JRST    REOPD\r
2520         MOVE    A,C             ; ACCESS TO A\r
2521         PUSHJ   P,GETFLN        ; CHECK LENGTH\r
2522         CAIGE   0,(A)           ; CHECK BOUNDS\r
2523         JRST    .+3             ; COMPLAIN\r
2524         PUSHJ   P,DOACCS        ; AND ACESS\r
2525         JRST    REOPD1          ; SUCCESS\r
2526 \r
2527         MOVE    A,CHANNO(B)     ; CLOSE THE G.D. CHANNEL\r
2528         PUSHJ   P,MCLOSE\r
2529         JRST    REOPD\r
2530 \r
2531 DOACCS: PUSH    P,A\r
2532         HRLZ    A,CHANNO(B)\r
2533         ASH     A,5\r
2534         IOR     A,[.ACCESS (P)]\r
2535         XCT     A\r
2536         POP     P,A\r
2537         POPJ    P,\r
2538 \r
2539 DOIOTO:\r
2540 DOIOTI:\r
2541 DOIOT:\r
2542         PUSH    P,0\r
2543         MOVSI   0,TCHAN\r
2544         MOVEM   0,BSTO(PVP)     ; IN CASE OF INTERRUPT\r
2545         ENABLE\r
2546         HRLZ    0,CHANNO(B)\r
2547         ASH     0,5\r
2548         IOR     0,[.IOT A]\r
2549         XCT     0\r
2550         DISABLE\r
2551         SETZM   BSTO(PVP)\r
2552         POP     P,0\r
2553         POPJ    P,\r
2554 \r
2555 GETFLN: MOVE    0,CHANNO(B)     ; GET CHANNEL\r
2556         .CALL   FILBLK          ; READ LNTH\r
2557         .VALUE\r
2558         POPJ    P,\r
2559 \r
2560 FILBLK: SETZ\r
2561         SIXBIT /FILLEN/\r
2562         0\r
2563         402000,,0       ; STUFF RESULT IN 0\r
2564 ]\r
2565 IFE ITS,[\r
2566 \r
2567         HRROI   B,1(E)          ; TENEX STRING POINTER\r
2568         MOVEI   A,1(P)          ; A POINT TO BLOCK OF INFO\r
2569         PUSH    P,[100400,,0]   ; FORCE JFN REUSE AND ONLY ACCEPT EXISTING FILE\r
2570         PUSH    P,[377777,,377777]      ; NO I/O FOR CORRECTIONS ETC.\r
2571         REPEAT  6,PUSH P,[0]            ; OTHER SLOTS\r
2572         MOVE    D,-2(TP)        ; CHANNEL BACK\r
2573         PUSH    P,CHANNO(D)     ; AND DESIRED JFN\r
2574         GTJFN                   ; GO GET IT\r
2575         JRST    RGTJL           ; COMPLAIN\r
2576         MOVE    P,(TP)          ; RESTORE P\r
2577         MOVE    A,(P)           ; MODE WORD BACK\r
2578         MOVE    B,[440000,,200000]      ; FLAG BITS\r
2579         TRNE    A,1             ; SKIP FOR INPUT\r
2580         TRC     B,300000        ; CHANGE TO WRITE\r
2581         MOVE    A,CHANNO(D)     ; GET JFN\r
2582         OPENF\r
2583         JRST    ROPFLS\r
2584         MOVE    E,C             ; LENGTH TO E\r
2585         SIZEF                   ; GET CURRENT LENGTH\r
2586         JRST    ROPFLS\r
2587         CAMGE   B,E             ; STILL A WINNER\r
2588         JRST    ROPFLS\r
2589         MOVE    A,-2(TP)        ; CHANNEL\r
2590         MOVE    A,CHANNO(A)     ; JFN\r
2591         MOVE    B,C\r
2592         SFPTR\r
2593         JRST    ROPFLS\r
2594         SUB     TP,[2,,2]       ; FLUSH PDL POINTER\r
2595         JRST    REOPD1\r
2596 \r
2597 ROPFLS: MOVE    A,-2(TP)\r
2598         MOVE    A,CHANNO(A)\r
2599         CLOSF                   ; ATTEMPT TO CLOSE\r
2600         JFCL                    ; IGNORE FAILURE\r
2601         SKIPA\r
2602 \r
2603 RGTJL:  MOVE    P,(TP)\r
2604         SUB     TP,[2,,2]\r
2605         JRST    REOPD\r
2606 \r
2607 DOACCS: PUSH    P,B\r
2608         EXCH    A,B\r
2609         MOVE    A,CHANNO(A)\r
2610         SFPTR\r
2611         JRST    ACCFAI\r
2612         POP     P,B\r
2613         POPJ    P,\r
2614 ]\r
2615 PSUEDO: AOS     (P)             ; ASSUME SUCCESS FOR NOW\r
2616         MOVEI   B,RDEVIC-1(B)   ; SEE WHAT DEVICE IS\r
2617         PUSHJ   P,CHRWRD\r
2618         JFCL\r
2619         CAME    B,[ASCII /E&S/] ; DISPLAY ?\r
2620         CAMN    B,[ASCII /DIS/]\r
2621         SKIPA   B,(TP)          ; YES, REGOBBLE CHANNEL AND CONTINUE\r
2622         JRST    REOPD0          ; NO, RETURN HAPPY\r
2623         PUSHJ   P,DISROP\r
2624         SOS     (P)             ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS\r
2625         JRST    REOPD0\r
2626 \r
2627 \f;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL\r
2628 \r
2629 MFUNCTION FCLOSE,SUBR,[CLOSE]\r
2630 \r
2631         ENTRY   1               ;ONLY ONE ARG\r
2632         GETYP   A,(AB)          ;CHECK ARGS\r
2633         CAIE    A,TCHAN         ;IS IT A CHANNEL\r
2634         JRST    WTYP1\r
2635         MOVE    B,1(AB)         ;PICK UP THE CHANNEL\r
2636         HRRZ    A,CHANNO-1(B)   ; GET REF COUNT\r
2637         SOJGE   A,CFIN5         ;  NOT READY TO REALLY CLOSE\r
2638         CAME    B,TTICHN+1(TVP) ; CHECK FOR TTY\r
2639         CAMN    B,TTOCHN+1(TVP)\r
2640         JRST    CLSTTY\r
2641         MOVE    A,[JRST CHNCLS]\r
2642         MOVEM   A,IOINS(B)      ;CLOBBER THE IO INS\r
2643         MOVE    A,RDEVIC-1(B)   ;GET THE NAME OF THE DEVICE\r
2644         MOVE    B,RDEVIC(B)\r
2645         PUSHJ   P,STRTO6\r
2646         HLRZS   A,(P)\r
2647         MOVE    B,1(AB)         ; RESTORE CHANNEL\r
2648         CAIE    A,(SIXBIT /E&S/)\r
2649         CAIN    A,(SIXBIT /DIS/)\r
2650         PUSHJ   P,DISCLS\r
2651         MOVE    B,1(AB)         ; IN CASE CLOBBERED BY DISCLS\r
2652         SKIPN   A,CHANNO(B)     ;ANY REAL CHANNEL?\r
2653         JRST    REMOV           ; NO, EITHER  CLOSED OR PSEUDO CHANNEL\r
2654 \r
2655         MOVE    A,DIRECT-1(B)   ; POINT TO DIRECTION\r
2656         MOVE    B,DIRECT(B)\r
2657         PUSHJ   P,STRTO6        ; CONVERT TO WORD\r
2658         POP     P,A\r
2659         LDB     E,[140600,,(P)] ; FIRST CHAR OD DEV NAME\r
2660         CAIE    E,'T            ; SKIP IF TTY\r
2661         JRST    CFIN4\r
2662         CAME    A,[SIXBIT /READ/]       ; SKIP IF WINNER\r
2663         JRST    CFIN1\r
2664 IFN ITS,[\r
2665         MOVE    B,1(AB)         ; IN ITS CHECK STATUS\r
2666         LDB     A,[600,,STATUS(B)]\r
2667         CAILE   A,2\r
2668         JRST    CFIN1\r
2669 ]\r
2670         PUSH    TP,$TCHSTR\r
2671         PUSH    TP,CHQUOTE CHAR\r
2672         PUSH    TP,(AB)\r
2673         PUSH    TP,1(AB)\r
2674         MCALL   2,OFF           ; TURN OFF INTERRUPT\r
2675 CFIN1:  MOVE    B,1(AB)\r
2676         MOVE    A,CHANNO(B)\r
2677 IFN ITS,[\r
2678         PUSHJ   P,MCLOSE\r
2679 ]\r
2680 IFE ITS,[\r
2681         TLZ     A,400000        ; FOR JFN RELEASE\r
2682         CLOSF                   ; CLOSE THE FILE AND RELEASE THE JFN\r
2683         JFCL\r
2684         MOVE    A,CHANNO(B)\r
2685 ]\r
2686 CFIN:   LSH     A,1\r
2687         ADDI    A,CHNL0+1(TVP)  ;POINT TO THIS CHANNELS LSOT\r
2688         SETZM   CHANNO(B)\r
2689         SETZM   (A)             ;AND CLOBBER IT\r
2690         HLLZS   BUFSTR-1(B)\r
2691         SETZM   BUFSTR(B)\r
2692         HLLZS   ACCESS-1(B)\r
2693 CFIN2:  HLLZS   -4(B)\r
2694         MOVSI   A,TCHAN         ;RETURN THE CHANNEL\r
2695         JRST    FINIS\r
2696 \r
2697 CLSTTY: PUSH    TP,$TATOM\r
2698         PUSH    TP,EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL\r
2699         JRST    CALER1\r
2700 \r
2701 \r
2702 REMOV:  MOVEI   D,CHNL0(TVP)+1  ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST\r
2703 REMOV0: SKIPN   C,D             ;FOUND ON LIST ?\r
2704         JRST    CFIN2           ;NO, JUST IGNORE THIS CLOSED CHANNEL\r
2705         HRRZ    D,(C)           ;GET POINTER TO NEXT\r
2706         CAME    B,(D)+1         ;FOUND ?\r
2707         JRST    REMOV0\r
2708         HRRZ    D,(D)           ;YES, SPLICE IT OUT\r
2709         HRRM    D,(C)\r
2710         JRST    CFIN2\r
2711 \r
2712 \r
2713 ; CLOSE UP ANY LEFTOVER BUFFERS\r
2714 \r
2715 CFIN4:  CAME    A,[SIXBIT /PRINTO/]\r
2716         CAMN    A,[SIXBIT /PRINTB/]\r
2717         JRST    .+3\r
2718         CAME    A,[SIXBIT /PRINT/]\r
2719         JRST    CFIN1\r
2720         MOVE    B,1(AB)         ; GET CHANNEL\r
2721         GETYP   0,BUFSTR-1(B)   ; IS THERE AN OUTPUT BUFFER\r
2722         SKIPN   BUFSTR(B)\r
2723         JRST    CFIN1\r
2724         CAIE    0,TCHSTR\r
2725         JRST    CFINX1\r
2726 IFE ITS,        PUSH    P,A             ; SAVE MODE\r
2727         PUSHJ   P,BFCLOS\r
2728 IFE ITS,[\r
2729         POP     P,A             ; RESTORE MODE\r
2730         MOVE    0,RDEVIC(B)\r
2731         ILDB    0,0\r
2732         CAIN    0,"D\r
2733         CAME    A,[SIXBIT /PRINT/]\r
2734         JRST    CFINX1\r
2735         MOVE    A,CHANNO(B)     ; GET JFN\r
2736         TLO     A,400000        ; BIT MEANS DONT RELEASE JFN\r
2737         CLOSF                   ; CLOSE THE FILE\r
2738         FATAL   CLOSF LOST?\r
2739         MOVE    E,B             ; SAVE CHANNEL\r
2740         MOVE    A,CHANNO(B)\r
2741         HRLI    A,11\r
2742         MOVSI   B,7700          ; MASK\r
2743         MOVSI   C,700           ; MAKE NEW SIZE 7\r
2744         CHFDB\r
2745         HRLI    A,12\r
2746         SETOM   B\r
2747         MOVE    C,ACCESS(E)     ; LENGTH IN CHARS\r
2748         CHFDB\r
2749 ]\r
2750         HLLZS   BUFSTR-1(B)\r
2751         SETZM   BUFSTR(B)\r
2752 CFINX1: HLLZS   ACCESS-1(B)\r
2753         JRST    CFIN1\r
2754 \r
2755 CFIN5:  HRRM    A,CHANNO-1(B)\r
2756         JRST    CFIN2\r
2757 \f;SUBR TO DO .ACCESS ON A READ CHANNEL\r
2758 ;FORM:  <ACCESS  CHANNEL FIX-NUMBER>\r
2759 ;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER\r
2760 ;H. BRODIE 7/26/72\r
2761 \r
2762 MFUNCTION MACCESS,SUBR,[ACCESS]\r
2763         ENTRY   2       ;ARGS: CHANNEL AND FIX-NUMBER\r
2764 \r
2765 ;CHECK ARGUMENT TYPES\r
2766         GETYP   A,(AB)\r
2767         CAIE    A,TCHAN         ;FIRST ARG SHOULD BE CHANNEL\r
2768         JRST    WTYP1\r
2769         GETYP   A,2(AB)         ;TYPE OF SECOND\r
2770         CAIE    A,TFIX          ;SHOULD BE FIX\r
2771         JRST    WTYP2\r
2772 \r
2773 ;CHECK DIRECTION OF CHANNEL\r
2774         MOVE    B,1(AB)         ;B GETS PNTR TO CHANNEL\r
2775         MOVEI   B,DIRECT-1(B)   ;GET DIRECTION OF CHANNEL\r
2776         PUSHJ   P,CHRWRD        ;GRAB THE CHAR STRNG\r
2777         JFCL\r
2778         CAME    B,[<ASCII /PRINT/>+1]\r
2779         JRST    MACCA\r
2780         PUSH    P,[2]           ;ACCESS ON PRINTB CHANNEL\r
2781         MOVE    B,1(AB)\r
2782         SKIPE   BUFSTR(B)       ;SEE IF WE MUST FLUSH PART BUFFER\r
2783         PUSHJ   P,BFCLS1\r
2784         JRST    MACC\r
2785 MACCA:  PUSH    P,[0]           ; READ RATHER THAN READB INDICATOR\r
2786         CAMN    B,[ASCIZ /READ/]\r
2787         JRST    .+4\r
2788         CAME    B,[ASCIZ /READB/]       ; READB CHANNEL?\r
2789         JRST    WRONGD\r
2790         AOS     (P)                     ; SET INDICATOR FOR BINARY MODE\r
2791 \r
2792 ;CHECK THAT THE CHANNEL IS OPEN\r
2793 MACC:   MOVE    B,1(AB)         ;GET BACK PTR TO CHANNEL\r
2794         SKIPN   CHANNO(B)       ;CLOSED CHANNELS HAVE CHANNO ZEROED OUT\r
2795         JRST    CHNCLS  ;IF CHNL CLOSED => ERROR\r
2796 \r
2797 ;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN\r
2798 ;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER\r
2799 ADEVOK: SKIPGE  C,3(AB)         ;GET CHAR POSN...ALL NEGS = -5\r
2800         MOVNI   C,-5\r
2801 ;BUT .ACCESS -1 ISN'T IMPLEMENTED ON ITS YET, SO TELL HIM\r
2802         JUMPGE  C,MACC1\r
2803         PUSH    TP,$TATOM\r
2804         PUSH    TP,EQUOTE NEGATIVE-ACCESS-NOT-ON-ITS\r
2805         JRST    CALER1\r
2806 MACC1:  SKIPN   (P)\r
2807         IDIVI   C,5\r
2808 \r
2809 ;SETUP THE .ACCESS\r
2810         MOVE    B,1(AB)         ;GET BACK PTR TO CHANNEL\r
2811         MOVE    A,CHANNO(B)     ;A GETS REAL CHANNEL NUMBER\r
2812 IFN ITS,[\r
2813         ROT     A,23.           ;SET UP IN AC FIELD\r
2814         IOR     A,[.ACCESS 0,C] ;C CONTAINS PLACE TO ACCESS TO\r
2815 \r
2816 ;DO IT TO IT!\r
2817         XCT     A\r
2818 ]\r
2819 IFE ITS,[\r
2820         MOVE    B,C\r
2821         SFPTR                   ; DO IT IN TENEX\r
2822         JRST    ACCFAI\r
2823         MOVE    B,1(AB)         ; RESTORE CHANNEL\r
2824 ]\r
2825         POP     P,E             ; CHECK FOR READB MODE\r
2826         CAIN    E,2\r
2827         JRST    DONADV          ; PRINTB CHANNEL\r
2828         SKIPE   BUFSTR(B)       ; IS THERE A READ BUFFER TO FLUSH\r
2829         JRST    .+3\r
2830         SETZM   LSTCH(B)        ; CLEAR OUT POSSIBLE EOF INDICATOR\r
2831         JRST    DONADV\r
2832 \r
2833 ;NOW FORCE GETCHR TO DO A .IOT FIRST THING\r
2834         MOVEI   C,BUFSTR-1(B)   ; FIND END OF STRING\r
2835         PUSHJ   P,BYTDOP"\r
2836         SUBI    A,2             ; LAST REAL WORD\r
2837         HRLI    A,010700\r
2838         MOVEM   A,BUFSTR(B)\r
2839         HLLZS   BUFSTR-1(B)     ; CLOBBER CHAR COUNT\r
2840         MOVEM   A,BUFSTR(B)\r
2841         SETZM   LSTCH(B)        ;CLOBBER READ'S HIDDEN CHARACTER\r
2842 \r
2843 ;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS\r
2844         JUMPLE  D,DONADV\r
2845 ADVPTR: PUSHJ   P,GETCHR\r
2846         MOVE    B,1(AB)         ;RESTORE IN CASE CLOBBERED\r
2847         SOJG    D,ADVPTR\r
2848 \r
2849 DONADV: MOVE    C,3(AB)         ;FIXUP ACCESS SLOT IN CHNL\r
2850         MOVEM   C,ACCESS(B)\r
2851         MOVE    A,$TCHAN        ;TYPE OF RESULT = "CHANNEL"\r
2852         JRST    FINIS           ;DONE...B CONTAINS CHANNEL\r
2853 \r
2854 IFE ITS,[\r
2855 ACCFAI: PUSH    TP,$TATOM\r
2856         PUSH    TP,EQUOTE ACCESS-FAILURE\r
2857         JRST    CALER1\r
2858 ]\r
2859 \r
2860 \r
2861 ;WRONG TYPE OF DEVICE ERROR\r
2862 WRDEV:  PUSH    TP,$TATOM\r
2863         PUSH    TP,EQUOTE NON-DSK-DEVICE\r
2864         JRST    CALER1\r
2865 \f\r
2866 ; BINARY READ AND PRINT ROUTINES\r
2867 \r
2868 MFUNCTION PRINTB,SUBR\r
2869 \r
2870         ENTRY   2\r
2871 \r
2872 PBFL:   PUSH    P,.             ; PUSH NON-ZERONESS\r
2873         JRST    BINI1\r
2874 \r
2875 MFUNCTION READB,SUBR\r
2876 \r
2877         ENTRY\r
2878 \r
2879         PUSH    P,[0]\r
2880         HLRZ    0,AB\r
2881         CAIG    0,-3\r
2882         CAIG    0,-7\r
2883         JRST    WNA\r
2884 \r
2885 BINI1:  GETYP   0,(AB)          ; SHOULD BE UVEC OR STORE\r
2886         CAIN    0,TUVEC\r
2887         JRST    BINI2\r
2888         CAIE    0,TSTORAGE\r
2889         JRST    WTYP1           ; ELSE LOSE\r
2890 BINI2:  MOVE    B,1(AB)         ; GET IT\r
2891         HLRE    C,B\r
2892         SUBI    B,(C)           ; POINT TO DOPE\r
2893         GETYP   A,(B)\r
2894         PUSHJ   P,SAT"          ; GET ITS ST.ALOC.TYPE\r
2895         CAIE    A,S1WORD\r
2896         JRST    WTYP1\r
2897         GETYP   0,2(AB)\r
2898         CAIE    0,TCHAN         ; BETTER BE A CHANNEL\r
2899         JRST    WTYP2\r
2900         MOVE    B,3(AB)         ; GET IT\r
2901         MOVEI   B,DIRECT-1(B)   ; GET DIRECTION OF\r
2902         PUSHJ   P,CHRWRD        ; INTO 1 WORD\r
2903         JFCL\r
2904         MOVNI   E,1\r
2905         CAMN    B,[ASCII /READB/]\r
2906         MOVEI   E,0\r
2907         CAMN    B,[<ASCII /PRINT/>+1]\r
2908         MOVE    E,PBFL\r
2909         JUMPL   E,WRONGD                ; LOSER\r
2910         CAME    E,(P)           ; CHECK WINNGE\r
2911         JRST    WRONGD\r
2912         MOVE    B,3(AB)         ; GET CHANNEL BACK\r
2913         SKIPN   A,IOINS(B)      ; OPEN?\r
2914         PUSHJ   P,OPENIT                ; LOSE\r
2915         CAMN    A,[JRST CHNCLS]\r
2916         JRST    CHNCLS          ; LOSE, CLOSED\r
2917         JUMPN   E,BUFOU1        ; JUMP FOR OUTPUT\r
2918         CAML    AB,[-5,,]       ; SKIP IF EOF GIVEN\r
2919         JRST    BINI5\r
2920         MOVE    0,4(AB)\r
2921         MOVEM   0,EOFCND-1(B)\r
2922         MOVE    0,5(AB)\r
2923         MOVEM   0,EOFCND(B)\r
2924 BINI5:  SKIPE   LSTCH(B)        ; INDICATES IF EOF HIT\r
2925         JRST    BINEOF\r
2926         MOVE    A,1(AB)         ; GET VECTOR\r
2927         PUSHJ   P,PGBIOI        ; READ IT\r
2928         HLRE    C,A             ; GET COUNT DONE\r
2929         HLRE    D,1(AB) ; AND FULL COUNT\r
2930         SUB     C,D             ; C=> TOTAL READ\r
2931         ADDM    C,ACCESS(B)\r
2932         JUMPGE  A,BINIOK        ; NOT EOF YET\r
2933         SETOM   LSTCH(B)\r
2934 BINIOK: MOVE    B,C\r
2935         MOVSI   A,TFIX          ; RETURN AMOUNT ACTUALLY READ\r
2936         JRST    FINIS\r
2937 \r
2938 BUFOU1: SKIPE   BUFSTR(B)       ; ANY BUFFERS AROUND?\r
2939         PUSHJ   P,BFCLS1        ; GET RID OF SAME\r
2940         MOVE    A,1(AB)\r
2941         PUSHJ   P,PGBIOO\r
2942         HLRE    C,1(AB)\r
2943         MOVNS   C\r
2944         addm    c,ACCESS(B)\r
2945         MOVE    A,(AB)          ; RET VECTOR ETC.\r
2946         MOVE    B,1(AB)\r
2947         JRST    FINIS\r
2948 \r
2949 \r
2950 BINEOF: PUSH    TP,EOFCND-1(B)\r
2951         PUSH    TP,EOFCND(B)\r
2952         PUSH    TP,$TCHAN\r
2953         PUSH    TP,B\r
2954         MCALL   1,FCLOSE        ; CLOSE THE LOSER\r
2955         MCALL   1,EVAL\r
2956         JRST    FINIS\r
2957 \r
2958 OPENIT: PUSH    P,E\r
2959         PUSHJ   P,OPNCHN        ;TRY TO OPEN THE LOSER\r
2960         JUMPE   B,CHNCLS        ;FAIL\r
2961         POP     P,E\r
2962         POPJ    P,\r
2963 \f; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE\r
2964 ; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF\r
2965 ; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS.\r
2966 \r
2967 R1CHAR: SKIPN   A,LSTCH(B)              ; CHAR READING ROUTINE FOR FCOPY\r
2968         PUSHJ   P,RXCT\r
2969         MOVEM   A,LSTCH(B)\r
2970         JUMPL   A,.+2                   ; IN CASE OF -1 ON STY\r
2971         TRZN    A,400000                ; EXCL HACKER\r
2972         JRST    .+4\r
2973         MOVEM   A,LSTCH(B)              ; SAVE DE-EXCLED CHAR\r
2974         MOVEI   A,"!\r
2975         JRST    .+2\r
2976         SETZM   LSTCH(B)\r
2977         PUSH    P,C\r
2978         HRRZ    C,DIRECT-1(B)\r
2979         CAIE    C,5                     ; IF DIRECTION IS 5 LONG THEN READB\r
2980         JRST    R1CH1\r
2981         AOS     C,ACCESS-1(B)\r
2982         CAMN    C,[TFIX,,1]\r
2983         AOS     ACCESS(B)               ; EVERY FIFTY INCREMENT\r
2984         CAMN    C,[TFIX,,5]\r
2985         HLLZS   ACCESS-1(B)\r
2986         JRST    .+2\r
2987 R1CH1:  AOS     ACCESS(B)\r
2988         POP     P,C\r
2989         POPJ    P,\r
2990 \r
2991 W1CHAR: CAIE    A,15            ; CHAR WRITING ROUTINE, TEST FOR CR\r
2992         JRST    .+3\r
2993         SETOM   CHRPOS(B)\r
2994         AOSA    LINPOS(B)\r
2995         CAIE    A,12                    ; TEST FOR LF\r
2996         AOS     CHRPOS(B)               ; IF NOT LF AOS CHARACTE5R POSITION\r
2997         CAIE    A,14                    ; TEST FOR FORM FEED\r
2998         JRST    .+3\r
2999         SETZM   CHRPOS(B)               ; IF FORM FEED ZERO CHARACTER POSITION\r
3000         SETZM   LINPOS(B)               ; AND LINE POSITION\r
3001         CAIE    A,11                    ; IS THIS A TAB?\r
3002         JRST    .+6\r
3003         MOVE    C,CHRPOS(B)\r
3004         ADDI    C,7\r
3005         IDIVI   C,8.\r
3006         IMULI   C,8.                    ; FIX UP CHAR POS FOR TAB\r
3007         MOVEM   C,CHRPOS(B)             ; AND SAVE\r
3008         PUSH    P,C\r
3009         HRRZ    C,DIRECT-1(B)\r
3010         CAIE    C,6                     ; SIX LONG MUST BE PRINTB\r
3011         JRST    W1CH1\r
3012         AOS     C,ACCESS-1(B)\r
3013         CAMN    C,[TFIX,,1]\r
3014         AOS     ACCESS(B)\r
3015         CAMN    C,[TFIX,,5]\r
3016         HLLZS   ACCESS-1(B)\r
3017         JRST    .+2\r
3018 W1CH1:  AOS     ACCESS(B)\r
3019         PUSHJ   P,WXCT\r
3020         POP     P,C\r
3021         POPJ    P,\r
3022 \r
3023 R1C:    SUBM    M,(P)                   ;LITTLE ENTRY FOR COMPILED STUFF\r
3024         PUSH    TP,$TCHAN               ;SAVE THE CHANNEL TO BLESS IT\r
3025         PUSH    TP,B\r
3026         MOVEI   B,DIRECT-1(B)\r
3027         PUSHJ   P,CHRWRD\r
3028         JFCL\r
3029         CAME    B,[ASCIZ /READ/]\r
3030         CAMN    B,[ASCII /READB/]\r
3031         JRST    .+2\r
3032         JRST    BADCHN\r
3033         POP     TP,B\r
3034         POP     TP,(TP)\r
3035         SKIPN   IOINS(B)                ; IS THE CHANNEL OPEN\r
3036         PUSHJ   P,OPENIT                ; NO, GO DO IT\r
3037         PUSHJ   P,GRB                   ; MAKE SURE WE HAVE A READ BUFFER\r
3038         PUSHJ   P,R1CHAR                ; AND GET HIM A CHARACTER\r
3039         JRST    MPOPJ                   ; THATS ALL FOLKS\r
3040 \r
3041 W1C:    SUBM    M,(P)\r
3042         PUSHJ   P,W1CI\r
3043         JRST    MPOPJ\r
3044 \r
3045 W1CI:   PUSH    TP,$TCHAN\r
3046         PUSH    TP,B\r
3047         PUSH    P,A                     ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR\r
3048         MOVEI   B,DIRECT-1(B)\r
3049         PUSHJ   P,CHRWRD                ; INTERNAL CALL TO W1CHAR\r
3050         JFCL\r
3051         CAME    B,[ASCII /PRINT/]\r
3052         CAMN    B,[<ASCII /PRINT/>+1]\r
3053         JRST    .+2\r
3054         JRST    BADCHN\r
3055         POP     TP,B\r
3056         POP     TP,(TP)\r
3057         SKIPN   IOINS(B)                ; MAKE SURE THAT IT IS OPEN\r
3058         PUSHJ   P,OPENIT\r
3059         PUSHJ   P,GWB\r
3060         POP     P,A                     ; GET THE CHAR TO DO\r
3061         JRST    W1CHAR\r
3062 \r
3063 ; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT\r
3064 ; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH.\r
3065 \r
3066 \r
3067 WXCT:   PUSH    P,A                     ; SAVE THE CHAR TO WRITE\r
3068         PUSH    TP,$TCHAN               ; AND SAVE THE CHANNEL TOO\r
3069         PUSH    TP,B\r
3070         XCT     IOINS(B)                ; DO THE REAL ONE\r
3071         JRST    DOSCPT                  ; AND CHECK OUT SCRIPTAGE\r
3072 \r
3073 RXCT:   PUSH    TP,$TCHAN\r
3074         PUSH    TP,B                    ; DO IT FOR READS, SAVE THE CHAN\r
3075         XCT     IOINS(B)                ; READ IT\r
3076         PUSH    P,A                     ; AND SAVE THE CHAR AROUND\r
3077         JRST    DOSCPT                  ; AND CHECK OUT SCRIPTAGE\r
3078 \r
3079 DOSCPT: MOVE    B,(TP)                  ;CHECK FOR SCRIPTAGE\r
3080         SKIPN   SCRPTO(B)               ; IF ZERO FORGET IT\r
3081         JRST    SCPTDN                  ; THATS ALL THERE IS TO IT\r
3082         PUSH    P,C                     ; SAVE AN ACCUMULATOR FOR CLEANLINESS\r
3083         GETYP   C,SCRPTO-1(B)           ; IS IT A LIST\r
3084         CAIE    C,TLIST\r
3085         JRST    BADCHN\r
3086         PUSH    TP,$TLIST\r
3087         PUSH    TP,[0]          ; SAVE A SLOT FOR THE LIST\r
3088         MOVE    C,SCRPTO(B)             ; GET THE LIST OF SCRIPT CHANNELS\r
3089 SCPT1:  GETYP   B,(C)                   ; GET THE TYPE OF THIS SCRIPT CHAN\r
3090         CAIE    B,TCHAN\r
3091         JRST    BADCHN                  ; IF IT ISN'T A CHANNEL, COMPLAIN\r
3092         HRRZ    B,(C)                   ; GET THE REST OF THE LIST IN B\r
3093         MOVEM   B,(TP)                  ; AND STORE ON STACK\r
3094         MOVE    B,1(C)                  ; GET THE CHANNEL IN B\r
3095         MOVE    A,-1(P)                 ; AND THE CHARACTER IN A\r
3096         PUSHJ   P,W1CI          ; GO TO INTERNAL W1C, IT BLESSES GOODIES\r
3097         SKIPE   C,(TP)                  ; GET THE REST OF LIST OF CHANS\r
3098         JRST    SCPT1                   ; AND CYCLE THROUGH\r
3099         SUB     TP,[2,,2]               ; CLEAN OFF THE LIST OF CHANS\r
3100         POP     P,C                     ; AND RESTORE ACCUMULATOR C\r
3101 SCPTDN: POP     P,A                     ; RESTORE THE CHARACTER\r
3102         POP     TP,B                    ; AND THE ORIGINAL CHANNEL\r
3103         POP     TP,(TP)\r
3104         POPJ    P,                      ; AND THATS ALL\r
3105 \r
3106 \r
3107 ; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT\r
3108 ; ON THE INPUT CHANNEL\r
3109 ; CALL IS <FILECOPY IN OUT> WHERE DEFAULTS ARE INCHAN AND OUTCHAN\r
3110 \r
3111         MFUNCTION       FCOPY,SUBR,[FILECOPY]\r
3112 \r
3113         ENTRY\r
3114         HLRE    0,AB\r
3115         CAMGE   0,[-4]\r
3116         JRST    WNA                     ; TAKES FROM 0 TO 2 ARGS\r
3117 \r
3118         JUMPE   0,.+4                   ; NO FIRST ARG?\r
3119         PUSH    TP,(AB)\r
3120         PUSH    TP,1(AB)                ; SAVE IN CHAN\r
3121         JRST    .+6\r
3122         MOVE    A,$TATOM\r
3123         MOVE    B,IMQUOTE INCHAN\r
3124         PUSHJ   P,IDVAL\r
3125         PUSH    TP,A\r
3126         PUSH    TP,B\r
3127         HLRE    0,AB                    ; CHECK FOR SECOND ARG\r
3128         CAML    0,[-2]                  ; WAS THERE MORE THAN ONE ARG?\r
3129         JRST    .+4\r
3130         PUSH    TP,2(AB)                ; SAVE SECOND ARG\r
3131         PUSH    TP,3(AB)\r
3132         JRST    .+6\r
3133         MOVE    A,$TATOM                ; LOOK UP OUTCHAN AS DEFAULT\r
3134         MOVE    B,IMQUOTE OUTCHAN\r
3135         PUSHJ   P,IDVAL\r
3136         PUSH    TP,A\r
3137         PUSH    TP,B                    ; AND SAVE IT\r
3138 \r
3139         MOVE    A,-3(TP)\r
3140         MOVE    B,-2(TP)                ; INPUT CHANNEL\r
3141         MOVEI   0,0                             ; INDICATE INPUT\r
3142         PUSHJ   P,CHKCHN                ; CHECK FOR GOOD CHANNEL\r
3143         MOVE    A,-1(TP)\r
3144         MOVE    B,(TP)                  ; GET OUT CHAN\r
3145         MOVEI   0,1                     ; INDICATE OUT CHAN\r
3146         PUSHJ   P,CHKCHN                ; CHECK FOR GOOD OUT CHAN\r
3147 \r
3148         PUSH    P,[0]                   ; COUNT OF CHARS OUTPUT\r
3149 \r
3150         MOVE    B,-2(TP)\r
3151         PUSHJ   P,GRB                   ; MAKE SURE WE HAVE READ BUFF\r
3152         MOVE    B,(TP)\r
3153         PUSHJ   P,GWB                   ; MAKE SURE WE HAVE WRITE BUFF\r
3154 \r
3155 FCLOOP: MOVE    B,-2(TP)\r
3156         PUSHJ   P,R1CHAR                ; GET A CHAR\r
3157         JUMPL   A,FCDON                 ; IF A NEG NUMBER WE GOT EOF\r
3158         MOVE    B,(TP)                  ; GET OUT CHAN\r
3159         PUSHJ   P,W1CHAR                ; SPIT IT OUT\r
3160         AOS     (P)                     ; INCREMENT COUNT\r
3161         JRST    FCLOOP\r
3162 \r
3163 FCDON:  SUB     TP,[2,,2]               ; POP OFF OUTCHAN\r
3164         MCALL   1,FCLOSE                ; CLOSE INCHAN\r
3165         MOVE    A,$TFIX\r
3166         POP     P,B                     ; GET CHAR COUNT TO RETURN\r
3167         JRST FINIS\r
3168 \r
3169 CHKCHN: PUSH    P,0                     ; CHECK FOR GOOD TASTING CHANNEL\r
3170         PUSH    TP,A\r
3171         PUSH    TP,B\r
3172         GETYP   C,A\r
3173         CAIE    C,TCHAN\r
3174         JRST    CHKBDC                  ; GO COMPLAIN IN RIGHT WAY\r
3175         MOVEI   B,DIRECT-1(B)\r
3176         PUSHJ   P,CHRWRD\r
3177         JRST    CHKBDC\r
3178         MOVE    C,(P)                   ; GET CHAN DIRECT\r
3179         CAMN    B,CHKT(C)\r
3180         JRST    .+4\r
3181         ADDI    C,2                     ; TEST FOR READB OR PRINTB ALSO\r
3182         CAME    B,CHKT(C)               ; TEST FOR CORRECT DIRECT\r
3183         JRST    CHKBDC\r
3184         MOVE    B,(TP)\r
3185         SKIPN   IOINS(B)                ; MAKE SURE IT IS OPEN\r
3186         PUSHJ   P,OPENIT                ; IF ZERO IOINS GO OPEN IT\r
3187         SUB     TP,[2,,2]\r
3188         POP     P,                      ; CLEAN UP STACKS\r
3189         POPJ    P,\r
3190 \r
3191 CHKT:   ASCIZ /READ/\r
3192         ASCII /PRINT/\r
3193         ASCII /READB/\r
3194         <ASCII /PRINT/>+1\r
3195 \r
3196 CHKBDC: POP     P,E\r
3197         MOVNI   D,2\r
3198         IMULI   D,1(E)\r
3199         HLRE    0,AB\r
3200         CAMLE   0,D                     ; SEE IF THIS WAS HIS ARG OF DEFAULT\r
3201         JRST    BADCHN\r
3202         JUMPE   E,WTYP1\r
3203         JRST    WTYP2\r
3204 \r
3205 \f; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB,\r
3206 ; THAT IS THEY READ INTO AND OUT OF STRINGS.  IN ADDITION BOTH ACCEPT\r
3207 ; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF\r
3208 ; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING.\r
3209 \r
3210 ; FORMAT IS <READSTRING .STRING .INCHANNEL .EOFCOND .MAXCHARS>\r
3211 ; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN\r
3212 \r
3213 ; FORMAT FOR PRINTSTRING IS <PRINTSTRING .STRING .OUTCHANNEL .MAXCHARS>\r
3214 \r
3215 ; THESE WERE CODED 9/16/73 BY NEAL D. RYAN\r
3216 \r
3217         MFUNCTION       RSTRNG,SUBR,READSTRING\r
3218 \r
3219         ENTRY\r
3220         PUSH    P,[0]           ; FLAG TO INDICATE READING\r
3221         HLRE    0,AB\r
3222         CAMG    0,[-1]\r
3223         CAMG    0,[-9]\r
3224         JRST    WNA             ; CHECK THAT IT HAS FROM 1 TO 4 ARGS\r
3225         JRST    STRIO1\r
3226 \r
3227         MFUNCTION       PSTRNG,SUBR,PRINTSTRING\r
3228 \r
3229         ENTRY\r
3230         PUSH    P,[1]           ; FLAG TO INDICATE WRITING\r
3231         HLRE    0,AB\r
3232         CAMG    0,[-1]\r
3233         CAMG    0,[-7]\r
3234         JRST    WNA             ; CHECK THAT IT HAS FROM 1 TO 3 ARGS\r
3235 \r
3236 STRIO1: PUSH    TP,[0]          ; SAVE SLOT ON STACK\r
3237         PUSH    TP,[0]\r
3238         GETYP   0,(AB)\r
3239         CAIE    0,TCHSTR                ; MAKE SURE WE GOT STRING\r
3240         JRST    WTYP1\r
3241         HRRZ    0,(AB)          ; CHECK FOR EMPTY STRING\r
3242         SKIPN   (P)\r
3243         JUMPE   0,MTSTRN\r
3244         HLRE    0,AB\r
3245         CAML    0,[-2]          ; WAS A CHANNEL GIVEN\r
3246         JRST    STRIO2\r
3247         GETYP   0,2(AB)\r
3248         CAIE    0,TCHAN\r
3249         JRST    WTYP2           ; SECOND ARG NOT CHANNEL\r
3250         MOVE    B,3(AB)\r
3251         MOVEI   B,DIRECT-1(B)\r
3252         PUSHJ   P,CHRWRD\r
3253         JFCL\r
3254         MOVNI   E,1             ; CHECKING FOR GOOD DIRECTION\r
3255         CAMN    B,[ASCII /READ/]\r
3256         MOVEI   E,0\r
3257         CAMN    B,[ASCII /PRINT/]\r
3258         MOVEI   E,1\r
3259         CAMN    B,[<ASCII /PRINT/>+1]\r
3260         MOVEI   E,1\r
3261         CAMN    B,[ASCII /READB/]\r
3262         MOVEI   E,0\r
3263         CAME    E,(P)\r
3264         JRST    WRONGD          ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE\r
3265         PUSH    TP,2(AB)\r
3266         PUSH    TP,3(AB)        ; PUSH ON CHANNEL\r
3267         JRST    STRIO3\r
3268 STRIO2: MOVE    B,IMQUOTE INCHAN\r
3269         MOVSI   A,TCHAN\r
3270         SKIPE   (P)\r
3271         MOVE    B,IMQUOTE OUTCHAN\r
3272         PUSHJ   P,IDVAL\r
3273         TLZ     A,TYPMSK#777777\r
3274         CAME    A,$TCHAN\r
3275         JRST    BADCHN          ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL\r
3276         PUSH    TP,A\r
3277         PUSH    TP,B\r
3278 STRIO3: MOVE    B,(TP)          ; GET CHANNEL\r
3279         SKIPN   E,IOINS(B)              ; MAKE SURE HE IS OPEN\r
3280         PUSHJ   P,OPENIT                ; IF NOT GO OPEN\r
3281         CAMN    E,[JRST CHNCLS]\r
3282         JRST    CHNCLS          ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED\r
3283 STRIO4: HLRE    0,AB\r
3284         CAML    0,[-4]\r
3285         JRST    STRIO5          ; NO COUNT TO WORRY ABOUT\r
3286         GETYP   0,4(AB)\r
3287         MOVE    E,4(AB)\r
3288         MOVE    C,5(AB)\r
3289         CAIE    0,TCHSTR\r
3290         CAIN    0,TFIX          ; BETTER BE A FIXED NUMBER\r
3291         JRST    .+2\r
3292         JRST    WTYP3\r
3293         HRRZ    D,(AB)          ; GET ACTUAL STRING LENGTH\r
3294         CAIN    0,TFIX\r
3295         JRST    .+7\r
3296         SKIPE   (P)     ; TEST FOR WRITING\r
3297         JRST    .-7             ; IF WRITING WE GOT TROUBLE\r
3298         PUSH    P,D             ; ACTUAL STRING LENGTH\r
3299         MOVEM   E,(TB)  ; STUFF HIS FUNNY DELIM STRING\r
3300         MOVEM   C,1(TB)\r
3301         JRST    STRIO7\r
3302         CAML    D,C             ; MAKE SURE THE STRING IS LONG ENOUGH\r
3303         JRST    .+4             ; WIN\r
3304         PUSH    TP,$TATOM       ; LOSAGE, COUNT TOO GREAT\r
3305         PUSH    TP,EQUOTE COUNT-GREATER-THAN-STRING-SIZE\r
3306         JRST    CALER1\r
3307         PUSH    P,C     ; PUSH ON MAX COUNT\r
3308         JRST    STRIO7\r
3309 STRIO5:\r
3310 STRIO6: HRRZ    C,(AB)  ; GET CHAR COUNT\r
3311         PUSH    P,C             ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN\r
3312 STRIO7: HLRE    0,AB\r
3313         CAML    0,[-6]\r
3314         JRST    .+6\r
3315         MOVE    B,(TP)          ; GET THE CHANNEL\r
3316         MOVE    0,6(AB)\r
3317         MOVEM   0,EOFCND-1(B)   ; STUFF IN SLOT IN CHAN\r
3318         MOVE    0,7(AB)\r
3319         MOVEM   0,EOFCND(B)\r
3320         PUSH    TP,(AB)         ; PUSH ON STRING\r
3321         PUSH    TP,1(AB)\r
3322         PUSH    P,[0]           ; PUSH ON CURRENT COUNT OF CHARS DONE\r
3323         MOVE    0,-2(P)         ; GET READ OR WRITE FLAG\r
3324         JUMPN   0,OUTLOP        ; GO WRITE STUFF\r
3325 \r
3326         MOVE    B,-2(TP)        ; GET CHANNEL\r
3327         PUSHJ   P,GRB           ; MAKE SURE WE HAVE BUFF\r
3328         SKIPGE  A,LSTCH(B)      ; CHECK FOR EOF ALREADY READ PREVIOUSLY\r
3329         JRST    SRDOEF          ; GO DOES HIS EOF HACKING\r
3330 INLOP:  INTGO\r
3331         MOVE    B,-2(TP)        ; GET CHANNEL\r
3332         MOVE    C,-1(P)         ; MAX COUNT\r
3333         CAMG    C,(P)           ; COMPARE WITH COUNT DONE\r
3334         JRST    STREOF          ; WE HAVE FINISHED\r
3335         PUSHJ   P,R1CHAR        ; GET A CHAR\r
3336         JUMPL   A,INEOF         ; EOF HIT\r
3337         MOVE    C,1(TB)\r
3338         HRRZ    E,(TB)          ; DO WE HAVE A STRING TO WORRY US?\r
3339         SOJL    E,INLNT         ; GO FINISH STUFFING\r
3340         ILDB    D,C\r
3341         CAME    D,A\r
3342         JRST    .-3\r
3343         JRST    INEOF\r
3344 INLNT:  IDPB    A,(TP)          ; STUFF IN STRING\r
3345         SOS     -1(TP)          ; DECREMENT STRING COUNT\r
3346         AOS     (P)             ; INCREMENT CHAR COUNT\r
3347         JRST    INLOP\r
3348 \r
3349 INEOF:  SKIPE   C,LSTCH(B)      ; IS THIS AN ! AND IS THERE A CHAR THERE\r
3350         JRST    .+3             ; YES\r
3351         MOVEM   A,LSTCH(B)      ; NO SAVE THE CHAR\r
3352         JRST    .+3\r
3353         ADDI    C,400000\r
3354         MOVEM   C,LSTCH(B)\r
3355         HRRZ    C,DIRECT-1(B)   ; GET THE TYPE OF CHAN\r
3356         CAIN    C,5             ; IS IT READB?\r
3357         JRST    .+3\r
3358         SOS     ACCESS(B)       ; FIX UP ACCESS FOR READ CHANNEL\r
3359         JRST    STREOF          ; AND THATS IT\r
3360         HRRZ    C,ACCESS-1(B)   ; FOR A READB ITS WORSE\r
3361         MOVEI   D,5\r
3362         SKIPG   C\r
3363         HRRM    D,ACCESS-1(B)   ; CHANGE A 0 TO A FIVE\r
3364         SOS     C,ACCESS-1(B)\r
3365         CAMN    C,[TFIX,,0]\r
3366         SOS     ACCESS(B)       ; AND SOS THE WORD COUNT MAYBE\r
3367         JRST    STREOF\r
3368 \r
3369 SRDOEF: SETZM   LSTCH(B)        ; IN CASE OF -1, FLUSH IT\r
3370         AOJE    A,INLOP         ; SKIP OVER -1 ON PTY'S\r
3371         SUB     TP,[6,,6]\r
3372         SUB     P,[3,,3]        ; POP JUNK OFF STACKS\r
3373         PUSH    TP,EOFCND-1(B)\r
3374         PUSH    TP,EOFCND(B)    ; WHAT WE NEED TO EVAL\r
3375         PUSH    TP,$TCHAN\r
3376         PUSH    TP,B\r
3377         MCALL   1,FCLOSE        ; CLOSE THE LOOSING CHANNEL\r
3378         MCALL   1,EVAL          ; EVAL HIS EOF JUNK\r
3379         JRST    FINIS\r
3380 \r
3381 OUTLOP: MOVE    B,-2(TP)\r
3382         PUSHJ   P,GWB           ; MAKE SURE WE HAVE BUFF\r
3383 OUTLP1: INTGO\r
3384         MOVE    B,-2(TP)\r
3385         MOVE    C,-1(P)         ; MAX COUNT TO DO\r
3386         CAMG    C,(P)           ; HAVE WE DONE ENOUGH\r
3387         JRST    STREOF\r
3388         ILDB    A,(TP)          ; GET THE CHAR\r
3389         SOS     -1(TP)  ; SUBTRACT FROM STRING LENGTH\r
3390         AOS     (P)             ; INC COUNT OF CHARS DONE\r
3391         PUSHJ   P,W1CHAR        ; GO STUFF CHAR\r
3392         JRST    OUTLP1\r
3393 \r
3394 STREOF: MOVE    A,$TFIX\r
3395         POP     P,B             ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE\r
3396         SUB     P,[2,,2]\r
3397         SUB     TP,[6,,6]\r
3398         JRST    FINIS\r
3399 \r
3400 \r
3401 GWB:    SKIPE   BUFSTR(B)\r
3402         POPJ    P,\r
3403         PUSH    TP,$TCHAN\r
3404         PUSH    TP,B            ; GET US A WRITE BUFFER ON PRINTB CHAN\r
3405         MOVEI   A,BUFLNT\r
3406         PUSHJ   P,IBLOCK\r
3407         MOVSI   A,TWORD+.VECT.\r
3408         MOVEM   A,BUFLNT(B)\r
3409         SETOM   (B)\r
3410         MOVEI   C,1(B)\r
3411         HRLI    C,(B)\r
3412         BLT     C,BUFLNT-1(B)\r
3413         MOVE    C,B\r
3414         HRLI    C,440700\r
3415         MOVE    B,(TP)\r
3416         MOVEI   0,C.BUF\r
3417         IORM    0,-4(B)\r
3418         MOVEM   C,BUFSTR(B)\r
3419         MOVE    C,[TCHSTR,,BUFLNT*5]\r
3420         MOVEM   C,BUFSTR-1(B)\r
3421         SUB     TP,[2,,2]\r
3422         POPJ    P,\r
3423 \r
3424 \r
3425 GRB:    SKIPE   BUFSTR(B)\r
3426         POPJ    P,\r
3427         PUSH    TP,$TCHAN\r
3428         PUSH    TP,B            ; GET US A READ BUFFER\r
3429         MOVEI   A,BUFLNT\r
3430         PUSHJ   P,IBLOCK\r
3431         MOVEI   C,BUFLNT(B)\r
3432         POP     TP,B\r
3433         MOVEI   0,C.BUF\r
3434         IORM    0,-4(B)\r
3435         HRLI    C,440700\r
3436         MOVEM   C,BUFSTR(B)\r
3437         MOVSI   C,TCHSTR\r
3438         MOVEM   C,BUFSTR-1(B)\r
3439         SUB     TP,[1,,1]\r
3440         POPJ    P,\r
3441 \r
3442 MTSTRN: PUSH    TP,$TATOM\r
3443         PUSH    TP,EQUOTE EMPTY-STRING\r
3444         JRST    CALER1\r
3445 \r
3446 \f; INPUT UNBUFFERING ROUTINE.  THIS DOES THE CHARACTER UNBUFFERING\r
3447 ; FOR INPUT.  THE OPEN ROUTINE SETUPS A PUSHJ P, TO\r
3448 ; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE.\r
3449 \r
3450 ; H. BRODIE 7/19/72\r
3451 \r
3452 ; CALLING SEQ:\r
3453 ;       PUSHJ   P,GETCHR\r
3454 ;               B/ AOBJN PNTR TO CHANNEL VECTOR\r
3455 ;               RETURNS NEXT CHARACTER IN AC A.\r
3456 ;       ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND\r
3457 ;       TRANSMITS ONLY ^C ON SUCCESSIVE CALLS\r
3458 \r
3459 \r
3460 GETCHR:\r
3461 ; FIRST GRAB THE BUFFER\r
3462         GETYP   A,BUFSTR-1(B)   ; GET TYPE WORD\r
3463         CAIN    A,TCHSTR        ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER)\r
3464         JRST    GTGBUF          ; IS GOOD BUFFER...SKIP ERROR RETURN\r
3465 BDCHAN: PUSH    TP,$TATOM       ; ERROR RETURN\r
3466         PUSH    TP,EQUOTE BAD-INPUT-BUFFER\r
3467         JRST    CALER1\r
3468 \r
3469 ; BUFFER WAS GOOD\r
3470 GTGBUF: HRRZ    A,BUFSTR-1(B)   ; GET LENGTH OF STRING\r
3471         SOJGE   A,GTGCHR        ; JUMP IF STILL MORE\r
3472 \r
3473 ; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS)\r
3474 ; GENERATE AN .IOT POINTER\r
3475 ;FIRST SAVE C AND D AS I WILL CLOBBER THEM\r
3476 NEWBUF: PUSH    P,C\r
3477         PUSH    P,D\r
3478 IFN ITS,[\r
3479         LDB     C,[600,,STATUS(B)]      ; GET TYPE\r
3480         CAIG    C,2             ; SKIP IF NOT TTY\r
3481 ]\r
3482 IFE ITS,[\r
3483         SKIPE   BUFRIN(B)\r
3484 ]\r
3485         JRST    GETTTY          ; GET A TTY BUFFER\r
3486 \r
3487         PUSHJ   P,PGBUFI        ; RE-FILL BUFFER\r
3488 \r
3489         JUMPGE  A,BUFGOO                ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL\r
3490         MOVEI   C,1             ; MAKE SURE LAST EOF REALLY ENDS IT\r
3491         ANDCAM  C,-1(A)\r
3492         MOVSI   C,014000        ; GET A ^C\r
3493         MOVEM   C,(A)           ;FAKE AN EOF\r
3494 \r
3495 ; RESET THE BYTE POINTER IN THE CHANNEL.\r
3496 ; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D\r
3497 BUFGOO: HRLI    D,440700        ; GENERATE VIRGIN LH\r
3498 \r
3499         MOVEM   D,BUFSTR(B)     ; STASH IN THE BUFFER BYTE PNTR SLOT\r
3500         MOVEI   A,BUFLNT*5-1\r
3501 BUFROK: POP     P,D             ;RESTORE D\r
3502         POP     P,C             ;RESTORE C\r
3503 \r
3504 \r
3505 ; HERE IF THERE ARE CHARS IN BUFFER\r
3506 GTGCHR: HRRM    A,BUFSTR-1(B)\r
3507         ILDB    A,BUFSTR(B)     ; GET A CHAR FROM BUFFER\r
3508 IFE ITS,[\r
3509         CAIN    A,32    ; TENEX EOF?\r
3510         JRST    .+3\r
3511 ]\r
3512         CAIE    A,3             ; EOF?\r
3513         POPJ    P,              ; AND RETURN\r
3514 IFN ITS,[\r
3515         LDB     A,[600,,STATUS(B)]      ; CHECK FOR TTY\r
3516         CAILE   A,2             ; SKIP IF TTY\r
3517 ]\r
3518 IFE ITS,        SKIPN   BUFRIN(B)\r
3519 \r
3520         JRST    .+3\r
3521 RETEO1: HRRI    A,3\r
3522         POPJ    P,\r
3523 \r
3524         HRRZ    A,@BUFSTR(B)    ; SEE IF RSUBR START BIT IS ON\r
3525         TRNN    A,1\r
3526         MOVSI   A,-1\r
3527         JRST    RETEO1\r
3528 \r
3529 IFN ITS,[\r
3530 PGBUFO:\r
3531 PGBUFI:\r
3532 ]\r
3533 IFE ITS,[\r
3534 PGBUFO: SKIPA   D,[SOUT]\r
3535 PGBUFI: MOVE    D,[SIN]\r
3536 ]\r
3537         SKIPGE  A,BUFSTR(B)     ; POINT TO CURRENT BUFFER POSIT\r
3538         SUBI    A,1             ; FOR 440700 AND 010700 START\r
3539         SUBI    A,BUFLNT-1      ; CALCULATE PNTR TO BEG OF BUFFER\r
3540         HRLI    A,-BUFLNT       ; IOT (AOBJN) PNTR IN A\r
3541 IFN ITS,[\r
3542 PGBIOO:\r
3543 PGBIOI: MOVE    D,A             ; COPY FOR LATER\r
3544         MOVSI   C,TUVEC         ; PREPARE TO HANDDLE INTS\r
3545         MOVEM   C,DSTO(PVP)\r
3546         MOVEM   C,ASTO(PVP)\r
3547         MOVSI   C,TCHAN\r
3548         MOVEM   C,BSTO(PVP)\r
3549 \r
3550 ; BUILD .IOT INSTR\r
3551         MOVE    C,CHANNO(B)     ; CHANNEL NUMBER IN C\r
3552         ROT     C,23.           ; MOVE INTO AC FIELD\r
3553         IOR     C,[.IOT 0,A]    ; IOR IN SKELETON .IOT\r
3554 \r
3555 ; DO THE .IOT\r
3556         ENABLE                  ; ALLOW INTS\r
3557         XCT     C               ; EXECUTE THE .IOT INSTR\r
3558         DISABLE\r
3559         SETZM   BSTO(PVP)\r
3560         SETZM   ASTO(PVP)\r
3561         SETZM   DSTO(PVP)\r
3562         POPJ    P,\r
3563 ]\r
3564 \r
3565 IFE ITS,[\r
3566 PGBIOT: PUSH    P,D\r
3567         PUSH    TP,$TCHAN\r
3568         PUSH    TP,B\r
3569         MOVEI   C,(A)           ; POINT TO BUFFER\r
3570         HRLI    C,444400\r
3571         MOVE    D,A             ; XTRA POINTER\r
3572         MOVE    A,CHANNO(B)     ; FILE JFN\r
3573         MOVE    B,C\r
3574         HLRE    C,D             ; - COUNT TO C\r
3575         XCT     (P)             ; DO IT TO IT\r
3576         MOVEI   A,1(B)\r
3577         MOVE    B,(TP)\r
3578         SUB     TP,[2,,2]\r
3579         SUB     P,[1,,1]\r
3580         JUMPGE  C,CPOPJ         ; NO EOF YET\r
3581         HRLI    A,(C)           ; LOOK LIKE AN AOBJN PNTR\r
3582         POPJ    P,\r
3583 \r
3584 PGBIOO: SKIPA   D,[SOUT]\r
3585 PGBIOI: MOVE    D,[SIN]\r
3586         JRST    PGBIOT\r
3587 DOIOTO: PUSH    P,D\r
3588         PUSH    P,C\r
3589         PUSHJ   P,PGBIOO\r
3590 DOIOTE: POP     P,C\r
3591         POP     P,D\r
3592         POPJ    P,\r
3593 DOIOTI: PUSH    P,D\r
3594         PUSH    P,C\r
3595         PUSHJ   P,PGBIOI\r
3596         JRST    DOIOTE\r
3597 ]\r
3598 \f\r
3599 ; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE\r
3600 \r
3601 PUTCHR: PUSH    P,A\r
3602         GETYP   A,BUFSTR-1(B)   ; CHECK TYPE OF ARG\r
3603         CAIE    A,TCHSTR        ; MUST BE STRING\r
3604         JRST    BDCHAN\r
3605 \r
3606         HRRZ    A,BUFSTR-1(B)   ; GET CHAR COUNT\r
3607         JUMPE   A,REBUFF        ; PREV RESET BUFF, UNDO SAME\r
3608 \r
3609 PUTCH1: POP     P,A             ; RESTORE CHAR\r
3610         CAMN    A,[-1]          ; SPECIAL HACK?\r
3611         JRST    PUTCH2          ; YES GO HANDLE\r
3612         IDPB    A,BUFSTR(B)     ; STUFF IT\r
3613 PUTCH3: SOS     A,BUFSTR-1(B)   ; COUNT DOWN STRING\r
3614         TRNE    A,-1            ; SKIP IF FULL\r
3615         POPJ    P,\r
3616 \r
3617 ; HERE TO FLUSH OUT A BUFFER\r
3618 \r
3619         PUSH    P,C\r
3620         PUSH    P,D\r
3621         PUSHJ   P,PGBUFO        ; SETUP AND DO IOT\r
3622         HRLI    D,440700        ; POINT INTO BUFFER\r
3623         MOVEM   D,BUFSTR(B)     ; STORE IT\r
3624         MOVEI   A,BUFLNT*5      ; RESET  COUNT\r
3625         HRRM    A,BUFSTR-1(B)\r
3626         POP     P,D\r
3627         POP     P,C\r
3628         POPJ    P,\r
3629 \r
3630 ;HERE TO DA ^C AND TURN ON MAGIC BIT\r
3631 \r
3632 PUTCH2: MOVEI   A,3\r
3633         IDPB    A,BUFSTR(B)     ; ZAP OUT THE ^C\r
3634         MOVEI   A,1             ; GET BIT\r
3635         IORM    A,@BUFSTR(B)    ; ON GOES THE BIT\r
3636         JRST    PUTCH3\r
3637 \r
3638 ; RESET A FUNNY BUF\r
3639 \r
3640 REBUFF: MOVEI   A,BUFLNT*5              ; 1ST COUNT\r
3641         HRRM    A,BUFSTR-1(B)\r
3642         HRRZ    A,BUFSTR(B)             ; NOW POINTER\r
3643         SUBI    A,BUFLNT\r
3644         HRLI    A,440700\r
3645         MOVEM   A,BUFSTR(B)             ; STORE BACK\r
3646         JRST    PUTCH1\r
3647 \r
3648 \r
3649 ; HERE TO FLUSH FINAL BUFFER\r
3650 \r
3651 BFCLOS: HLLZS   ACCESS-1(B)     ; CLEAR OUT KLUDGE PRINTB PART ACCESS COUNT\r
3652         MOVE    C,B             ; THIS BUFFER FLUSHER THE WORK OF NDR\r
3653         MOVEI   B,RDEVIC-1(B)   ; FIND OUT IF THIS IS NET\r
3654         PUSHJ   P,CHRWRD\r
3655         JFCL\r
3656         TRZ     B,77777         ; LEAVE ONLY HIGH 3 CHARS\r
3657         MOVEI   A,0             ; FLAG 0=NET 1=DSK\r
3658         CAME    B,[ASCIZ /NET/] ; IS THIS NET?\r
3659         AOS     A\r
3660         PUSH    P,A             ; SAVE THE RESULT OF OUR TEST\r
3661         MOVE    B,C             ; RESTORE CHANNEL IN B\r
3662         JUMPN   A,BFCLNN        ; DONT HAVE TO CHECK NET STATE\r
3663         PUSH    TP,$TCHAN\r
3664         PUSH    TP,B            ; SAVE CHANNEL\r
3665         PUSHJ   P,INSTAT        ; GET CURRENT NETWORK STATE\r
3666         MOVE    A,(B)           ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE\r
3667         POP     TP,B            ; RESTORE B\r
3668         POP     TP,\r
3669         CAIE    A,5             ; IS NET IN OPEN STATE?\r
3670         CAIN    A,6             ; OR ELSE IS IT IN RFNM WAIT STATE\r
3671         JRST    BFCLNN          ; IF SO TO THE IOT\r
3672         POP     P,              ; ELSE FLUSH CRUFT AND DONT IOT\r
3673         POPJ    P,              ; RETURN DOING NO IOT\r
3674 BFCLNN: MOVEI   C,BUFLNT*5      ; NEW BUFFER FLUSHER BY NDR\r
3675         HRRZ    D,BUFSTR-1(B)   ; SO THAT NET ALSO WORKS RIGHT\r
3676         SUBI    C,(D)           ; GET NUMBER OF CHARS\r
3677         IDIVI   C,5             ; NUMBER OF FULL WORDS AND REST\r
3678         PUSH    P,D             ; SAVE NUMBER OF ODD CHARS\r
3679         SKIPGE  A,BUFSTR(B)     ; GET CURRENT BUF POSITION\r
3680         SUBI    A,1             ; FIX FOR 440700 BYTE POINTER\r
3681         PUSH    P,(A)           ; SAVE THE ODD WORD OF BUFFER\r
3682         MOVEI   D,BUFLNT\r
3683         SUBI    D,(C)\r
3684         SKIPE   -1(P)\r
3685         SUBI    A,1\r
3686         ADDI    D,1(A)          ; FIX UP FOR POSSIBLE ODD CHARS\r
3687         PUSH    TP,$TUVEC\r
3688         PUSH    TP,D            ; PUSH THE DOPE VECTOR ONTO THE STACK\r
3689         JUMPE   C,BFCLSR        ; IN CASE THERE ARE NO FULL WORDS TO DO\r
3690         HRL     A,C\r
3691         MOVE    E,[A,,BUFLNT]\r
3692         SUBI    E,(C)   ; FIX UP FOR BACKWARDS BLT\r
3693         POP     A,@E            ; AMAZING GRACE\r
3694         TLNE    A,-1\r
3695         JRST    .-2\r
3696         HRRO    A,D             ; SET UP AOBJN POINTER\r
3697         SUBI    A,(C)\r
3698         TLC     A,-1(C)\r
3699         PUSHJ   P,PGBIOO        ; DO THE IOT OF ALL THE FULL WORDS\r
3700 BFCLSR: HRRO    A,(TP)          ; GET IOT PTR FOR REST OF JUNK\r
3701         SUBI    A,1             ; POINT TO WORD BEFORE DOPE WORDS\r
3702         POP     P,0             ; GET BACK ODD WORD\r
3703         POP     P,C             ; GET BACK ODD CHAR COUNT\r
3704         POP     P,D             ; FLAG FOR NET OR DSK\r
3705         JUMPE   C,BFCLSD        ; IF NO ODD CHARS FINISH UP\r
3706         JUMPN   D,BFCDSK        ; GO FINISH OFF DSK\r
3707         MOVEI   D,7\r
3708         IMULI   D,(C)           ; FIND NO OF BITS TO SHIFT\r
3709         LSH     0,-43(D)        ; SHIFT BITS TO RIGHT PLACE\r
3710         MOVEM   0,(A)   ; STORE IN STRING\r
3711         SUBI    C,5             ; HOW MANY CHAR POSITIONS TO SKIP\r
3712         MOVNI   C,(C)           ; MAKE C POSITIVE\r
3713         LSH     C,17\r
3714         TLC     A,(C)           ; MUNG THE AOBJN POINTER TO KLUDGE\r
3715         PUSHJ   P,PGBIOO        ; DO IOT OF ODD CHARS\r
3716 BFCLSD: HRRZ    A,(TP)  ; GET PTR TO DOPE WORD\r
3717         SUBI    A,BUFLNT\r
3718         HRLI    A,440700        ; AOBJN POINTER TO FIRST OF BUFFER\r
3719         MOVEM   A,BUFSTR(B)\r
3720         MOVEI   A,BUFLNT*5\r
3721         HRRM    A,BUFSTR-1(B)\r
3722         SUB     TP,[2,,2]\r
3723         POPJ    P,\r
3724 \r
3725 BFCDSK: MOVE    C,A             ; FOR FUNNY AOBJN PTR\r
3726         HLL     C,BUFSTR(B)     ; POINT INTO WORD AFTER LAST CHAR\r
3727         TRZ     0,1\r
3728         MOVEM   0,(A)\r
3729 IFN ITS,        MOVEI   0,3             ; CONTROL C\r
3730 IFE ITS,        MOVEI   0,32            ; CNTL Z\r
3731         IDPB    0,C\r
3732         PUSHJ   P,PGBIOO\r
3733         JRST    BFCLSD\r
3734 \r
3735 BFCLS1: HRRZ    C,DIRECT-1(B)\r
3736         MOVSI   0,(JFCL)\r
3737         CAIE    C,6\r
3738         MOVE    0,[AOS ACCESS(B)]\r
3739         PUSH    P,0\r
3740         HRRZ    C,BUFSTR-1(B)\r
3741         IDIVI   C,5\r
3742         JUMPE   D,BCLS11\r
3743         MOVEI   A,40            ; PAD WITH SPACES\r
3744         PUSHJ   P,PUTCHR\r
3745         XCT     (P)             ; AOS ACCESS IF NECESSARY\r
3746         SOJG    D,.-3           ; TO END OF WORD\r
3747 BCLS11: POP     P,0\r
3748         HLLZS   ACCESS-1(B)\r
3749         HRRZ    C,BUFSTR-1(B)\r
3750         CAIE    C,BUFLNT*5\r
3751         PUSHJ   P,BFCLOS\r
3752         POPJ    P,\r
3753 \r
3754 \f\r
3755 ; HERE TO GET A TTY BUFFER\r
3756 \r
3757 GETTTY: SKIPN   C,EXBUFR(B)     ; SKIP IF BUFFERS BACKED UP\r
3758         JRST    TTYWAI\r
3759         HRRZ    D,(C)           ; CDR THE LIST\r
3760         GETYP   A,(C)           ; CHECK TYPE\r
3761         CAIE    A,TDEFER        ; MUST BE DEFERRED\r
3762         JRST    BDCHAN\r
3763         MOVE    C,1(C)          ; GET DEFERRED GOODIE\r
3764         GETYP   A,(C)           ; BETTER BE CHSTR\r
3765         CAIE    A,TCHSTR\r
3766         JRST    BDCHAN\r
3767         MOVE    A,(C)           ; GET FULL TYPE WORD\r
3768         MOVE    C,1(C)\r
3769         MOVEM   D,EXBUFR(B)     ; STORE CDR'D LIST\r
3770         MOVEM   A,BUFSTR-1(B)   ; MAKE CURRENT BUFFER\r
3771         MOVEM   C,BUFSTR(B)\r
3772         SOJA    A,BUFROK\r
3773 \r
3774 TTYWAI: PUSHJ   P,TTYBLK        ; BLOCKED FOR TTY I/O\r
3775         JRST    GETTTY          ; SHOULD ONLY RETURN HAPPILY\r
3776 \r
3777 \f;INTERNAL DEVICE READ ROUTINE.\r
3778 \r
3779 ;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,\r
3780 ;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER,\r
3781 ;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE"\r
3782 \r
3783 ;H. BRODIE 8/31/72\r
3784 \r
3785 GTINTC: PUSH    TP,$TCHAN       ;SAVE THE CHANNEL...WE'LL CLOBBER B\r
3786         PUSH    TP,B\r
3787         PUSH    P,C     ;AND SAVE THE OTHER ACS\r
3788         PUSH    P,D\r
3789         PUSH    P,E\r
3790         PUSH    P,0\r
3791         PUSH    TP,INTFCN-1(B)\r
3792         PUSH    TP,INTFCN(B)\r
3793         MCALL   1,APPLY\r
3794         GETYP   A,A\r
3795         CAIE    A,TCHRS\r
3796         JRST    BADRET\r
3797         MOVE    A,B\r
3798 INTRET: POP     P,0             ;RESTORE THE ACS\r
3799         POP     P,E\r
3800         POP     P,D\r
3801         POP     P,C\r
3802         POP     TP,B            ;RESTORE THE CHANNEL\r
3803         SUB     TP,[1,,1]       ;FLUSH $TCHAN...WE DON'T NEED IT\r
3804         POPJ    P,\r
3805 \r
3806 \r
3807 BADRET: PUSH    TP,$TATOM\r
3808         PUSH    TP,EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT\r
3809         JRST    CALER1\r
3810 \r
3811 ;INTERNAL DEVICE PRINT ROUTINE.\r
3812 \r
3813 ;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR)\r
3814 ;TO THE CURRENT CHARACTER BEING "PRINTED".\r
3815 \r
3816 PTINTC: PUSH    TP,$TCHAN       ;SAVE THE CHANNEL...WE'LL CLOBBER B\r
3817         PUSH    TP,B\r
3818         PUSH    P,C     ;AND SAVE THE OTHER ACS\r
3819         PUSH    P,D\r
3820         PUSH    P,E\r
3821         PUSH    P,0\r
3822         PUSH    TP,INTFCN-1(B)  ;PUSH TYPE OF GIVEN OBJ\r
3823         PUSH    TP,INTFCN(B)    ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.)\r
3824         PUSH    TP,$TCHRS       ;PUSH THE TYPE "CHARACTER"\r
3825         PUSH    TP,A            ;PUSH THE CHAR\r
3826         MCALL   2,APPLY         ;APPLY THE FUNCTION TO THE CHAR\r
3827         JRST    INTRET\r
3828 \r
3829 \r
3830 \f\r
3831 ; ROUTINE TO FLUSH OUT A PRINT BUFFER\r
3832 \r
3833 MFUNCTION BUFOUT,SUBR\r
3834 \r
3835         ENTRY   1\r
3836 \r
3837         GETYP   0,(AB)\r
3838         CAIE    0,TCHAN\r
3839         JRST    WTYP1\r
3840 \r
3841         MOVE    B,1(AB)\r
3842         MOVEI   B,DIRECT-1(B)\r
3843         PUSHJ   P,CHRWRD        ; GET DIR NAME\r
3844         JFCL\r
3845         CAMN    B,[ASCII /PRINT/]\r
3846         JRST    .+3\r
3847         CAME    B,[<ASCII /PRINT/>+1]\r
3848         JRST    WRONGD\r
3849         TRNE    B,1             ; SKIP IF PRINT\r
3850         PUSH    P,[JFCL]\r
3851         TRNN    B,1             ; SKIP IF PRINTB\r
3852         PUSH    P,[AOS ACCESS(B)]\r
3853         MOVE    B,1(AB)\r
3854         GETYP   0,BUFSTR-1(B)\r
3855         CAIN    0,TCHSTR\r
3856         SKIPN   C,BUFSTR(B)             ; BYTE POINTER?\r
3857         JRST    BFIN1\r
3858         HRRZ    C,BUFSTR-1(B)   ; CHARS LEFT\r
3859         IDIVI   C,5             ; MULTIPLE OF 5?\r
3860         JUMPE   D,BFIN2         ; YUP NO EXTRAS\r
3861 \r
3862         MOVEI   A,40            ; PAD WITH SPACES\r
3863         PUSHJ   P,PUTCHR        ; OUT IT GOES\r
3864         XCT     (P)             ; MAYBE BUMP ACCESS\r
3865         SOJG    D,.-3           ; FILL\r
3866 \r
3867 BFIN2:  PUSHJ   P,BFCLOS        ; WRITE OUT BUFFER\r
3868 BFIN1:  MOVSI   A,TCHAN\r
3869         JRST FINIS\r
3870 \r
3871 \r
3872 \r
3873 ; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL\r
3874 \r
3875 MFUNCTION FILLNT,SUBR,[FILE-LENGTH]\r
3876         ENTRY   1\r
3877 \r
3878         GETYP   0,(AB)\r
3879         CAIE    0,TCHAN\r
3880         JRST    WTYP1\r
3881         MOVE    B,1(AB)\r
3882         MOVEI   B,DIRECT-1(B)   ; GET CHANNEL TYPE\r
3883         PUSHJ   P,CHRWRD\r
3884         JFCL\r
3885         CAME    B,[ASCIZ /READ/]\r
3886         JRST    .+3\r
3887         PUSH    P,[5]           ; MULTIPLICATIVE FACTOR FOR READ\r
3888         JRST    .+4\r
3889         CAME    B,[ASCII /READB/]\r
3890         JRST    WRONGD\r
3891         PUSH    P,[1]           ; MULTIPLICATIVE FACTOR FOR READ\r
3892         MOVE    C,1(AB)\r
3893 IFN ITS,[\r
3894         .CALL   FILL1\r
3895         JRST    FILLOS          ; GIVE HIM A NICE FALSE\r
3896 ]\r
3897 IFE ITS,[\r
3898         MOVE    A,CHANNO(C)\r
3899         SIZEF\r
3900         JRST    FILLOS\r
3901 ]\r
3902         POP     P,C\r
3903         IMUL    B,C\r
3904         MOVE    A,$TFIX\r
3905         JRST    FINIS\r
3906 \r
3907 IFN ITS,[\r
3908 FILL1:  SETZ                    ; BLOCK FOR .CALL TO FILLEN\r
3909         SIXBIT /FILLEN/\r
3910         CHANNO  (C)\r
3911         SETZM   B\r
3912 \r
3913 FILLOS: MOVE    A,CHANNO(C)\r
3914         PUSHJ   P,GFALS\r
3915         JRST    FINIS\r
3916 ]\r
3917 IFE ITS,[\r
3918 FILLOS: PUSHJ   P,TGFALS\r
3919         JRST    FINIS\r
3920 ]\r
3921 \r
3922 \r
3923 \f;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O\r
3924 \r
3925 NOTNET:\r
3926 BADCHN: PUSH    TP,$TATOM\r
3927         PUSH    TP,EQUOTE BAD-CHANNEL\r
3928         JRST    CALER1\r
3929 \r
3930 WRONGD: PUSH    TP,$TATOM\r
3931         PUSH    TP,EQUOTE WRONG-DIRECTION-CHANNEL\r
3932         JRST    CALER1\r
3933 \r
3934 CHNCLS: PUSH    TP,$TATOM\r
3935         PUSH    TP,EQUOTE CHANNEL-CLOSED\r
3936         JRST    CALER1\r
3937 \r
3938 BAD6:   PUSH    TP,$TATOM\r
3939         PUSH    TP,EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME\r
3940         JRST    CALER1\r
3941 \r
3942 DISLOS: MOVE    C,$TCHSTR\r
3943         MOVE    D,CHQUOTE [DISPLAY NOT AVAILABLE]\r
3944         PUSHJ   P,INCONS\r
3945         MOVSI   A,TFALSE\r
3946         JRST    OPNRET\r
3947 \r
3948 NOCHAN: PUSH    TP,$TATOM\r
3949         PUSH    TP,EQUOTE ITS-CHANNELS-EXHAUSTED\r
3950         JRST    CALER1\r
3951 \r
3952 MODE1:  232020,,202020\r
3953 MODE2:  232023,,332320\r
3954 \r
3955 END\r
3956 \r
3957 \f\r