<mdl.int>/fopen.mid.58

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