<mdl.int>/fopen.mid.56

   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    A,CHANNO(B)     ; GET JFN
1588         GDSTS                   ; GET STATE
1589         MOVE    E,T.CHAN+1(TB)
1590         MOVEM   D,RNAME2(E)
1591         MOVEM   C,RSNAME(E)
1592         MOVE    C,BUFRIN(E)
1593         MOVEM   B,(C)           ; INITIAL STATE STORED
1594         MOVE    B,E
1595         JRST    OPNWIN
1596
1597 ; DOIOT FOR TENEX NETWRK
1598
1599 DONETO: PUSH    P,0
1600         MOVE    0,[BOUT]
1601         JRST    .+3
1602
1603 DONETI: PUSH    P,0
1604         MOVE    0,[BIN]
1605         PUSH    P,0
1606         PUSH    TP,$TCHAN
1607         PUSH    TP,B
1608         MOVEI   0,(A)           ; POSSIBLE OUTPUT CHAR TO 0
1609         MOVE    A,CHANNO(B)
1610         MOVE    B,0
1611         ENABLE
1612         XCT     (P)
1613         DISABLE
1614         MOVEI   A,(B)           ; RET CHAR IN A
1615         MOVE    B,(TP)
1616         MOVE    0,-1(P)
1617         SUB     P,[2,,2]
1618         SUB     TP,[2,,2]
1619         POPJ    P,
1620
1621 NETPRS: MOVEI   D,0
1622         HRRZ    0,(C)
1623         MOVE    C,1(C)
1624
1625 ONETL:  ILDB    A,C
1626         CAIN    A,"#
1627         POPJ    P,
1628         SUBI    A,60
1629         ASH     D,3
1630         IORI    D,(A)
1631         SOJG    0,ONETL
1632         AOS     (P)
1633         POPJ    P,
1634
1635 FIXSTK: CAMN    0,[-1]
1636         POPJ    P,
1637         JFFO    0,FIXS3         ; PUT OCTAL DIGITS INTO STIRNG
1638         MOVEI   A,"0
1639         POP     P,D
1640         AOJA    D,ONETCH
1641 FIXS3:  IDIVI   A,3
1642         MOVEI   B,12.
1643         SUBI    B,(A)
1644         HRLM    B,(P)
1645         IMULI   A,3
1646         LSH     0,(A)
1647         POP     P,B
1648 FIXS2:  MOVEI   A,0
1649         ROTC    0,3             ; NEXT DIGIT
1650         ADDI    A,60
1651         JSP     D,ONETCH
1652         SUB     B,[1,,0]
1653         TLNN    B,-1
1654         JRST    1(B)
1655         JRST    FIXS2
1656
1657 ONETCH: IDPB    A,C
1658         TLNE    C,760000        ; SKIP IF NEW WORD
1659         JRST    (D)
1660         PUSH    P,[0]
1661         JRST    (D)
1662
1663 INSTAT: MOVE    E,B
1664         MOVE    A,CHANNO(E)
1665         GDSTS
1666         LSH     B,-32.
1667         MOVEM   D,RNAME2(E)     ; UPDATE FOREIGN SOCHKET
1668         MOVEM   C,RSNAME(E)     ; AND HOST
1669         MOVE    C,BUFRIN(E)
1670         XCT     ITSTRN(B)       ; XLATE TO LOOK MORE LIKE ITS
1671         MOVEM   B,(C)           ; STORE STATE
1672         MOVE    B,E
1673         POPJ    P,
1674 \r
1675 ITSTRN: MOVEI   B,0\r
1676         JRST    NLOSS\r
1677         JRST    NLOSS\r
1678         MOVEI   B,1\r
1679         MOVEI   B,2\r
1680         JRST    NLOSS\r
1681         MOVEI   B,4\r
1682         PUSHJ   P,NOPND\r
1683         MOVEI   B,0\r
1684         JRST    NLOSS\r
1685         JRST    NLOSS\r
1686         PUSHJ   P,NCLSD\r
1687         MOVEI   B,0\r
1688         JRST    NLOSS\r
1689         MOVEI   B,0
1690
1691 NLOSS:  FATAL ILLEGAL NETWORK STATE
1692
1693 NOPND:  MOVE    B,DIRECT(E)     ; SEE IF READ OR PRINT
1694         ILDB    B,B             ; GET 1ST CHAR
1695         CAIE    B,"R            ; SKIP FOR READ
1696         JRST    NOPNDW
1697         SIBE            ; SEE IF INPUT EXISTS
1698         JRST    .+3
1699         MOVEI   B,5
1700         POPJ    P,
1701         MOVEM   B,2(C)          ; STORE BYTES IN STATE VECTOR
1702         MOVEI   B,11            ; RETURN DATA PRESENT STATE
1703         POPJ    P,
1704
1705 NOPNDW: SOBE                    ; SEE IF OUTPUT PRESENT
1706         JRST    .+3
1707         MOVEI   B,5
1708         POPJ    P,
1709
1710         MOVEI   B,6
1711         POPJ    P,
1712
1713 NCLSD:  MOVE    B,DIRECT(E)
1714         ILDB    B,B
1715         CAIE    B,"R
1716         JRST    RET0
1717         SIBE
1718         JRST    .+2
1719         JRST    RET0
1720         MOVEI   B,10
1721         POPJ    P,
1722
1723 RET0:   MOVEI   B,0
1724         POPJ    P,
1725
1726
1727 MFUNCTION NETSTATE,SUBR
1728
1729         PUSHJ   P,ARGNET
1730         PUSHJ   P,INSTAT
1731         MOVE    B,BUFRIN(B)
1732         MOVSI   A,TUVEC
1733         JRST    FINIS
1734
1735 MFUNCTION NETS,SUBR
1736
1737         PUSHJ   P,ARGNET
1738         CAME    A,MODES+1       ; PRINT OR PRINTB?
1739         CAMN    A,MODES+3
1740         SKIPA   A,CHANNO(B)
1741         JRST    WRONGD
1742         MOVEI   B,21
1743         MTOPR
1744 NETRET: MOVE    B,1(AB)
1745         MOVSI   A,TCHAN
1746         JRST    FINIS
1747
1748 MFUNCTION NETACC,SUBR
1749
1750         PUSHJ   P,ARGNET
1751         MOVE    A,CHANNO(B)
1752         MOVEI   B,20
1753         MTOPR
1754         JRST    NETRET
1755
1756 ]
1757 \f
1758 ; HERE TO OPEN TELETYPE DEVICES
1759
1760 OTTY:   HRRZ    A,S.DIR(C)      ; GET DIR CODE
1761         TRNE    A,2             ; SKIP IF NOT READB/PRINTB
1762         JRST    WRONGD          ; CANT DO THAT
1763
1764 IFN ITS,[
1765         MOVE    A,S.NM1(C)      ; CHECK FOR A DIR
1766         MOVE    0,S.NM2(C)
1767         CAMN    A,[SIXBIT /.FILE./]
1768         CAME    0,[SIXBIT /(DIR)/]
1769         SKIPA   E,[-15.*2,,]
1770         JRST    OUTN            ; DO IT THAT WAY
1771
1772         HRRZ    A,S.DIR(C)      ; CHECK DIR
1773         TRNE    A,1
1774         JRST    TTYLP2
1775         HRRI    E,CHNL1
1776         PUSH    P,S.DEV(C)      ; SAVE THE SIXBIT DEV NAME
1777    ;    HRLZS   (P)             ; POSTITION DEVICE NAME
1778
1779 TTYLP:  SKIPN   D,1(E)          ; CHANNEL OPEN?
1780         JRST    TTYLP1          ; NO, GO TO NEXT
1781         MOVE    A,RDEVIC-1(D)           ; GET DEV NAME
1782         MOVE    B,RDEVIC(D)
1783         PUSHJ   P,STRTO6        ; TO 6 BIT
1784         POP     P,A             ; GET RESULT
1785         CAMN    A,(P)           ; SAME?
1786         JRST    SAMTYQ          ; COULD BE THE SAME
1787 TTYLP1: ADD     E,[2,,2]
1788         JUMPL   E,TTYLP
1789         SUB     P,[1,,1]        ; THIS ONE MUST BE UNIQUE
1790 TTYLP2: MOVE    C,T.SPDL+1(TB)  ; POINT TO P BASE
1791         HRRZ    A,S.DIR(C)      ; GET DIR OF OPEN
1792         SKIPE   A               ; IF OUTPUT,
1793         IORI    A,20            ; THEN USE DISPLAY MODE
1794         HRLM    A,S.DIR(C)      ; STORE IN OPEN BLOCK
1795         PUSHJ   P,OPEN2         ; OPEN THE TTY
1796         MOVE    A,S.DEV(C)      ; GET DEVICE NAME
1797         PUSHJ   P,6TOCHS        ; TO A STRING
1798         MOVE    D,T.CHAN+1(TB)  ; POINT TO CHANNEL
1799         MOVEM   A,RDEVIC-1(D)
1800         MOVEM   B,RDEVIC(D)
1801         MOVE    C,T.SPDL+1(TB)  ; RESTORE PDL BASE
1802         MOVE    B,D             ; CHANNEL TO B
1803         HRRZ    0,S.DIR(C)      ; AND DIR
1804         JUMPE   0,TTYSPC
1805 TTY1:   DOTCAL  TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]]
1806          .LOSE  %LSSYS
1807         DOTCAL  TTYSET,[CHANNO(B),MODE1,MODE2,D]
1808          .LOSE  %LSSYS
1809         MOVE    A,[PUSHJ P,GMTYO]
1810         MOVEM   A,IOINS(B)
1811         DOTCAL  RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]]
1812          .LOSE  %LSSYS
1813         MOVEM   D,LINLN(B)
1814         MOVEM   A,PAGLN(B)
1815         JRST    OPNWIN
1816
1817 ; MAKE AN IOT
1818
1819 IOTMAK: HRLZ    A,CHANNO(B)     ; GET CHANNEL
1820         ROT     A,5
1821         IOR     A,[.IOT A]      ; BUILD IOT
1822         MOVEM   A,IOINS(B)      ; AND STORE IT
1823         POPJ    P,
1824 \f
1825
1826 ; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY
1827
1828 SAMTYQ: MOVE    D,1(E)          ; RESTORE CURRENT CHANNEL
1829         MOVE    A,DIRECT-1(D)   ; GET DIR
1830         MOVE    B,DIRECT(D)
1831         PUSHJ   P,STRTO6
1832         POP     P,A             ; GET SIXBIT
1833         MOVE    C,T.SPDL+1(TB)
1834         HRRZ    C,S.DIR(C)
1835         CAME    A,MODES(C)      ; SKIP IF DIFFERENT DIRECTION
1836         JRST    TTYLP1
1837
1838 ; HERE IF A RE-OPEN ON A TTY
1839
1840         HRRZ    0,FSAV(TB)      ; IS IT FROM A FOPEN
1841         CAIN    0,FOPEN
1842         JRST    RETOLD          ; RET OLD CHANNEL
1843
1844         PUSH    TP,$TCHAN
1845         PUSH    TP,1(E)         ; PUSH OLD CHANNEL
1846         PUSH    TP,$TFIX
1847         PUSH    TP,T.CHAN+1(TB)
1848         MOVE    A,[PUSHJ P,CHNFIX]
1849         MOVEI   PVP,0           ; SAY MIGHT BE NON-ATOMS
1850         PUSHJ   P,GCHACK
1851         SUB     TP,[4,,4]
1852
1853 RETOLD: MOVE    B,1(E)          ; GET CHANNEL
1854         AOS     CHANNO-1(B)     ; AOS REF COUNT
1855         MOVSI   A,TCHAN
1856         SUB     P,[1,,1]        ; CLEAN UP STACK
1857         JRST    OPNRET          ; AND LEAVE
1858
1859
1860 ; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER
1861
1862 CHNFIX: CAIN    C,TCHAN
1863         CAME    D,(TP)
1864         POPJ    P,
1865         MOVE    D,-2(TP)        ; GET REPLACEMENT
1866         SKIPE   B
1867         MOVEM   D,1(B)          ; CLOBBER IT AWAY
1868         POPJ    P,
1869 ]\f
1870
1871 IFE ITS,[
1872         MOVE    C,T.SPDL+1(TB)  ; POINT TO P BASE
1873         HRRZ    0,S.DIR(C)      ; 0/ 0 FOR READ 0/ 1 FOR PRINT
1874         MOVE    A,[PUSHJ P,INMTYO]
1875         MOVE    B,T.CHAN+1(TB)
1876         MOVEM   A,IOINS(B)
1877         MOVEI   A,100           ; PRIM INPUT JFN
1878         JUMPN   0,TNXTY1
1879         MOVEI   E,C.OPN+C.READ+C.TTY
1880         HRRM    E,-2(B)
1881         MOVEM   B,CHNL0+2*100+1
1882         JRST    TNXTY2
1883 TNXTY1: MOVEM   B,CHNL0+2*101+1
1884         MOVEI   A,101           ; PRIM OUTPUT JFN
1885         MOVEI   E,C.OPN+C.PRIN+C.TTY
1886         HRRM    E,-2(B)
1887 TNXTY2: MOVEM   A,CHANNO(B)
1888         JUMPN   0,OPNWIN
1889 ]
1890 ; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES
1891
1892 TTYSPC: MOVEI   A,EXTBFR        ; GET EXTRA BUFFER
1893         PUSHJ   P,IBLOCK        ; GET BLOCK
1894         MOVE    D,T.CHAN+1(TB)  ;RESTORE CHANNEL POINTER
1895 IFN ITS,[
1896         MOVE    A,CHANNO(D)
1897         LSH     A,23.
1898         IOR     A,[.IOT A]
1899         MOVEM   A,IOIN2(B)
1900 ]
1901 IFE ITS,[
1902         MOVE    A,[PBIN]
1903         MOVEM   A,IOIN2(B)
1904 ]
1905         MOVSI   A,TLIST
1906         MOVEM   A,EXBUFR-1(D)   ; FOR WAITING TTY BUFFERS
1907         SETZM   EXBUFR(D)       ; NIL LIST
1908         MOVEM   B,BUFRIN(D)     ;STORE IN CHANNEL
1909         MOVSI   A,TUVEC         ;MAKE SURE TYPE IS UNIFORM VECTOR
1910         HLLM    A,BUFRIN-1(D)
1911         MOVEI   A,177           ;SET ERASER TO RUBOUT
1912         MOVEM   A,ERASCH(B)
1913 IFE ITS,[
1914         MOVEI   A,25
1915         MOVEM   A,KILLCH(B)
1916 ]
1917 IFN ITS,[
1918         SETZM   KILLCH(B)       ;NO KILL CHARACTER NEEDED
1919 ]
1920         MOVEI   A,33            ;BREAKCHR TO C.R.
1921         MOVEM   A,BRKCH(B)
1922         MOVEI   A,"\            ;ESCAPER TO \
1923         MOVEM   A,ESCAP(B)
1924         MOVE    A,[010700,,BYTPTR(E)]   ;RELATIVE BYTE POINTER
1925         MOVEM   A,BYTPTR(B)
1926         MOVEI   A,14            ;BARF BACK CHARACTER FF
1927         MOVEM   A,BRFCHR(B)
1928         MOVEI   A,^D
1929         MOVEM   A,BRFCH2(B)
1930
1931 ; SETUP DEFAULT TTY INTERRUPT HANDLER
1932
1933         PUSH    TP,$TATOM
1934         PUSH    TP,MQUOTE CHAR,CHAR,INTRUP
1935         PUSH    TP,$TFIX
1936         PUSH    TP,[10]         ; PRIORITY OF CHAR INT
1937         PUSH    TP,$TCHAN
1938         PUSH    TP,D
1939         MCALL   3,EVENT         ; 1ST MAKE AN EVENT EXIST
1940         PUSH    TP,A
1941         PUSH    TP,B
1942         PUSH    TP,$TSUBR
1943         PUSH    TP,[QUITTER]    ; DEFAULT HANDLER IS QUITTER
1944         MCALL   2,HANDLER
1945
1946 ; BUILD A NULL STRING
1947
1948         MOVEI   A,0
1949         PUSHJ   P,IBLOCK                ; USE A BLOCK
1950         MOVE    D,T.CHAN+1(TB)
1951         MOVEI   0,C.BUF
1952         IORM    0,-2(D)
1953         HRLI    B,010700
1954         SUBI    B,1
1955         MOVSI   A,TCHSTR
1956         MOVEM   A,BUFSTR-1(D)
1957         MOVEM   B,BUFSTR(D)
1958         MOVEI   A,0
1959         MOVE    B,D             ; CHANNEL TO B
1960         JRST    MAKION
1961 \f
1962
1963 ; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST
1964
1965 IFN ITS,[
1966 OPEN2:  MOVEI   A,S.DIR(C)      ; POINT TO OPEN BLOCK
1967         PUSHJ   P,MOPEN         ; OPEN THE FILE
1968         JRST    OPNLOS
1969         MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL BACK
1970         MOVEM   A,CHANNO(B)     ; SAVE THE CHANNEL
1971         JRST    OPEN3
1972
1973 ; FIX UP MODE AND FALL INTO OPEN
1974
1975 OPEN0:  HRRZ    A,S.DIR(C)      ; GET DIR
1976         TRNE    A,2             ; SKIP IF NOT BLOCK
1977         IORI    A,4             ; TURN ON IMAGE
1978         IORI    A,2             ; AND BLOCK
1979
1980         PUSH    P,A
1981         PUSH    TP,$TPDL
1982         PUSH    TP,C            ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA
1983         MOVE    B,T.CHAN+1(TB)
1984         MOVE    A,DIRECT-1(B)
1985         MOVE    B,DIRECT(B)     ; THIS KLUDGE THE MESS OF NDR
1986         PUSHJ   P,STRTO6
1987         MOVE    C,(TP)
1988         POP     P,D             ; THE SIXBIT FOR KLUDGE
1989         POP     P,A             ; GET BACK THE RANDOM BITS
1990         SUB     TP,[2,,2]
1991         CAME    D,[SIXBIT /PRINAO/]
1992         CAMN    D,[SIXBIT /PRINTO/]
1993         IORI    A,100000        ; WRITEOVER BIT
1994         HRRZ    0,FSAV(TB)
1995         CAIN    0,NFOPEN
1996         IORI    A,10            ; DON'T CHANGE REF DATE
1997 OPEN9:  HRLM    A,S.DIR(C)      ; AND STORE IT
1998
1999 ; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL
2000
2001 OPEN1:  MOVEI   A,S.DIR(C)      ; POINT TO OPEN BLOCK
2002         PUSHJ   P,MOPEN
2003         JRST    OPNLOS
2004         MOVE    B,T.CHAN+1(TB)  ; GET CHANNEL BACK
2005         MOVEM   A,CHANNO(B)     ; CLOBBER INTO CHANNEL
2006         DOTCAL  RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]]
2007         JFCL
2008
2009 ; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL
2010
2011 OPEN3:  MOVE    A,S.DIR(C)
2012         MOVEI   0,C.OPN+C.READ
2013         TRNE    A,1
2014         MOVEI   0,C.OPN+C.PRIN
2015         TRNE    A,2
2016         TRO     0,C.BIN
2017         HRRM    0,-2(B)
2018         MOVE    A,CHANNO(B)     ; GET CHANNEL #
2019         ASH     A,1
2020         ADDI    A,CHNL0 ; POINT TO SLOT
2021         MOVEM   B,1(A)          ; NOT: TYPE ALREADY SETUP
2022
2023 ; NOW GET STATUS WORD
2024
2025 DOSTAT: HRRZ    A,CHANNO(B)     ; NOW GET STATUS WORD
2026         DOTCAL  STATUS,[A,[2002,,STATUS]]
2027         JFCL
2028         POPJ    P,
2029 \f
2030
2031 ; HERE IF OPEN FAILS (CHANNEL IS IN A)
2032
2033 OPNLOS: JUMPL   A,NOCHAN        ; ALL CHANNELS ARE IN USE
2034         LSH     A,23.           ; DO A .STATUS
2035         IOR     A,[.STATUS A]
2036         XCT     A               ; STATUS TO A
2037         MOVE    B,T.CHAN+1(TB)
2038         PUSHJ   P,GFALS         ; GET A FALSE WITH A MESSAGE
2039         SUB     P,[1,,1]        ; EXTRA RET ADDR FLUSHED
2040         JRST    OPNRET          ; AND RETURN
2041 ]
2042
2043 CGFALS: SUBM    M,(P)
2044         MOVEI   B,0
2045 IFN ITS,        PUSHJ   P,GFALS
2046 IFE ITS,        PUSHJ   P,TGFALS
2047         JRST    MPOPJ
2048
2049 ; ROUTINE TO CONS UP FALSE WITH REASON
2050 IFN ITS,[
2051 GFALS:  PUSH    TP,$TCHAN
2052         PUSH    TP,B
2053         PUSH    P,[SIXBIT /   ERR/]     ; SET UP OPEN TO ERR DEV
2054         PUSH    P,[3]           ; SAY ITS FOR CHANNEL
2055         PUSH    P,A
2056         .OPEN   0,-2(P)         ; USE CHANNEL 0 FOR THIS
2057         FATAL CAN'T OPEN ERROR DEVICE
2058         SUB     P,[3,,3]        ; DONT WANT OPEN BLOCK NOW
2059 IFN FNAMS,      PUSH    P,A
2060         MOVEI   A,0             ; PREPARE TO BUILD STRING ON STACK
2061 EL1:    PUSH    P,[0]           ; WHERE IT WILL GO
2062         MOVSI   B,(<440700,,(P)>)       ; BYTE POINTER TO TOP OF STACK
2063 EL2:    .IOT    0,0             ; GET A CHAR
2064         JUMPL   0,EL3           ; JUMP ON -1,,3
2065         CAIN    0,3             ; EOF?
2066         JRST    EL3             ; YES, MAKE STRING
2067         CAIN    0,14            ; IGNORE FORM FEEDS
2068         JRST    EL2             ; IGNORE FF
2069         CAIE    0,15            ; IGNORE CR & LF
2070         CAIN    0,12
2071         JRST    EL2
2072         IDPB    0,B             ; STUFF IT
2073         TLNE    B,760000        ; SIP IF WORD FULL
2074         AOJA    A,EL2
2075         AOJA    A,EL1           ; COUNT WORD AND GO
2076
2077 EL3:
2078 IFN FNAMS,[
2079         SKIPN   (P)
2080         SUB     P,[1,,1]
2081         PUSH    P,A
2082         .CLOSE  0,
2083         PUSHJ   P,CHMAK
2084         PUSH    TP,A
2085         PUSH    TP,B
2086         SKIPN   B,-2(TP)
2087         JRST    EL4
2088         MOVEI   A,0
2089         MOVSI   B,(<440700,,(P)>)
2090         PUSH    P,[0]
2091         IRP     XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40]
2092 IFSN YY,0,[
2093         MOVEI   0,YY
2094         JSP     E,1PUSH
2095 ]
2096         MOVE    E,-2(TP)
2097         MOVE    C,XX(E)
2098         HRRZ    D,XX-1(E)
2099         JSP     E,PUSHIT
2100         TERMIN
2101 ]
2102         SKIPN   (P)             ; ANY CHARS AT END?
2103         SUB     P,[1,,1]        ; FLUSH XTRA
2104         PUSH    P,A             ; PUT UP COUNT
2105         .CLOSE  0,              ; CLOSE THE ERR DEVICE
2106         PUSHJ   P,CHMAK         ; MAKE STRING
2107         PUSH    TP,A
2108         PUSH    TP,B
2109 IFN FNAMS,[
2110 EL4:    POP     P,A
2111         PUSH    TP,$TFIX
2112         PUSH    TP,A]
2113 IFE FNAMS,      MOVEI   A,1
2114 IFN FNAMS,[
2115         MOVEI   A,3
2116         SKIPN   B
2117         MOVEI   A,2
2118 ]
2119         PUSHJ   P,IILIST
2120         MOVSI   A,TFALSE        ; MAKEIT A FALSE
2121 IFN FNAMS,      SUB     TP,[2,,2]
2122         POPJ    P,
2123
2124 IFN FNAMS,[
2125 1PUSH:  MOVEI   D,0
2126         JRST    PUSHI2
2127 PUSHI1: PUSH    P,[0]
2128         MOVSI   B,(<440700,,(P)>)
2129 PUSHIT: SOJL    D,(E)
2130         ILDB    0,C
2131 PUSHI2: IDPB    0,B
2132         TLNE    B,760000
2133         AOJA    A,PUSHIT
2134         AOJA    A,PUSHI1
2135 ]
2136 ]
2137 \f
2138
2139 ; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL
2140
2141 FIXREA:
2142 IFE ITS,        HRLZS   S.DEV(C)        ; KILL MODE BITS
2143         MOVE    D,[-4,,S.DEV]
2144
2145 FIXRE1: MOVEI   A,(D)           ; COPY REL POINTER
2146         ADD     A,T.SPDL+1(TB)  ; POINT TO SLOT
2147         SKIPN   A,(A)           ; SKIP IF GOODIE THERE
2148         JRST    FIXRE2
2149         PUSHJ   P,6TOCHS        ; MAKE INOT A STRING
2150         MOVE    C,RDTBL-S.DEV(D); GET OFFSET
2151         ADD     C,T.CHAN+1(TB)
2152         MOVEM   A,-1(C)
2153         MOVEM   B,(C)
2154 FIXRE2: AOBJN   D,FIXRE1
2155         POPJ    P,
2156
2157 IFN ITS,[
2158 DOOPN:  HRLZ    A,A
2159         HRR     A,CHANNO(B)     ; GET CHANNEL
2160         DOTCAL  OPEN,[A,-3(P),-2(P),-1(P),(P)]
2161          SKIPA
2162           AOS   -1(P)
2163         POPJ    P,
2164 ]
2165 \f
2166 ;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES
2167 STRTO6: PUSH    TP,A
2168         PUSH    TP,B
2169         PUSH    P,E             ;SAVE USEFUL FROB
2170         MOVEI   E,(A)           ; CHAR COUNT TO E
2171         GETYP   A,A
2172         CAIE    A,TCHSTR                ; IS IT ONE WORD?
2173         JRST    WRONGT          ;NO
2174         CAILE   E,6             ; SKIP IF L=? 6 CHARS
2175         MOVEI   E,6
2176 CHREAD: MOVEI   A,0             ;INITIALIZE OUTPUT WORD
2177         MOVE    D,[440600,,A]   ;AND BYTE POINTER TO IT
2178 NEXCHR: SOJL    E,SIXDON
2179         ILDB    0,B             ; GET NEXT CHAR
2180         CAIN    0,^Q            ; CNTL-Q, QUOTES NEXT CHAR
2181         JRST    NEXCHR
2182         JUMPE   0,SIXDON        ;IF NULL, WE ARE FINISHED
2183         PUSHJ   P,A0TO6         ; CONVERT TO SIXBIT
2184         IDPB    0,D             ;DEPOSIT INTO SIX BIT
2185         JRST    NEXCHR          ; NO, GET NEXT
2186 SIXDON: SUB     TP,[2,,2]       ;FIX UP TP
2187         POP     P,E
2188         EXCH    A,(P)           ;LEAVE RESULT ON P-STACK
2189         JRST    (A)             ;NOW RETURN
2190
2191
2192 ;SUBROUTINE TO CONVERT SIXBIT TO ATOM
2193
2194 6TOCHS: PUSH    P,E
2195         PUSH    P,D
2196         MOVEI   B,0             ;MAX NUMBER OF CHARACTERS
2197         PUSH    P,[0]           ;STRING WILL GO ON P SATCK
2198         JUMPE   A,GETATM        ; EMPTY, LEAVE
2199         MOVEI   E,-1(P)         ;WILL BE BYTE POINTER
2200         HRLI    E,10700         ;SET IT UP
2201         PUSH    P,[0]           ;SECOND POSSIBLE WORD
2202         MOVE    D,[440600,,A]   ;INPUT BYTE POINTER
2203 6LOOP:  ILDB    0,D             ;START CHAR GOBBLING
2204         ADDI    0,40            ;CHANGET TOASCII
2205         IDPB    0,E             ;AND STORE IT
2206         TLNN    D,770000        ; SKIP IF NOT DONE
2207         JRST    6LOOP1
2208         TDNN    A,MSKS(B)       ; CHECK IF JUST SPACES LEFT
2209         AOJA    B,GETATM        ; YES, DONE
2210         AOJA    B,6LOOP         ;KEEP LOOKING
2211 6LOOP1: PUSH    P,[6]           ;IF ARRIVE HERE, STRING IS 2 WORDS
2212         JRST    .+2
2213 GETATM: MOVEM   B,(P)           ;SET STRING LENGTH=1
2214         PUSHJ   P,CHMAK         ;MAKE A MUDDLE STRING
2215         POP     P,D
2216         POP     P,E
2217         POPJ    P,
2218
2219 MSKS:   7777,,-1
2220         77,,-1
2221         ,,-1
2222         7777
2223         77
2224
2225
2226 ; CONVERT ONE CHAR
2227
2228 A0TO6:  CAIL    0,141           ;IF IT IS GREATER OR EQUAL TO LOWER A
2229         CAILE   0,172           ;BUT LESS THAN OR EQUAL TO LOWER Z
2230         JRST    .+2             ;THEN
2231         SUBI    0,40            ;CONVERT TO UPPER CASE
2232         SUBI    0,40            ;NOW TO SIX BIT
2233         JUMPL   0,BAD6          ;CHECK FOR A WINNER
2234         CAILE   0,77
2235         JRST    BAD6
2236         POPJ    P,
2237 \f
2238 ; SUBR TO TEST THE EXISTENCE OF FILES
2239
2240 MFUNCTION FEXIST,SUBR,[FILE-EXISTS?]
2241
2242         ENTRY
2243
2244         JUMPGE  AB,TFA
2245         PUSH    TP,$TPDL
2246         PUSH    TP,P            ; SAVE P-STACK BASE
2247         ADD     TP,[2,,2]
2248         MOVSI   E,-4            ; 4 THINGS TO PUSH
2249 EXIST:
2250 IFN ITS,        MOVE    B,@RNMTBL(E)
2251 IFE ITS,        MOVE    B,@FETBL(E)
2252         PUSH    P,E
2253         PUSHJ   P,IDVAL1
2254         POP     P,E
2255         GETYP   0,A
2256         CAIE    0,TCHSTR        ; SKIP IF WINS
2257         JRST    EXIST1
2258
2259 IFN ITS,        PUSHJ   P,STRTO6        ; CONVERT TO SIXBIT
2260 IFE ITS,[
2261 ;       PUSH    P,E
2262 ;       PUSHJ   P,ADDNUL        ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA
2263 ;       POP     P,E
2264         PUSH    TP,A            ; DEFAULT TYPE AND VALUE GIVEN BY USER
2265         PUSH    TP,B            ; IN VALUE OF DEV, SNM, NM1, NM2
2266         ]
2267 IFN ITS,        JRST    .+2
2268 IFE ITS,        JRST    .+3
2269
2270 EXIST1:
2271 IFN ITS,        PUSH    P,EXISTS(E)     ; USE DEFAULT
2272 IFE ITS,[
2273         PUSH    TP,FETYP(E)     ; DEFAULT TYPE AND VALUE IF NO
2274         PUSH    TP,FEVAL(E)     ; DEFAULT GIVEN BY USER
2275         ]
2276         AOBJN   E,EXIST
2277
2278         PUSHJ   P,RGPRS         ; PARSE THE ARGS
2279         JRST    TMA             ; TOO MANY ARGUMENTS
2280
2281 IFN ITS,[
2282         MOVE    0,-3(P)         ; GET SIXBIT DEV NAME
2283         MOVEI   B,0
2284         CAMN    0,[SIXBITS /DSK   /]
2285         MOVSI   B,10            ; DONT SET REF DATE IF DISK DEV
2286         .IOPUSH
2287         DOTCAL  OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]]
2288          JRST   .+3
2289         .IOPOP
2290         JRST    FDLWON          ; WON!!!
2291         .STATUS 0,A             ; FIND THE STATUS OF CHANNEL BEFORE POPING
2292         .IOPOP
2293         JRST    FDLST1]
2294
2295 IFE ITS,[
2296         MOVE    B,TB
2297         SUBI    B,10            ; GET B TO POINT CORRECTLY TO ARGS
2298         PUSHJ   P,STSTK         ; GET FILE NAME IN A STRING
2299         HRROI   B,1(E)          ; POINT B TO THE STRING
2300         MOVSI   A,100001
2301         GTJFN
2302         JRST    TDLLOS          ; FILE DOES NOT EXIST
2303         RLJFN                   ; FILE EXIST SO RETURN JFN
2304         JFCL
2305         JRST    FDLWON          ; SUCCESS
2306         ]
2307
2308 IFN ITS,[
2309 EXISTS: SIXBITS /DSK   INPUT >           /
2310         ]
2311 IFE ITS,[
2312 FETBL:  SETZ IMQUOTE    NM1
2313         SETZ IMQUOTE    NM2
2314         SETZ IMQUOTE    DEV
2315         SETZ IMQUOTE    SNM
2316
2317 FETYP:  TCHSTR,,5
2318         TCHSTR,,3
2319         TCHSTR,,3
2320         TCHSTR,,0
2321
2322 FEVAL:  440700,,[ASCIZ /INPUT/]
2323         440700,,[ASCIZ /MUD/]
2324         440700,,[ASCIZ /DSK/]
2325         0
2326         ]
2327 \f
2328 ; SUBR TO DELETE AND RENAME FILES
2329
2330 MFUNCTION RENAME,SUBR
2331
2332         ENTRY
2333
2334         JUMPGE  AB,TFA
2335         PUSH    TP,$TPDL
2336         PUSH    TP,P            ; SAVE P-STACK BASE
2337         GETYP   0,(AB)          ; GET 1ST ARG TYPE
2338 IFN ITS,[
2339         CAIN    0,TCHAN         ; CHANNEL?
2340         JRST    CHNRNM          ; MUST BE RENAME WHILE OPEN FOR WRITING
2341 ]
2342 IFE ITS,[
2343         PUSH    P,[100000,,-2]
2344         PUSH    P,[377777,,377777]
2345 ]
2346         MOVSI   E,-4            ; 4 THINGS TO PUSH
2347 RNMALP: MOVE    B,@RNMTBL(E)
2348         PUSH    P,E
2349         PUSHJ   P,IDVAL1
2350         POP     P,E
2351         GETYP   0,A
2352         CAIE    0,TCHSTR        ; SKIP IF WINS
2353         JRST    RNMLP1
2354
2355 IFN ITS,        PUSHJ   P,STRTO6        ; CONVERT TO SIXBIT
2356 IFE ITS,[
2357         PUSH    P,E
2358         PUSHJ   P,ADDNUL
2359         EXCH    B,(P)
2360         MOVE    E,B
2361 ]
2362         JRST    .+2
2363
2364 RNMLP1: PUSH    P,RNSTBL(E)     ; USE DEFAULT
2365         AOBJN   E,RNMALP
2366
2367 IFN ITS,[
2368         PUSHJ   P,RGPRS         ; PARSE THE ARGS
2369         JRST    RNM1            ; COULD BE A RENAME
2370
2371 ; HERE TO DELETE A FILE
2372
2373 DELFIL: MOVE    A,(P)           ; AND GET SNAME
2374         .SUSET  [.SSNAM,,A]
2375         DOTCAL  DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]]
2376         JRST    FDLST           ; ANALYSE ERROR
2377
2378 FDLWON: MOVSI   A,TATOM
2379         MOVE    B,IMQUOTE T
2380         JRST    FINIS
2381 ]
2382 IFE ITS,[
2383         MOVE    A,(AB)
2384         MOVE    B,1(AB)
2385         PUSHJ   P,ADDNUL
2386         MOVE    A,(TP)          ; GET BASE OF PDL
2387         MOVEI   A,1(A)          ; POINT TO CRAP
2388         CAMGE   AB,[-3,,]       ; SKIP IF DELETE
2389         HLLZS   (A)             ; RESET DEFAULT
2390         PUSH    P,[0]
2391         PUSH    P,[0]
2392         PUSH    P,[0]
2393         GTJFN                   ; GET A JFN
2394         JRST    TDLLOS          ; LOST
2395         ADD     AB,[2,,2]       ; PAST ARG
2396         JUMPL   AB,RNM1         ; GO TRY FOR RENAME
2397         MOVE    P,(TP)          ; RESTORE P STACK
2398         MOVEI   C,(A)           ; FOR RELEASE
2399         DELF                    ; ATTEMPT DELETE
2400         JRST    DELLOS          ; LOSER
2401         RLJFN                   ; MAKE SURE FLUSHED
2402         JFCL
2403
2404 FDLWON: MOVSI   A,TATOM
2405         MOVE    B,IMQUOTE T
2406         JRST    FINIS
2407
2408 RNMLOS: PUSH    P,A
2409         MOVEI   A,(B)
2410         RLJFN
2411         JFCL
2412 DELLO1: MOVEI   A,(C)
2413         RLJFN
2414         JFCL
2415         POP     P,A             ; ERR NUMBER BACK
2416 TDLLOS: MOVEI   B,0
2417         PUSHJ   P,TGFALS        ; GET FALSE WITH REASON
2418         JRST    FINIS
2419
2420 DELLOS: PUSH    P,A             ; SAVE ERROR
2421         JRST    DELLO1
2422 ]
2423
2424 ;TABLE OF REANMAE DEFAULTS
2425 IFN ITS,[
2426 RNMTBL: IMQUOTE DEV
2427         IMQUOTE NM1
2428         IMQUOTE NM2
2429         IMQUOTE SNM
2430
2431 RNSTBL: SIXBIT /DSK   _MUDS_>           /
2432 ]
2433 IFE ITS,[
2434 RNMTBL: SETZ IMQUOTE DEV
2435         SETZ IMQUOTE SNM
2436         SETZ IMQUOTE NM1
2437         SETZ IMQUOTE NM2
2438
2439 RNSTBL: -1,,[ASCIZ /DSK/]
2440         0
2441         -1,,[ASCIZ /_MUDS_/]
2442         -1,,[ASCIZ /MUD/]
2443 ]
2444 ; HERE TO DO A RENAME
2445
2446 RNM1:   JUMPGE  AB,TMA          ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING
2447         GETYP   0,(AB)
2448         MOVE    C,1(AB)         ; GET ARG
2449         CAIN    0,TATOM         ; IS IT "TO"
2450         CAME    C,IMQUOTE TO
2451         JRST    WRONGT          ; NO, LOSE
2452         ADD     AB,[2,,2]       ; BUMP PAST "TO"
2453         JUMPGE  AB,TFA
2454 IFN ITS,[
2455         MOVEM   P,T.SPDL+1(TB)  ; SAVE NEW P-BASE
2456
2457         MOVEI   0,4             ; FOUR DEFAULTS
2458         PUSH    P,-3(P)         ; DEFAULT DEVICE IS CURRENT
2459         SOJN    0,.-1
2460
2461         PUSHJ   P,RGPRS         ; PARSE THE NEXT STRING
2462         JRST    TMA
2463
2464         MOVE    A,-7(P)         ; FIX AND GET DEV1
2465         MOVE    B,-3(P)         ; SAME FOR DEV2
2466         CAME    A,B             ; SAME?
2467         JRST    DEVDIF
2468
2469         POP     P,A             ; GET SNAME 2
2470         CAME    A,(P)-3         ; SNAME 1
2471         JRST    DEVDIF
2472         .SUSET  [.SSNAM,,A]
2473         POP     P,-2(P)         ; MOVE NAMES DOWN
2474         POP     P,-2(P)
2475         DOTCAL  RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)]
2476         JRST    FDLST
2477         JRST    FDLWON
2478
2479 ; HERE FOR RENAME WHILE OPEN FOR WRITING
2480
2481 CHNRNM: ADD     AB,[2,,2]       ; NEXT ARG
2482         JUMPGE  AB,TFA
2483         MOVE    B,-1(AB)        ; GET CHANNEL
2484         SKIPN   CHANNO(B)       ; SKIP IF OPEN
2485         JRST    BADCHN
2486         MOVE    A,DIRECT-1(B)   ; CHECK DIRECTION
2487         MOVE    B,DIRECT(B)
2488         PUSHJ   P,STRTO6        ; TO 6 BIT
2489         POP     P,A
2490         CAME    A,[SIXBIT /PRINT/]
2491         CAMN    A,[SIXBIT /PRINTB/]
2492         JRST    CHNRN1
2493         CAMN    A,[SIXBIT /PRINAO/]
2494         JRST    CHNRM1
2495         CAME    A,[SIXBIT /PRINTO/]
2496         JRST    WRONGD
2497
2498 ; SET UP .FDELE BLOCK
2499
2500 CHNRN1: PUSH    P,[0]
2501         PUSH    P,[0]
2502         MOVEM   P,T.SPDL+1(TB)
2503         PUSH    P,[0]
2504         PUSH    P,[SIXBIT /_MUDL_/]
2505         PUSH    P,[SIXBIT />/]
2506         PUSH    P,[0]
2507
2508         PUSHJ   P,RGPRS         ; PARSE THESE
2509         JRST    TMA
2510
2511         SUB     P,[1,,1]        ; SNAME/DEV IGNORED
2512         MOVE    AB,ABSAV(TB)    ; GET ORIG ARG POINTER
2513         MOVE    B,1(AB)
2514         MOVE    A,CHANNO(B)     ; ITS CHANNEL #
2515         DOTCAL  RENMWO,[A,[17,,-1],(P)]
2516         JRST    FDLST
2517         MOVE    A,CHANNO(B)     ; ITS CHANNEL #
2518         DOTCAL  RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]]
2519         JFCL
2520         MOVE    A,-3(P)         ; UPDATE CHANNEL
2521         PUSHJ   P,6TOCHS        ; GET A STRING
2522         MOVE    C,1(AB)
2523         MOVEM   A,RNAME1-1(C)
2524         MOVEM   B,RNAME1(C)
2525         MOVE    A,-2(P)
2526         PUSHJ   P,6TOCHS
2527         MOVE    C,1(AB)
2528         MOVEM   A,RNAME2-1(C)
2529         MOVEM   B,RNAME2(C)
2530         MOVE    B,1(AB)
2531         MOVSI   A,TCHAN\b
2532         JRST    FINIS
2533 ]
2534 IFE ITS,[
2535         PUSH    P,A
2536         MOVE    A,(AB)
2537         MOVE    B,1(AB)
2538         PUSHJ   P,ADDNUL
2539         MOVE    A,(TP)          ; PBASE BACK
2540         PUSH    A,[400000,,0]
2541         MOVEI   A,(A)
2542         GTJFN
2543         JRST    TDLLOS
2544         POP     P,B
2545         EXCH    A,B
2546         MOVEI   C,(A)           ; FOR RELEASE ATTEMPT
2547         RNAMF
2548         JRST    RNMLOS
2549         MOVEI   A,(B)
2550         RLJFN                   ; FLUSH JFN
2551         JFCL
2552         MOVEI   A,(C)           ; MAKE SURR OTHER IS FLUSHED
2553         RLJFN
2554         JFCL
2555         JRST    FDLWON
2556
2557
2558 ADDNUL: PUSH    TP,A
2559         PUSH    TP,B
2560         MOVEI   A,(A)           ; LNTH OF STRING
2561         IDIVI   A,5
2562         JUMPN   B,NONUAD        ; DONT NEED TO ADD ONE
2563
2564         PUSH    TP,$TCHRS
2565         PUSH    TP,[0]
2566         MOVEI   A,2
2567         PUSHJ   P,CISTNG        ; COPY OF STRING
2568         POPJ    P,
2569
2570 NONUAD: POP     TP,B
2571         POP     TP,A
2572         POPJ    P,
2573 ]
2574 ; HERE FOR LOSING .FDELE
2575
2576 IFN ITS,[
2577 FDLST:  .STATUS 0,A             ; GET STATUS
2578 FDLST1: MOVEI   B,0
2579         PUSHJ   P,GFALS         ; ANALYZE IT
2580         JRST    FINIS
2581 ]
2582
2583 ; SOME .FDELE ERRORS
2584
2585 DEVDIF: ERRUUO  EQUOTE DEVICE-OR-SNAME-DIFFERS
2586
2587 \f; HERE TO RESET A READ CHANNEL
2588
2589 MFUNCTION FRESET,SUBR,RESET
2590
2591         ENTRY   1
2592         GETYP   A,(AB)
2593         CAIE    A,TCHAN
2594         JRST    WTYP1
2595         MOVE    B,1(AB)         ;GET CHANNEL
2596         SKIPN   IOINS(B)                ; OPEN?
2597         JRST    REOPE1          ; NO, IGNORE CHECKS
2598 IFN ITS,[
2599         MOVE    A,STATUS(B)     ;GET STATUS
2600         ANDI    A,77
2601         JUMPE   A,REOPE1        ;IF IT CLOSED, JUST REOPEN IT, MAYBE?
2602         CAILE   A,2             ;SKIPS IF TTY FLAVOR
2603         JRST    REOPEN
2604 ]
2605 IFE ITS,[
2606         MOVE    A,CHANNO(B)
2607         CAIE    A,100           ; TTY-IN
2608         CAIN    A,101           ; TTY-OUT
2609         JRST    .+2
2610         JRST    REOPEN
2611 ]
2612         CAME    B,TTICHN+1
2613         CAMN    B,TTOCHN+1
2614         JRST    REATTY
2615 REATT1: MOVEI   B,DIRECT-1(B)   ;POINT TO DIRECTION
2616         PUSHJ   P,CHRWRD        ;CONVERT TO A WORD
2617         JFCL
2618         CAME    B,[ASCII /READ/]
2619         JRST    TTYOPN
2620         MOVE    B,1(AB)         ;RESTORE CHANNEL
2621         PUSHJ   P,RRESET"       ;DO REAL RESET
2622         JRST    TTYOPN
2623
2624 REOPEN: PUSH    TP,(AB)         ;FIRST CLOSE IT
2625         PUSH    TP,(AB)+1
2626         MCALL   1,FCLOSE
2627         MOVE    B,1(AB)         ;RESTORE CHANNEL
2628
2629 ; SET UP TEMPS FOR OPNCH
2630
2631 REOPE1: PUSH    P,[0]           ; WILL HOLD DIR CODE
2632         PUSH    TP,$TPDL
2633         PUSH    TP,P
2634         IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS]
2635         PUSH    TP,A-1(B)
2636         PUSH    TP,A(B)
2637         TERMIN
2638
2639         PUSH    TP,$TCHAN
2640         PUSH    TP,1(AB)
2641
2642         MOVE    A,T.DIR(TB)
2643         MOVE    B,T.DIR+1(TB)   ; GET DIRECTION
2644         PUSHJ   P,CHMOD ; CHECK THE MODE
2645         MOVEM   A,(P)           ; AND STORE IT
2646
2647 ; NOW SET UP OPEN BLOCK IN SIXBIT
2648
2649 IFN ITS,[
2650         MOVSI   E,-4            ; AOBN PNTR
2651 FRESE2: MOVE    B,T.CHAN+1(TB)
2652         MOVEI   A,@RDTBL(E)     ; GET ITEM POINTER
2653         GETYP   0,-1(A)         ; GET ITS TYPE
2654         CAIE    0,TCHSTR
2655         JRST    FRESE1
2656         MOVE    B,(A)           ; GET STRING
2657         MOVE    A,-1(A)
2658         PUSHJ   P,STRTO6
2659 FRESE3: AOBJN   E,FRESE2
2660 ]
2661 IFE ITS,[
2662         MOVE    B,T.CHAN+1(TB)
2663         MOVE    A,RDEVIC-1(B)
2664         MOVE    B,RDEVIC(B)
2665         PUSHJ   P,STRTO6                ; RESULT ON STACK
2666         HLRZS   (P)
2667 ]
2668
2669         PUSH    P,[0]           ; PUSH UP SOME DUMMIES
2670         PUSH    P,[0]
2671         PUSH    P,[0]
2672         PUSHJ   P,OPNCH         ; ATTEMPT TO DO THEOPEN
2673         GETYP   0,A
2674         CAIE    0,TCHAN
2675         JRST    FINIS           ; LEAVE IF FALSE OR WHATEVER
2676
2677 DRESET: MOVE    A,(AB)
2678         MOVE    B,1(AB)
2679         SETZM   CHRPOS(B)       ;INITIALIZE THESE PARAMETERS
2680         SETZM   LINPOS(B)
2681         SETZM   ACCESS(B)
2682         JRST    FINIS
2683
2684 TTYOPN:
2685 IFN ITS,[
2686         MOVE    B,1(AB)
2687         CAME    B,TTOCHN+1
2688         CAMN    B,TTICHN+1
2689         PUSHJ   P,TTYOP2
2690         PUSHJ   P,DOSTAT
2691         DOTCAL  RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]]
2692          .LOSE  %LSSYS
2693         MOVEM   C,PAGLN(B)
2694         MOVEM   D,LINLN(B)
2695 ]
2696         JRST    DRESET
2697
2698 IFN ITS,[
2699 FRESE1: CAIE    0,TFIX
2700         JRST    BADCHN
2701         PUSH    P,(A)
2702         JRST    FRESE3
2703 ]
2704
2705 ; INTERFACE TO REOPEN CLOSED CHANNELS
2706
2707 OPNCHN: PUSH    TP,$TCHAN
2708         PUSH    TP,B
2709         MCALL   1,FRESET
2710         POPJ    P,
2711
2712 REATTY: PUSHJ   P,TTYOP2
2713 IFE ITS,        SKIPN   DEMFLG          ; SKIP IF DEMONFLAG IS ON
2714         SKIPE   NOTTY
2715         JRST    DRESET
2716         MOVE    B,1(AB)
2717         JRST    REATT1
2718 \f
2719 ; FUNCTION TO LIST ALL CHANNELS
2720
2721 MFUNCTION CHANLIST,SUBR
2722
2723         ENTRY   0
2724
2725         MOVEI   A,N.CHNS-1      ;MAX # OF REAL CHANNELS
2726         MOVEI   C,0
2727         MOVEI   B,CHNL1 ;POINT TO FIRST REAL CHANNEL
2728
2729 CHNLP:  SKIPN   1(B)            ;OPEN?
2730         JRST    NXTCHN          ;NO, SKIP
2731         HRRE    E,(B)           ; ABOUT TO FLUSH?
2732         JUMPL   E,NXTCHN        ; YES, FORGET IT
2733         MOVE    D,1(B)          ; GET CHANNEL
2734         HRRZ    E,CHANNO-1(D)   ; GET REF COUNT
2735         PUSH    TP,(B)
2736         PUSH    TP,1(B)
2737         ADDI    C,1             ;COUNT WINNERS
2738         SOJGE   E,.-3           ; COUNT THEM
2739 NXTCHN: ADDI    B,2
2740         SOJN    A,CHNLP
2741
2742         SKIPN   B,CHNL0+1       ;NOW HACK LIST OF PSUEDO CHANNELS
2743         JRST    MAKLST
2744 CHNLS:  PUSH    TP,(B)
2745         PUSH    TP,(B)+1
2746         ADDI    C,1
2747         HRRZ    B,(B)
2748         JUMPN   B,CHNLS
2749
2750 MAKLST: ACALL   C,LIST
2751         JRST    FINIS
2752
2753 \f; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE
2754
2755
2756 REOPN:  PUSH    TP,$TCHAN
2757         PUSH    TP,B
2758         SKIPN   CHANNO(B)       ; ONLY REAL CHANNELS
2759         JRST    PSUEDO
2760
2761 IFN ITS,[
2762         MOVSI   E,-4            ; SET UP POINTER FOR NAMES
2763
2764 GETOPB: MOVE    B,(TP)          ; GET CHANNEL
2765         MOVEI   A,@RDTBL(E)     ; GET POINTER
2766         MOVE    B,(A)           ; NOW STRING
2767         MOVE    A,-1(A)
2768         PUSHJ   P,STRTO6        ; LEAVES SIXBIT ON STACK
2769         AOBJN   E,GETOPB
2770 ]
2771 IFE ITS,[
2772         MOVE    A,RDEVIC-1(B)
2773         MOVE    B,RDEVIC(B)
2774         PUSHJ   P,STRTO6        ; GET DEV NAME IN SIXBIT
2775 ]
2776         MOVE    B,(TP)          ; RESTORE CHANNEL
2777         MOVE    A,DIRECT-1(B)
2778         MOVE    B,DIRECT(B)
2779         PUSHJ   P,CHMOD ; CHECK FOR A VALID MODE
2780
2781 IFN ITS,        MOVE    E,-3(P)         ; GET DEVICE IN PROPER PLACE
2782 IFE ITS,        HLRZS   E,(P)
2783         MOVE    B,(TP)          ; RESTORE CHANNEL
2784 IFN ITS,        CAMN    E,[SIXBIT /DSK   /]
2785 IFE ITS,[
2786         CAIE    E,(SIXBIT /PS /)
2787         CAIN    E,(SIXBIT /DSK/)
2788         JRST    DISKH           ; DISK WINS IMMEIDATELY
2789         CAIE    E,(SIXBIT /SS  /)
2790         CAIN    E,(SIXBIT /SRC/)
2791         JRST    DISKH           ; DISK WINS IMMEIDATELY
2792 ]
2793 IFN ITS,        CAMN    E,[SIXBIT /TTY   /]     ; NO NEED TO RE-OPEN THE TTY
2794 IFE ITS,        CAIN    E,(SIXBIT /TTY/)
2795         JRST    REOPD1
2796 IFN ITS,[
2797         AND     E,[777700,,0]   ; COULD BE "UTn"
2798         MOVE    D,CHANNO(B)     ; GET CHANNEL
2799         ASH     D,1
2800         ADDI    D,CHNL0 ; DON'T SEEM TO BE OPEN
2801         SETZM   1(D)
2802         SETZM   CHANNO(B)
2803         CAMN    E,[SIXBIT /UT    /]
2804         JRST    REOPD           ; CURRENTLY, CANT RESTORE UTAPE CHANNLES
2805         CAMN    E,[SIXBIT /AI    /]
2806         JRST    REOPD           ; CURRENTLY CANT RESTORE AI CHANNELS
2807         CAMN    E,[SIXBIT /ML    /]
2808         JRST    REOPD           ; CURRENTLY CANT RESTORE ML CHANNELS
2809         CAMN    E,[SIXBIT /DM    /]
2810         JRST    REOPD           ; CURRENTLY CANT RESTORE DM CHANNELS
2811 ]
2812         PUSH    TP,$TCHAN       ; TRY TO RESET IT
2813         PUSH    TP,B
2814         MCALL   1,FRESET
2815
2816 IFN ITS,[
2817 REOPD1: AOS     -4(P)
2818 REOPD:  SUB     P,[4,,4]
2819 ]
2820 IFE ITS,[
2821 REOPD1: AOS     -1(P)
2822 REOPD:  SUB     P,[1,,1]
2823 ]
2824 REOPD0: SUB     TP,[2,,2]
2825         POPJ    P,
2826
2827 IFN ITS,[
2828 DISKH:  MOVE    C,(P)           ; SNAME
2829         .SUSET  [.SSNAM,,C]
2830 ]
2831 IFE ITS,[
2832 DISKH:  MOVEM   A,(P)           ; SAVE MODE WORD
2833         PUSHJ   P,STSTK         ; STRING TO STACK
2834         MOVE    A,(E)           ; RESTORE MODE WORD
2835         PUSH    TP,$TPDL
2836         PUSH    TP,E            ; SAVE PDL BASE
2837         MOVE    B,-2(TP)        ; CHANNEL BACK TO B
2838 ]
2839         MOVE    C,ACCESS(B)     ; GET CHANNELS ACCESS
2840         TRNN    A,2             ; SKIP IF NOT ASCII CHANNEL
2841         JRST    DISKH1
2842         HRRZ    D,ACCESS-1(B)   ; IF PARTIAL WORD OUT
2843         IMULI   C,5             ; TO CHAR ACCESS
2844         JUMPE   D,DISKH1        ; NO SWEAT
2845         ADDI    C,(D)
2846         SUBI    C,5
2847 DISKH1: HRRZ    D,BUFSTR-1(B)   ; ANY CHARS IN MUDDLE BUFFER
2848         JUMPE   D,DISKH2
2849         TRNN    A,1             ; SKIP IF OUTPUT CHANNEL
2850         JRST    DISKH2
2851         PUSH    P,A
2852         PUSH    P,C
2853         MOVEI   C,BUFSTR-1(B)
2854         PUSHJ   P,BYTDOP        ; FIND LENGTH OF WHOLE BUFFER
2855         HLRZ    D,(A)           ; LENGTH + 2 TO D
2856         SUBI    D,2
2857         IMULI   D,5             ; TO CHARS
2858         SUB     D,BUFSTR-1(B)
2859         POP     P,C
2860         POP     P,A
2861 DISKH2: SUBI    C,(D)           ; UPDATE CHAR ACCESS
2862         IDIVI   C,5             ; BACK TO WORD ACCESS
2863 IFN ITS,[
2864         IORI    A,6             ; BLOCK IMAGE
2865         TRNE    A,1
2866         IORI    A,100000        ; WRITE OVER BIT
2867         PUSHJ   P,DOOPN
2868         JRST    REOPD
2869         MOVE    A,C             ; ACCESS TO A
2870         PUSHJ   P,GETFLN        ; CHECK LENGTH
2871         CAIGE   0,(A)           ; CHECK BOUNDS
2872         JRST    .+3             ; COMPLAIN
2873         PUSHJ   P,DOACCS        ; AND ACESS
2874         JRST    REOPD1          ; SUCCESS
2875
2876         MOVE    A,CHANNO(B)     ; CLOSE THE G.D. CHANNEL
2877         PUSHJ   P,MCLOSE
2878         JRST    REOPD
2879
2880 DOACCS: PUSH    P,A
2881         HRRZ    A,CHANNO(B)
2882         DOTCAL  ACCESS,[A,(P)]
2883         JFCL
2884         POP     P,A
2885         POPJ    P,
2886
2887 DOIOTO:
2888 DOIOTI:
2889 DOIOT:
2890         PUSH    P,0
2891         MOVSI   0,TCHAN
2892         MOVE    PVP,PVSTOR+1
2893         MOVEM   0,BSTO(PVP)     ; IN CASE OF INTERRUPT
2894         ENABLE
2895         HRRZ    0,CHANNO(B)
2896         DOTCAL  IOT,[0,A]
2897         JFCL
2898         DISABLE
2899         MOVE    PVP,PVSTOR+1
2900         SETZM   BSTO(PVP)
2901         POP     P,0
2902         POPJ    P,
2903
2904 GETFLN: MOVE    0,CHANNO(B)     ; GET CHANNEL
2905         .CALL   FILBLK          ; READ LNTH
2906         .VALUE
2907         POPJ    P,
2908
2909 FILBLK: SETZ
2910         SIXBIT /FILLEN/
2911         0
2912         402000,,0       ; STUFF RESULT IN 0
2913 ]
2914 IFE ITS,[
2915         MOVEI   A,CHNL0
2916         ADD     A,CHANNO(B)
2917         ADD     A,CHANNO(B)
2918         SETZM   1(A)            ; MAY GET A DIFFERENT JFN
2919         HRROI   B,1(E)          ; TENEX STRING POINTER
2920         MOVSI   A,400001        ; MAKE SURE
2921         GTJFN                   ; GO GET IT
2922         JRST    RGTJL           ; COMPLAIN
2923         MOVE    D,-2(TP)
2924         HRRZM   A,CHANNO(D)     ; COULD HAVE CHANGED
2925         MOVE    P,(TP)          ; RESTORE P
2926         MOVEI   B,CHNL0
2927         ASH     A,1             ; MUNG ITS SLOT
2928         ADDI    A,(B)
2929         MOVEM   D,1(A)
2930         HLLOS   (A)             ; MARK CHANNEL NOT TO BE RELOOKED AT
2931         MOVE    A,(P)           ; MODE WORD BACK
2932         MOVE    B,[440000,,200000]      ; FLAG BITS
2933         TRNE    A,1             ; SKIP FOR INPUT
2934         TRC     B,300000        ; CHANGE TO WRITE
2935         MOVE    A,CHANNO(D)     ; GET JFN
2936         OPENF
2937         JRST    ROPFLS
2938         MOVE    E,C             ; LENGTH TO E
2939         SIZEF                   ; GET CURRENT LENGTH
2940         JRST    ROPFLS
2941         CAMGE   B,E             ; STILL A WINNER
2942         JRST    ROPFLS
2943         MOVE    A,CHANNO(D)     ; JFN
2944         MOVE    B,C
2945         SFPTR
2946         JRST    ROPFLS
2947         SUB     TP,[2,,2]       ; FLUSH PDL POINTER
2948         JRST    REOPD1
2949
2950 ROPFLS: MOVE    A,-2(TP)
2951         MOVE    A,CHANNO(A)
2952         CLOSF                   ; ATTEMPT TO CLOSE
2953         JFCL                    ; IGNORE FAILURE
2954         SKIPA
2955
2956 RGTJL:  MOVE    P,(TP)
2957         SUB     TP,[2,,2]
2958         JRST    REOPD
2959
2960 DOACCS: PUSH    P,B
2961         EXCH    A,B
2962         MOVE    A,CHANNO(A)
2963         SFPTR
2964         JRST    ACCFAI
2965         POP     P,B
2966         POPJ    P,
2967 ]
2968 PSUEDO: AOS     (P)             ; ASSUME SUCCESS FOR NOW
2969         MOVEI   B,RDEVIC-1(B)   ; SEE WHAT DEVICE IS
2970         PUSHJ   P,CHRWRD
2971         JFCL
2972         JRST    REOPD0          ; NO, RETURN HAPPY
2973 IFN 0,[ CAME    B,[ASCII /E&S/] ; DISPLAY ?
2974         CAMN    B,[ASCII /DIS/]
2975         SKIPA   B,(TP)          ; YES, REGOBBLE CHANNEL AND CONTINUE
2976         JRST    REOPD0          ; NO, RETURN HAPPY
2977         PUSHJ   P,DISROP
2978         SOS     (P)             ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS
2979         JRST    REOPD0]
2980
2981 \f;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL
2982
2983 MFUNCTION FCLOSE,SUBR,[CLOSE]
2984
2985         ENTRY   1               ;ONLY ONE ARG
2986         GETYP   A,(AB)          ;CHECK ARGS
2987         CAIE    A,TCHAN         ;IS IT A CHANNEL
2988         JRST    WTYP1
2989         MOVE    B,1(AB)         ;PICK UP THE CHANNEL
2990         HRRZ    A,CHANNO-1(B)   ; GET REF COUNT
2991         SOJGE   A,CFIN5         ;  NOT READY TO REALLY CLOSE
2992         CAME    B,TTICHN+1      ; CHECK FOR TTY
2993         CAMN    B,TTOCHN+1
2994         JRST    CLSTTY
2995         MOVE    A,[JRST CHNCLS]
2996         MOVEM   A,IOINS(B)      ;CLOBBER THE IO INS
2997         MOVE    A,RDEVIC-1(B)   ;GET THE NAME OF THE DEVICE
2998         MOVE    B,RDEVIC(B)
2999         PUSHJ   P,STRTO6
3000 IFN ITS,        MOVE    A,(P)
3001 IFE ITS,        HLRZS   A,(P)
3002         MOVE    B,1(AB)         ; RESTORE CHANNEL
3003 IFN 0,[
3004         CAME    A,[SIXBIT /E&S   /]
3005         CAMN    A,[SIXBIT /DIS   /]
3006         PUSHJ   P,DISCLS]
3007         MOVE    B,1(AB)         ; IN CASE CLOBBERED BY DISCLS
3008         SKIPN   A,CHANNO(B)     ;ANY REAL CHANNEL?
3009         JRST    REMOV           ; NO, EITHER  CLOSED OR PSEUDO CHANNEL
3010
3011         MOVE    A,DIRECT-1(B)   ; POINT TO DIRECTION
3012         MOVE    B,DIRECT(B)
3013         PUSHJ   P,STRTO6        ; CONVERT TO WORD
3014         POP     P,A
3015 IFN ITS,        LDB     E,[360600,,(P)] ; FIRST CHAR OD DEV NAME
3016 IFE ITS,        LDB     E,[140600,,(P)] ; FIRST CHAR OD DEV NAME
3017         CAIE    E,'T            ; SKIP IF TTY
3018         JRST    CFIN4
3019         CAME    A,[SIXBIT /READ/]       ; SKIP IF WINNER
3020         JRST    CFIN1
3021 IFN ITS,[
3022         MOVE    B,1(AB)         ; IN ITS CHECK STATUS
3023         LDB     A,[600,,STATUS(B)]
3024         CAILE   A,2
3025         JRST    CFIN1
3026 ]
3027         PUSH    TP,$TCHSTR
3028         PUSH    TP,CHQUOTE CHAR
3029         PUSH    TP,(AB)
3030         PUSH    TP,1(AB)
3031         MCALL   2,OFF           ; TURN OFF INTERRUPT
3032 CFIN1:  MOVE    B,1(AB)
3033         MOVE    A,CHANNO(B)
3034 IFN ITS,[
3035         PUSHJ   P,MCLOSE
3036 ]
3037 IFE ITS,[
3038         TLZ     A,400000        ; FOR JFN RELEASE
3039         CLOSF                   ; CLOSE THE FILE AND RELEASE THE JFN
3040         JFCL
3041         MOVE    A,CHANNO(B)
3042 ]
3043 CFIN:   LSH     A,1
3044         ADDI    A,CHNL0+1       ;POINT TO THIS CHANNELS LSOT
3045         SETZM   CHANNO(B)
3046         SETZM   (A)             ;AND CLOBBER IT
3047         HLLZS   BUFSTR-1(B)
3048         SETZM   BUFSTR(B)
3049         HLLZS   ACCESS-1(B)
3050 CFIN2:  HLLZS   -2(B)
3051         MOVSI   A,TCHAN         ;RETURN THE CHANNEL
3052         JRST    FINIS
3053
3054 CLSTTY: ERRUUO  EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL
3055
3056
3057 REMOV:  MOVEI   D,CHNL0+1       ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST
3058 REMOV0: SKIPN   C,D             ;FOUND ON LIST ?
3059         JRST    CFIN2           ;NO, JUST IGNORE THIS CLOSED CHANNEL
3060         HRRZ    D,(C)           ;GET POINTER TO NEXT
3061         CAME    B,(D)+1         ;FOUND ?
3062         JRST    REMOV0
3063         HRRZ    D,(D)           ;YES, SPLICE IT OUT
3064         HRRM    D,(C)
3065         JRST    CFIN2
3066
3067
3068 ; CLOSE UP ANY LEFTOVER BUFFERS
3069
3070 CFIN4:
3071 ;       CAME    A,[SIXBIT /PRINTO/]
3072 ;       CAMN    A,[SIXBIT /PRINTB/]
3073 ;       JRST    .+3
3074 ;       CAME    A,[SIXBIT /PRINT/]
3075 ;       JRST    CFIN1
3076         MOVE    B,1(AB)         ; GET CHANNEL
3077         HRRZ    A,-2(B)         ;GET MODE BITS
3078         TRNN    A,C.PRIN
3079          JRST   CFIN1
3080         GETYP   0,BUFSTR-1(B)   ; IS THERE AN OUTPUT BUFFER
3081         SKIPN   BUFSTR(B)
3082         JRST    CFIN1
3083         CAIE    0,TCHSTR
3084         JRST    CFINX1
3085         PUSHJ   P,BFCLOS
3086 IFE ITS,[
3087         MOVE    A,CHANNO(B)
3088         MOVEI   B,7
3089         SFBSZ
3090         JFCL
3091         CLOSF
3092         JFCL
3093 ]
3094         HLLZS   BUFSTR-1(B)
3095         SETZM   BUFSTR(B)
3096 CFINX1: HLLZS   ACCESS-1(B)
3097         JRST    CFIN1
3098
3099 CFIN5:  HRRM    A,CHANNO-1(B)
3100         JRST    CFIN2
3101 \f;SUBR TO DO .ACCESS ON A READ CHANNEL
3102 ;FORM:  <ACCESS  CHANNEL FIX-NUMBER>
3103 ;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER
3104 ;H. BRODIE 7/26/72
3105
3106 MFUNCTION MACCESS,SUBR,[ACCESS]
3107         ENTRY   2       ;ARGS: CHANNEL AND FIX-NUMBER
3108
3109 ;CHECK ARGUMENT TYPES
3110         GETYP   A,(AB)
3111         CAIE    A,TCHAN         ;FIRST ARG SHOULD BE CHANNEL
3112         JRST    WTYP1
3113         GETYP   A,2(AB)         ;TYPE OF SECOND
3114         CAIE    A,TFIX          ;SHOULD BE FIX
3115         JRST    WTYP2
3116
3117 ;CHECK DIRECTION OF CHANNEL
3118         MOVE    B,1(AB)         ;B GETS PNTR TO CHANNEL
3119 ;       MOVEI   B,DIRECT-1(B)   ;GET DIRECTION OF CHANNEL
3120 ;       PUSHJ   P,CHRWRD        ;GRAB THE CHAR STRNG
3121 ;       JFCL
3122 ;       CAME    B,[<ASCII /PRINT/>+1]
3123         HRRZ    A,-2(B)         ; GET MODE BITS
3124         TRNN    A,C.PRIN
3125         JRST    MACCA
3126         MOVE    B,1(AB)
3127         SKIPE   C,BUFSTR(B)     ;SEE IF WE MUST FLUSH PART BUFFER
3128         PUSHJ   P,BFCLOS
3129         JRST    MACC
3130 MACCA:
3131 ;       CAMN    B,[ASCIZ /READ/]
3132 ;       JRST    .+4
3133 ;       CAME    B,[ASCIZ /READB/]       ; READB CHANNEL?
3134 ;       JRST    WRONGD
3135 ;       AOS     (P)                     ; SET INDICATOR FOR BINARY MODE
3136
3137 ;CHECK THAT THE CHANNEL IS OPEN
3138 MACC:   MOVE    B,1(AB)         ;GET BACK PTR TO CHANNEL
3139         HRRZ    E,-2(B)
3140         TRNN    E,C.OPN
3141         JRST    CHNCLS          ;IF CHNL CLOSED => ERROR
3142
3143 ;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN
3144 ;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER
3145 ADEVOK: SKIPGE  C,3(AB)         ;GET CHAR POSN
3146         ERRUUO  EQUOTE NEGATIVE-ARGUMENT
3147 MACC1:  MOVEI   D,0
3148         TRNN    E,C.BIN         ; SKIP FOR BINARY FILE
3149         IDIVI   C,5
3150
3151 ;SETUP THE .ACCESS
3152         TRNN    E,C.PRIN
3153          JRST   NLSTCH
3154         HRRZ    0,LSTCH-1(B)
3155         MOVE    A,ACCESS(B)
3156         TRNN    E,C.BIN
3157          JRST   LSTCH1
3158         IMULI   A,5
3159         ADD     A,ACCESS-1(B)
3160         ANDI    A,-1
3161 LSTCH1: CAIG    0,(A)
3162          MOVE   0,A
3163         MOVE    A,C
3164         IMULI   A,5
3165         ADDI    A,(D)
3166         CAML    A,0
3167          MOVE   0,A
3168         HRRM    0,LSTCH-1(B)    ; UPDATE "LARGEST"
3169 NLSTCH: MOVE    A,CHANNO(B)     ;A GETS REAL CHANNEL NUMBER
3170 IFN ITS,[
3171         DOTCAL  ACCESS,[A,C]
3172          .LOSE  %LSFIL          ;PRESUMABLY LOSSAGE MATTERS
3173 ]
3174
3175 IFE ITS,[
3176         MOVE    B,C
3177         SFPTR                   ; DO IT IN TENEX
3178         JRST    ACCFAI
3179         MOVE    B,1(AB)         ; RESTORE CHANNEL
3180 ]
3181 ;       POP     P,E             ; CHECK FOR READB MODE
3182         TRNN    E,C.READ
3183         JRST    ACCOUT          ; PRINT TYPE CHANNEL, GO DO IT
3184         SKIPE   BUFSTR(B)       ; IS THERE A READ BUFFER TO FLUSH
3185         JRST    .+3
3186         SETZM   LSTCH(B)        ; CLEAR OUT POSSIBLE EOF INDICATOR
3187         JRST    DONADV
3188
3189 ;NOW FORCE GETCHR TO DO A .IOT FIRST THING
3190         MOVEI   C,BUFSTR-1(B)   ; FIND END OF STRING
3191         PUSHJ   P,BYTDOP"
3192         SUBI    A,2             ; LAST REAL WORD
3193         HRLI    A,010700
3194         MOVEM   A,BUFSTR(B)
3195         HLLZS   BUFSTR-1(B)     ; CLOBBER CHAR COUNT
3196         SETZM   LSTCH(B)        ;CLOBBER READ'S HIDDEN CHARACTER
3197
3198 ;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS
3199         JUMPLE  D,DONADV
3200 ADVPTR: PUSHJ   P,GETCHR
3201         MOVE    B,1(AB)         ;RESTORE IN CASE CLOBBERED
3202         SOJG    D,ADVPTR
3203
3204 DONADV: MOVE    C,3(AB)         ;FIXUP ACCESS SLOT IN CHNL
3205         HLLZS   ACCESS-1(B)
3206         MOVEM   C,ACCESS(B)
3207         MOVE    A,$TCHAN        ;TYPE OF RESULT = "CHANNEL"
3208         JRST    FINIS           ;DONE...B CONTAINS CHANNEL
3209
3210 IFE ITS,[
3211 ACCFAI: ERRUUO  EQUOTE ACCESS-FAILURE
3212 ]
3213 ACCOUT: SKIPN   C,BUFSTR(B)     ; FIXUP BUFFER?
3214          JRST   ACCOU1
3215         HRRZ    F,BUFSTR-1(B)
3216         ADD     F,[-BUFLNT*5-4]
3217         IDIVI   F,5
3218         ADD     F,BUFSTR(B)
3219         HRLI    F,010700
3220         MOVEM   F,BUFSTR(B)
3221         MOVEI   F,BUFLNT*5
3222         HRRM    F,BUFSTR-1(B)
3223 ACCOU1: TRNE    E,C.BIN         ; FINISHED FOR BINARY CHANNELS
3224          JRST   DONADV
3225
3226         JUMPE   D,DONADV        ; THIS CASE OK
3227 IFE ITS,[
3228         MOVE    A,CHANNO(B)     ; GET LAST WORD
3229         RFPTR
3230         JFCL
3231         PUSH    P,B
3232         MOVNI   C,1
3233         MOVE    B,[444400,,E]   ; READ THE WORD
3234         SIN
3235         JUMPL   C,ACCFAI
3236         POP     P,B
3237         SFPTR
3238         JFCL
3239         MOVE    B,1(AB)         ; CHANNEL BACK
3240         MOVE    C,[440700,,E]
3241         ILDB    0,C
3242         IDPB    0,BUFSTR(B)
3243         SOS     BUFSTR-1(B)
3244         SOJG    D,.-3
3245         JRST    DONADV
3246 ]
3247 IFN ITS,        ERRUUO  EQUOTE CANT-ACCESS-ASCII-ON-ITS
3248
3249
3250 ;WRONG TYPE OF DEVICE ERROR
3251 WRDEV:  ERRUUO  EQUOTE NON-DSK-DEVICE
3252 \f
3253 ; BINARY READ AND PRINT ROUTINES
3254
3255 MFUNCTION PRINTB,SUBR
3256
3257         ENTRY
3258
3259 PBFL:   PUSH    P,.             ; PUSH NON-ZERONESS
3260         MOVEI   A,-7
3261         JRST    BINI1
3262
3263 MFUNCTION READB,SUBR
3264
3265         ENTRY
3266
3267         PUSH    P,[0]
3268         MOVEI   A,-11
3269 BINI1:  HLRZ    0,AB
3270         CAILE   0,-3
3271          JRST   TFA
3272         CAIG    0,(A)
3273          JRST   TMA
3274
3275         GETYP   0,(AB)          ; SHOULD BE UVEC OR STORE
3276         CAIE    0,TSTORAGE
3277          CAIN   0,TUVEC
3278           JRST  BINI2
3279         CAIE    0,TCHSTR
3280          CAIN   0,TBYTE
3281           JRST  BYTOK
3282            JRST WTYP1           ; ELSE LOSE
3283 BINI2:  MOVE    B,1(AB)         ; GET IT
3284         HLRE    C,B
3285         SUBI    B,(C)           ; POINT TO DOPE
3286         GETYP   A,(B)
3287         PUSHJ   P,SAT"          ; GET ITS ST.ALOC.TYPE
3288         CAIE    A,S1WORD
3289          JRST   WTYP1
3290 BYTOK:  GETYP   0,2(AB)
3291         CAIE    0,TCHAN         ; BETTER BE A CHANNEL
3292          JRST   WTYP2
3293         MOVE    B,3(AB)         ; GET IT
3294 ;       MOVEI   B,DIRECT-1(B)   ; GET DIRECTION OF
3295 ;       PUSHJ   P,CHRWRD        ; INTO 1 WORD
3296 ;       JFCL
3297 ;       MOVNI   E,1
3298 ;       CAMN    B,[ASCII /READB/]
3299 ;       MOVEI   E,0
3300 ;       CAMN    B,[<ASCII /PRINT/>+1]
3301         HRRZ    A,-2(B)         ; MODE BITS
3302         TRNN    A,C.BIN         ; IF NOT BINARY
3303          JRST   WRONGD
3304         MOVEI   E,0
3305         TRNE    A,C.PRIN
3306         MOVE    E,PBFL
3307 ;       JUMPL   E,WRONGD                ; LOSER
3308         CAME    E,(P)           ; CHECK WINNGE
3309          JRST   WRONGD
3310         MOVE    B,3(AB)         ; GET CHANNEL BACK
3311         SKIPN   A,IOINS(B)      ; OPEN?
3312          PUSHJ  P,OPENIT                ; LOSE
3313         CAMN    A,[JRST CHNCLS]
3314          JRST   CHNCLS          ; LOSE, CLOSED
3315         JUMPN   E,BUFOU1        ; JUMP FOR OUTPUT
3316         MOVEI   C,0
3317         CAML    AB,[-5,,]       ; SKIP IF EOF GIVEN
3318          JRST   BINI5
3319         MOVE    0,4(AB)
3320         MOVEM   0,EOFCND-1(B)
3321         MOVE    0,5(AB)
3322         MOVEM   0,EOFCND(B)
3323         CAML    AB,[-7,,]
3324          JRST   BINI5
3325         GETYP   0,6(AB)
3326         CAIE    0,TFIX
3327          JRST   WTYP
3328         MOVE    C,7(AB)
3329 BINI5:  SKIPE   LSTCH(B)        ; INDICATES IF EOF HIT
3330          JRST   BINEOF
3331         GETYP   0,(AB)          ; BRANCH BASED ON BYTE SIZE
3332         CAIE    0,TCHSTR
3333          CAIN   0,TBYTE
3334           JRST  BYTI
3335         MOVE    A,1(AB)         ; GET VECTOR
3336         PUSHJ   P,PGBIOI        ; READ IT
3337         HLRE    C,A             ; GET COUNT DONE
3338         HLRE    D,1(AB)         ; AND FULL COUNT
3339         SUB     C,D             ; C=> TOTAL READ
3340         ADDM    C,ACCESS(B)
3341         JUMPGE  A,BINIOK        ; NOT EOF YET
3342         SETOM   LSTCH(B)
3343 BINIOK: MOVE    B,C
3344         MOVSI   A,TFIX          ; RETURN AMOUNT ACTUALLY READ
3345         JRST    FINIS
3346
3347 BYTI:
3348 IFE ITS,[
3349         MOVE    A,1(B)
3350         RFBSZ
3351         FATAL RFBSZ-LOST
3352         PUSH    P,B
3353         LDB     B,[300600,,1(AB)]
3354         SFBSZ
3355         FATAL SFBSZ-LOST
3356         MOVE    B,3(AB)
3357         HRRZ    A,(AB)          ; GET BYTE STRING LENGTH
3358         MOVNS   A
3359         MOVSS   A               ; MAKE FUNNY BYTE POINTER
3360         HRR     A,1(AB)
3361         ADDI    A,1
3362         PUSH    P,C
3363         HLL     C,1(AB)         ; GET START OF BPTR
3364         MOVE    D,[SIN]
3365         PUSHJ   P,PGBIOT
3366         HLRE    C,A             ; GET COUNT DONE
3367         POP     P,D
3368         SKIPN   D
3369         HRRZ    D,(AB)          ; AND FULL COUNT
3370         ADD     D,C             ; C=> TOTAL READ
3371         LDB     E,[300600,,1(AB)]
3372         MOVEI   A,36.
3373         IDIVM   A,E
3374         IDIVM   D,E
3375         ADDM    E,ACCESS(B)
3376         SKIPGE  C               ; NOT EOF YET
3377         SETOM   LSTCH(B)
3378         MOVE    A,1(B)
3379         POP     P,B
3380         SFBSZ
3381         FATAL SFBSZ-LOST
3382         MOVE    C,D
3383         JRST    BINIOK
3384 ]
3385 BUFOU1: SKIPE   BUFSTR(B)       ; ANY BUFFERS AROUND?
3386          PUSHJ  P,BFCLS1        ; GET RID OF SAME
3387         MOVEI   C,0
3388         CAML    AB,[-5,,]
3389          JRST   BINO5
3390         GETYP   0,4(AB)
3391         CAIE    0,TFIX
3392          JRST   WTYP
3393         MOVE    C,5(AB)
3394 BINO5:  MOVE    A,1(AB)
3395         GETYP   0,(AB)          ; BRANCH BASED ON BYTE SIZE
3396         CAIE    0,TCHSTR
3397          CAIN   0,TBYTE
3398           JRST  BYTO
3399         PUSHJ   P,PGBIOO
3400         HLRE    C,1(AB)
3401         MOVNS   C
3402         ADDM    C,ACCESS(B)
3403 BYTO1:  MOVE    A,(AB)          ; RET VECTOR ETC.
3404         MOVE    B,1(AB)
3405         JRST    FINIS
3406
3407 BYTO:
3408 IFE ITS,[
3409         MOVE    A,1(B)
3410         RFBSZ
3411         FATAL RFBSZ-FAILURE
3412         PUSH    P,B
3413         LDB     B,[300600,,1(AB)]
3414         SFBSZ
3415         FATAL SFBSZ-FAILURE
3416         MOVE    B,3(AB)
3417         HRRZ    A,(AB)          ; GET BYTE SIZE
3418         MOVNS   A
3419         MOVSS   A               ; MAKE FUNNY BYTE POINTER
3420         HRR     A,1(AB)
3421         ADDI    A,1             ; COMPENSATE FOR PGBIOT DOING THE WRONG THING
3422         HLL     C,1(AB)         ; GET START OF BPTR
3423         MOVE    D,[SOUT]
3424         PUSHJ   P,PGBIOT
3425         LDB     D,[300600,,1(AB)]
3426         MOVEI   C,36.
3427         IDIVM   C,D
3428         HRRZ    C,(AB)
3429         IDIVI   C,(D)
3430         ADDM    C,ACCESS(B)
3431         MOVE    A,1(B)
3432         POP     P,B
3433         SFBSZ
3434         FATAL SFBSZ-FAILURE
3435         JRST    BYTO1
3436 ]
3437
3438 BINEOF: PUSH    TP,EOFCND-1(B)
3439         PUSH    TP,EOFCND(B)
3440         PUSH    TP,$TCHAN
3441         PUSH    TP,B
3442         MCALL   1,FCLOSE        ; CLOSE THE LOSER
3443         MCALL   1,EVAL
3444         JRST    FINIS
3445
3446 OPENIT: PUSH    P,E
3447         PUSHJ   P,OPNCHN        ;TRY TO OPEN THE LOSER
3448         JUMPE   B,CHNCLS        ;FAIL
3449         POP     P,E
3450         POPJ    P,
3451 \f; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE
3452 ; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF
3453 ; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS.
3454
3455 R1CHAR: SKIPN   A,LSTCH(B)              ; CHAR READING ROUTINE FOR FCOPY
3456         PUSHJ   P,RXCT
3457         TLO     A,200000                ; ^@ BUG
3458         MOVEM   A,LSTCH(B)
3459         TLZ     A,200000
3460         JUMPL   A,.+2                   ; IN CASE OF -1 ON STY
3461         TRZN    A,400000                ; EXCL HACKER
3462         JRST    .+4
3463         MOVEM   A,LSTCH(B)              ; SAVE DE-EXCLED CHAR
3464         MOVEI   A,"!
3465         JRST    .+2
3466         SETZM   LSTCH(B)
3467         PUSH    P,C
3468         HRRZ    C,DIRECT-1(B)
3469         CAIE    C,5                     ; IF DIRECTION IS 5 LONG THEN READB
3470         JRST    R1CH1
3471         AOS     C,ACCESS-1(B)
3472         CAMN    C,[TFIX,,1]
3473         AOS     ACCESS(B)               ; EVERY FIFTY INCREMENT
3474         CAMN    C,[TFIX,,5]
3475         HLLZS   ACCESS-1(B)
3476         JRST    .+2
3477 R1CH1:  AOS     ACCESS(B)
3478         POP     P,C
3479         POPJ    P,
3480
3481 W1CHAR: CAIE    A,15            ; CHAR WRITING ROUTINE, TEST FOR CR
3482         JRST    .+3
3483         SETOM   CHRPOS(B)
3484         AOSA    LINPOS(B)
3485         CAIE    A,12                    ; TEST FOR LF
3486         AOS     CHRPOS(B)               ; IF NOT LF AOS CHARACTE5R POSITION
3487         CAIE    A,14                    ; TEST FOR FORM FEED
3488         JRST    .+3
3489         SETZM   CHRPOS(B)               ; IF FORM FEED ZERO CHARACTER POSITION
3490         SETZM   LINPOS(B)               ; AND LINE POSITION
3491         CAIE    A,11                    ; IS THIS A TAB?
3492         JRST    .+6
3493         MOVE    C,CHRPOS(B)
3494         ADDI    C,7
3495         IDIVI   C,8.
3496         IMULI   C,8.                    ; FIX UP CHAR POS FOR TAB
3497         MOVEM   C,CHRPOS(B)             ; AND SAVE
3498         PUSH    P,C
3499         HRRZ    C,-2(B)                 ; GET BITS
3500         TRNN    C,C.BIN                 ; SIX LONG MUST BE PRINTB
3501         JRST    W1CH1
3502         AOS     C,ACCESS-1(B)
3503         CAMN    C,[TFIX,,1]
3504         AOS     ACCESS(B)
3505         CAMN    C,[TFIX,,5]
3506         HLLZS   ACCESS-1(B)
3507         JRST    .+2
3508 W1CH1:  AOS     ACCESS(B)
3509         PUSH    P,A
3510         PUSHJ   P,WXCT
3511         POP     P,A
3512         POP     P,C
3513         POPJ    P,
3514
3515 R1C:    SUBM    M,(P)                   ;LITTLE ENTRY FOR COMPILED STUFF
3516 ;       PUSH    TP,$TCHAN               ;SAVE THE CHANNEL TO BLESS IT
3517 ;       PUSH    TP,B
3518 ;       MOVEI   B,DIRECT-1(B)
3519 ;       PUSHJ   P,CHRWRD
3520 ;       JFCL
3521 ;       CAME    B,[ASCIZ /READ/]
3522 ;       CAMN    B,[ASCII /READB/]
3523 ;       JRST    .+2
3524 ;       JRST    BADCHN
3525         HRRZ    A,-2(B)                 ; GET MODE BITS
3526         TRNN    A,C.READ
3527          JRST   BADCHN
3528         SKIPN   IOINS(B)                ; IS THE CHANNEL OPEN
3529         PUSHJ   P,OPENIT                ; NO, GO DO IT
3530         PUSHJ   P,GRB                   ; MAKE SURE WE HAVE A READ BUFFER
3531         PUSHJ   P,R1CHAR                ; AND GET HIM A CHARACTER
3532         JRST    MPOPJ                   ; THATS ALL FOLKS
3533
3534 W1C:    SUBM    M,(P)
3535         PUSHJ   P,W1CI
3536         JRST    MPOPJ
3537
3538 W1CI:
3539 ;       PUSH    TP,$TCHAN
3540 ;       PUSH    TP,B
3541         PUSH    P,A                     ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR
3542 ;       MOVEI   B,DIRECT-1(B)
3543 ;       PUSHJ   P,CHRWRD                ; INTERNAL CALL TO W1CHAR
3544 ;       JFCL
3545 ;       CAME    B,[ASCII /PRINT/]
3546 ;       CAMN    B,[<ASCII /PRINT/>+1]
3547 ;       JRST    .+2
3548 ;       JRST    BADCHN
3549 ;       POP     TP,B
3550 ;       POP     TP,(TP)
3551         HRRZ    A,-2(B)
3552         TRNN    A,C.PRIN
3553          JRST   BADCHN
3554         SKIPN   IOINS(B)                ; MAKE SURE THAT IT IS OPEN
3555         PUSHJ   P,OPENIT
3556         PUSHJ   P,GWB
3557         POP     P,A                     ; GET THE CHAR TO DO
3558         JRST    W1CHAR
3559
3560 ; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT
3561 ; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH.
3562
3563
3564 WXCT:
3565 RXCT:   XCT     IOINS(B)                ; READ IT
3566         SKIPN   SCRPTO(B)
3567         POPJ    P,
3568
3569 DOSCPT: PUSH    TP,$TCHAN
3570         PUSH    TP,B
3571         PUSH    P,A                     ; AND SAVE THE CHAR AROUND
3572
3573         SKIPN   SCRPTO(B)               ; IF ZERO FORGET IT
3574         JRST    SCPTDN                  ; THATS ALL THERE IS TO IT
3575         PUSH    P,C                     ; SAVE AN ACCUMULATOR FOR CLEANLINESS
3576         GETYP   C,SCRPTO-1(B)           ; IS IT A LIST
3577         CAIE    C,TLIST
3578         JRST    BADCHN
3579         PUSH    TP,$TLIST
3580         PUSH    TP,[0]          ; SAVE A SLOT FOR THE LIST
3581         MOVE    C,SCRPTO(B)             ; GET THE LIST OF SCRIPT CHANNELS
3582 SCPT1:  GETYP   B,(C)                   ; GET THE TYPE OF THIS SCRIPT CHAN
3583         CAIE    B,TCHAN
3584         JRST    BADCHN                  ; IF IT ISN'T A CHANNEL, COMPLAIN
3585         HRRZ    B,(C)                   ; GET THE REST OF THE LIST IN B
3586         MOVEM   B,(TP)                  ; AND STORE ON STACK
3587         MOVE    B,1(C)                  ; GET THE CHANNEL IN B
3588         MOVE    A,-1(P)                 ; AND THE CHARACTER IN A
3589         PUSHJ   P,W1CI          ; GO TO INTERNAL W1C, IT BLESSES GOODIES
3590         SKIPE   C,(TP)                  ; GET THE REST OF LIST OF CHANS
3591         JRST    SCPT1                   ; AND CYCLE THROUGH
3592         SUB     TP,[2,,2]               ; CLEAN OFF THE LIST OF CHANS
3593         POP     P,C                     ; AND RESTORE ACCUMULATOR C
3594 SCPTDN: POP     P,A                     ; RESTORE THE CHARACTER
3595         POP     TP,B                    ; AND THE ORIGINAL CHANNEL
3596         POP     TP,(TP)
3597         POPJ    P,                      ; AND THATS ALL
3598
3599
3600 ; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT
3601 ; ON THE INPUT CHANNEL
3602 ; CALL IS <FILECOPY IN OUT> WHERE DEFAULTS ARE INCHAN AND OUTCHAN
3603
3604         MFUNCTION       FCOPY,SUBR,[FILECOPY]
3605
3606         ENTRY
3607         HLRE    0,AB
3608         CAMGE   0,[-4]
3609         JRST    WNA                     ; TAKES FROM 0 TO 2 ARGS
3610
3611         JUMPE   0,.+4                   ; NO FIRST ARG?
3612         PUSH    TP,(AB)
3613         PUSH    TP,1(AB)                ; SAVE IN CHAN
3614         JRST    .+6
3615         MOVE    A,$TATOM
3616         MOVE    B,IMQUOTE INCHAN
3617         PUSHJ   P,IDVAL
3618         PUSH    TP,A
3619         PUSH    TP,B
3620         HLRE    0,AB                    ; CHECK FOR SECOND ARG
3621         CAML    0,[-2]                  ; WAS THERE MORE THAN ONE ARG?
3622         JRST    .+4
3623         PUSH    TP,2(AB)                ; SAVE SECOND ARG
3624         PUSH    TP,3(AB)
3625         JRST    .+6
3626         MOVE    A,$TATOM                ; LOOK UP OUTCHAN AS DEFAULT
3627         MOVE    B,IMQUOTE OUTCHAN
3628         PUSHJ   P,IDVAL
3629         PUSH    TP,A
3630         PUSH    TP,B                    ; AND SAVE IT
3631
3632         MOVE    A,-3(TP)
3633         MOVE    B,-2(TP)                ; INPUT CHANNEL
3634         MOVEI   0,C.READ                        ; INDICATE INPUT
3635         PUSHJ   P,CHKCHN                ; CHECK FOR GOOD CHANNEL
3636         MOVE    A,-1(TP)
3637         MOVE    B,(TP)                  ; GET OUT CHAN
3638         MOVEI   0,C.PRIN                ; INDICATE OUT CHAN
3639         PUSHJ   P,CHKCHN                ; CHECK FOR GOOD OUT CHAN
3640
3641         PUSH    P,[0]                   ; COUNT OF CHARS OUTPUT
3642
3643         MOVE    B,-2(TP)
3644         PUSHJ   P,GRB                   ; MAKE SURE WE HAVE READ BUFF
3645         MOVE    B,(TP)
3646         PUSHJ   P,GWB                   ; MAKE SURE WE HAVE WRITE BUFF
3647
3648 FCLOOP: INTGO
3649         MOVE    B,-2(TP)
3650         PUSHJ   P,R1CHAR                ; GET A CHAR
3651         JUMPL   A,FCDON                 ; IF A NEG NUMBER WE GOT EOF
3652         MOVE    B,(TP)                  ; GET OUT CHAN
3653         PUSHJ   P,W1CHAR                ; SPIT IT OUT
3654         AOS     (P)                     ; INCREMENT COUNT
3655         JRST    FCLOOP
3656
3657 FCDON:  SUB     TP,[2,,2]               ; POP OFF OUTCHAN
3658         MCALL   1,FCLOSE                ; CLOSE INCHAN
3659         MOVE    A,$TFIX
3660         POP     P,B                     ; GET CHAR COUNT TO RETURN
3661         JRST FINIS
3662
3663 CHKCHN: PUSH    P,0                     ; CHECK FOR GOOD TASTING CHANNEL
3664         PUSH    TP,A
3665         PUSH    TP,B
3666         GETYP   C,A
3667         CAIE    C,TCHAN
3668         JRST    CHKBDC                  ; GO COMPLAIN IN RIGHT WAY
3669 ;       MOVEI   B,DIRECT-1(B)
3670 ;       PUSHJ   P,CHRWRD
3671 ;       JRST    CHKBDC
3672 ;       MOVE    C,(P)                   ; GET CHAN DIRECT
3673         HRRZ    C,-2(B)                 ; MODE BITS
3674         TDNN    C,0
3675         JRST    CHKBDC
3676 ;       CAMN    B,CHKT(C)
3677 ;       JRST    .+4
3678 ;       ADDI    C,2                     ; TEST FOR READB OR PRINTB ALSO
3679 ;       CAME    B,CHKT(C)               ; TEST FOR CORRECT DIRECT
3680 ;       JRST    CHKBDC
3681         MOVE    B,(TP)
3682         SKIPN   IOINS(B)                ; MAKE SURE IT IS OPEN
3683         PUSHJ   P,OPENIT                ; IF ZERO IOINS GO OPEN IT
3684         SUB     TP,[2,,2]
3685         POP     P,                      ; CLEAN UP STACKS
3686         POPJ    P,
3687
3688 CHKT:   ASCIZ /READ/
3689         ASCII /PRINT/
3690         ASCII /READB/
3691         <ASCII /PRINT/>+1
3692
3693 CHKBDC: POP     P,E
3694         MOVNI   D,2
3695         IMULI   D,1(E)
3696         HLRE    0,AB
3697         CAMLE   0,D                     ; SEE IF THIS WAS HIS ARG OF DEFAULT
3698         JRST    BADCHN
3699         JUMPE   E,WTYP1
3700         JRST    WTYP2
3701
3702 \f; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB,
3703 ; THAT IS THEY READ INTO AND OUT OF STRINGS.  IN ADDITION BOTH ACCEPT
3704 ; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF
3705 ; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING.
3706
3707 ; FORMAT IS <READSTRING .STRING .INCHANNEL .EOFCOND .MAXCHARS>
3708 ; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN
3709
3710 ; FORMAT FOR PRINTSTRING IS <PRINTSTRING .STRING .OUTCHANNEL .MAXCHARS>
3711
3712 ; THESE WERE CODED 9/16/73 BY NEAL D. RYAN
3713
3714         MFUNCTION       RSTRNG,SUBR,READSTRING
3715
3716         ENTRY
3717         PUSH    P,[0]           ; FLAG TO INDICATE READING
3718         HLRE    0,AB
3719         CAMG    0,[-1]
3720         CAMG    0,[-9]
3721         JRST    WNA             ; CHECK THAT IT HAS FROM 1 TO 4 ARGS
3722         JRST    STRIO1
3723
3724         MFUNCTION       PSTRNG,SUBR,PRINTSTRING
3725
3726         ENTRY
3727         PUSH    P,[1]           ; FLAG TO INDICATE WRITING
3728         HLRE    0,AB
3729         CAMG    0,[-1]
3730         CAMG    0,[-7]
3731         JRST    WNA             ; CHECK THAT IT HAS FROM 1 TO 3 ARGS
3732
3733 STRIO1: PUSH    TP,[0]          ; SAVE SLOT ON STACK
3734         PUSH    TP,[0]
3735         GETYP   0,(AB)
3736         CAIE    0,TCHSTR                ; MAKE SURE WE GOT STRING
3737         JRST    WTYP1
3738         HRRZ    0,(AB)          ; CHECK FOR EMPTY STRING
3739         SKIPN   (P)
3740         JUMPE   0,MTSTRN
3741         HLRE    0,AB
3742         CAML    0,[-2]          ; WAS A CHANNEL GIVEN
3743         JRST    STRIO2
3744         GETYP   0,2(AB)
3745         SKIPN   (P)             ; SKIP IF PRINT
3746         JRST    TESTIN
3747         CAIN    0,TTP           ; SEE IF FLATSIZE HACK
3748         JRST    STRIO9
3749 TESTIN: CAIE    0,TCHAN
3750         JRST    WTYP2           ; SECOND ARG NOT CHANNEL
3751         MOVE    B,3(AB)
3752         HRRZ    B,-2(B)
3753         MOVNI   E,1             ; CHECKING FOR GOOD DIRECTION
3754         TRNE    B,C.READ                ; SKIP IF NOT READ
3755         MOVEI   E,0
3756         TRNE    B,C.PRIN                ; SKIP IF NOT PRINT
3757         MOVEI   E,1
3758         CAME    E,(P)
3759         JRST    WRONGD          ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE
3760 STRIO9: PUSH    TP,2(AB)
3761         PUSH    TP,3(AB)        ; PUSH ON CHANNEL
3762         JRST    STRIO3
3763 STRIO2: MOVE    B,IMQUOTE INCHAN
3764         MOVSI   A,TCHAN
3765         SKIPE   (P)
3766         MOVE    B,IMQUOTE OUTCHAN
3767         PUSHJ   P,IDVAL
3768         GETYP   0,A
3769         SKIPN   (P)             ; SKIP IF PRINTSTRING
3770         JRST    TESTI2
3771         CAIN    0,TTP           ; SKIP IF NOT FLATSIZE HACK
3772         JRST    STRIO8
3773 TESTI2: CAIE    0,TCHAN
3774         JRST    BADCHN          ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL
3775 STRIO8: PUSH    TP,A
3776         PUSH    TP,B
3777 STRIO3: MOVE    B,(TP)          ; GET CHANNEL
3778         SKIPN   E,IOINS(B)
3779         PUSHJ   P,OPENIT                ; IF NOT GO OPEN
3780         MOVE    E,IOINS(B)
3781         CAMN    E,[JRST CHNCLS]
3782         JRST    CHNCLS          ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED
3783 STRIO4: HLRE    0,AB
3784         CAML    0,[-4]
3785         JRST    STRIO5          ; NO COUNT TO WORRY ABOUT
3786         GETYP   0,4(AB)
3787         MOVE    E,4(AB)
3788         MOVE    C,5(AB)
3789         CAIE    0,TCHSTR
3790         CAIN    0,TFIX          ; BETTER BE A FIXED NUMBER
3791         JRST    .+2
3792         JRST    WTYP3
3793         HRRZ    D,(AB)          ; GET ACTUAL STRING LENGTH
3794         CAIN    0,TFIX
3795         JRST    .+7
3796         SKIPE   (P)     ; TEST FOR WRITING
3797         JRST    .-7             ; IF WRITING WE GOT TROUBLE
3798         PUSH    P,D             ; ACTUAL STRING LENGTH
3799         MOVEM   E,(TB)  ; STUFF HIS FUNNY DELIM STRING
3800         MOVEM   C,1(TB)
3801         JRST    STRIO7
3802         CAML    D,C             ; MAKE SURE THE STRING IS LONG ENOUGH
3803         JRST    .+2             ; WIN
3804         ERRUUO  EQUOTE COUNT-GREATER-THAN-STRING-SIZE
3805         PUSH    P,C     ; PUSH ON MAX COUNT
3806         JRST    STRIO7
3807 STRIO5:
3808 STRIO6: HRRZ    C,(AB)  ; GET CHAR COUNT
3809         PUSH    P,C             ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN
3810 STRIO7: HLRE    0,AB
3811         CAML    0,[-6]
3812         JRST    .+6
3813         MOVE    B,(TP)          ; GET THE CHANNEL
3814         MOVE    0,6(AB)
3815         MOVEM   0,EOFCND-1(B)   ; STUFF IN SLOT IN CHAN
3816         MOVE    0,7(AB)
3817         MOVEM   0,EOFCND(B)
3818         PUSH    TP,(AB)         ; PUSH ON STRING
3819         PUSH    TP,1(AB)
3820         PUSH    P,[0]           ; PUSH ON CURRENT COUNT OF CHARS DONE
3821         MOVE    0,-2(P)         ; GET READ OR WRITE FLAG
3822         JUMPN   0,OUTLOP        ; GO WRITE STUFF
3823
3824         MOVE    B,-2(TP)        ; GET CHANNEL
3825         PUSHJ   P,GRB           ; MAKE SURE WE HAVE BUFF
3826         SKIPGE  A,LSTCH(B)      ; CHECK FOR EOF ALREADY READ PREVIOUSLY
3827         JRST    SRDOEF          ; GO DOES HIS EOF HACKING
3828 INLOP:  INTGO
3829         MOVE    B,-2(TP)        ; GET CHANNEL
3830         MOVE    C,-1(P)         ; MAX COUNT
3831         CAMG    C,(P)           ; COMPARE WITH COUNT DONE
3832         JRST    STREOF          ; WE HAVE FINISHED
3833         PUSHJ   P,R1CHAR        ; GET A CHAR
3834         JUMPL   A,INEOF         ; EOF HIT
3835         MOVE    C,1(TB)
3836         HRRZ    E,(TB)          ; DO WE HAVE A STRING TO WORRY US?
3837         SOJL    E,INLNT         ; GO FINISH STUFFING
3838         ILDB    D,C
3839         CAME    D,A
3840         JRST    .-3
3841         JRST    INEOF
3842 INLNT:  IDPB    A,(TP)          ; STUFF IN STRING
3843         SOS     -1(TP)          ; DECREMENT STRING COUNT
3844         AOS     (P)             ; INCREMENT CHAR COUNT
3845         JRST    INLOP
3846
3847 INEOF:  SKIPE   C,LSTCH(B)      ; IS THIS AN ! AND IS THERE A CHAR THERE
3848         JRST    .+3             ; YES
3849         MOVEM   A,LSTCH(B)      ; NO SAVE THE CHAR
3850         JRST    .+3
3851         ADDI    C,400000
3852         MOVEM   C,LSTCH(B)
3853         MOVSI   C,200000
3854         IORM    C,LSTCH(B)
3855         HRRZ    C,DIRECT-1(B)   ; GET THE TYPE OF CHAN
3856         CAIN    C,5             ; IS IT READB?
3857         JRST    .+3
3858         SOS     ACCESS(B)       ; FIX UP ACCESS FOR READ CHANNEL
3859         JRST    STREOF          ; AND THATS IT
3860         HRRZ    C,ACCESS-1(B)   ; FOR A READB ITS WORSE
3861         MOVEI   D,5
3862         SKIPG   C
3863         HRRM    D,ACCESS-1(B)   ; CHANGE A 0 TO A FIVE
3864         SOS     C,ACCESS-1(B)
3865         CAMN    C,[TFIX,,0]
3866         SOS     ACCESS(B)       ; AND SOS THE WORD COUNT MAYBE
3867         JRST    STREOF
3868
3869 SRDOEF: SETZM   LSTCH(B)        ; IN CASE OF -1, FLUSH IT
3870         AOJE    A,INLOP         ; SKIP OVER -1 ON PTY'S
3871         SUB     TP,[6,,6]
3872         SUB     P,[3,,3]        ; POP JUNK OFF STACKS
3873         PUSH    TP,EOFCND-1(B)
3874         PUSH    TP,EOFCND(B)    ; WHAT WE NEED TO EVAL
3875         PUSH    TP,$TCHAN
3876         PUSH    TP,B
3877         MCALL   1,FCLOSE        ; CLOSE THE LOOSING CHANNEL
3878         MCALL   1,EVAL          ; EVAL HIS EOF JUNK
3879         JRST    FINIS
3880
3881 OUTLOP: MOVE    B,-2(TP)
3882 OUTLP1: INTGO
3883         MOVE    A,-3(TP)                ; GET CHANNEL
3884         MOVE    B,-2(TP)
3885         MOVE    C,-1(P)         ; MAX COUNT TO DO
3886         CAMG    C,(P)           ; HAVE WE DONE ENOUGH
3887         JRST    STREOF
3888         ILDB    D,(TP)          ; GET THE CHAR
3889         SOS     -1(TP)          ; SUBTRACT FROM STRING LENGTH
3890         AOS     (P)             ; INC COUNT OF CHARS DONE
3891         PUSHJ   P,CPCH1         ; GO STUFF CHAR
3892         JRST    OUTLP1
3893
3894 STREOF: MOVE    A,$TFIX
3895         POP     P,B             ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE
3896         SUB     P,[2,,2]
3897         SUB     TP,[6,,6]
3898         JRST    FINIS
3899
3900
3901 GWB:    SKIPE   BUFSTR(B)
3902         POPJ    P,
3903         PUSH    TP,$TCHAN
3904         PUSH    TP,B            ; GET US A WRITE BUFFER ON PRINTB CHAN
3905         MOVEI   A,BUFLNT
3906         PUSHJ   P,IBLOCK
3907         MOVSI   A,TWORD+.VECT.
3908         MOVEM   A,BUFLNT(B)
3909         SETOM   (B)
3910         MOVEI   C,1(B)
3911         HRLI    C,(B)
3912         BLT     C,BUFLNT-1(B)
3913         MOVEI   C,-1(B)
3914         HRLI    C,010700
3915         MOVE    B,(TP)
3916         MOVEI   0,C.BUF
3917         IORM    0,-2(B)
3918         MOVEM   C,BUFSTR(B)
3919         MOVE    C,[TCHSTR,,BUFLNT*5]
3920         MOVEM   C,BUFSTR-1(B)
3921         SUB     TP,[2,,2]
3922         POPJ    P,
3923
3924
3925 GRB:    SKIPE   BUFSTR(B)
3926         POPJ    P,
3927         PUSH    TP,$TCHAN
3928         PUSH    TP,B            ; GET US A READ BUFFER
3929         MOVEI   A,BUFLNT
3930         PUSHJ   P,IBLOCK
3931         MOVEI   C,BUFLNT-1(B)
3932         POP     TP,B
3933         MOVEI   0,C.BUF
3934         IORM    0,-2(B)
3935         HRLI    C,010700
3936         MOVEM   C,BUFSTR(B)
3937         MOVSI   C,TCHSTR
3938         MOVEM   C,BUFSTR-1(B)
3939         SUB     TP,[1,,1]
3940         POPJ    P,
3941
3942 MTSTRN: ERRUUO  EQUOTE EMPTY-STRING
3943
3944 \f; INPUT UNBUFFERING ROUTINE.  THIS DOES THE CHARACTER UNBUFFERING
3945 ; FOR INPUT.  THE OPEN ROUTINE SETUPS A PUSHJ P, TO
3946 ; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE.
3947
3948 ; H. BRODIE 7/19/72
3949
3950 ; CALLING SEQ:
3951 ;       PUSHJ   P,GETCHR
3952 ;               B/ AOBJN PNTR TO CHANNEL VECTOR
3953 ;               RETURNS NEXT CHARACTER IN AC A.
3954 ;       ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND
3955 ;       TRANSMITS ONLY ^C ON SUCCESSIVE CALLS
3956
3957
3958 GETCHR:
3959 ; FIRST GRAB THE BUFFER
3960 ;       GETYP   A,BUFSTR-1(B)   ; GET TYPE WORD
3961 ;       CAIN    A,TCHSTR        ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER)
3962 ;       JRST    GTGBUF          ; IS GOOD BUFFER...SKIP ERROR RETURN
3963 GTGBUF: HRRZ    A,BUFSTR-1(B)   ; GET LENGTH OF STRING
3964         SOJGE   A,GTGCHR        ; JUMP IF STILL MORE
3965
3966 ; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS)
3967 ; GENERATE AN .IOT POINTER
3968 ;FIRST SAVE C AND D AS I WILL CLOBBER THEM
3969 NEWBUF: PUSH    P,C
3970         PUSH    P,D
3971 IFN ITS,[
3972         LDB     C,[600,,STATUS(B)]      ; GET TYPE
3973         CAIG    C,2             ; SKIP IF NOT TTY
3974 ]
3975 IFE ITS,[
3976         SKIPE   BUFRIN(B)
3977 ]
3978         JRST    GETTTY          ; GET A TTY BUFFER
3979
3980         PUSHJ   P,PGBUFI        ; RE-FILL BUFFER
3981
3982 IFE ITS,        MOVEI   C,-1
3983         JUMPGE  A,BUFGOO        ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL
3984         MOVEI   C,1             ; MAKE SURE LAST EOF REALLY ENDS IT
3985         ANDCAM  C,-1(A)
3986         MOVSI   C,014000        ; GET A ^C
3987         MOVEM   C,(A)           ;FAKE AN EOF
3988
3989 IFE ITS,[
3990         HLRE    C,A             ; HOW MUCH LEFT
3991         ADDI    C,BUFLNT        ; # OF WORDS TO C
3992         IMULI   C,5             ; TO CHARS
3993         MOVE    A,-2(B)         ; GET BITS
3994         TRNE    A,C.BIN         ; CAN'T HELP A BINARY CHANNEL
3995         JRST    BUFGOO
3996         MOVE    A,CHANNO(B)
3997         PUSH    P,B
3998         PUSH    P,D
3999         PUSH    P,C
4000         PUSH    P,[0]
4001         PUSH    P,[0]
4002         MOVEI   C,-1(P)
4003         MOVE    B,[2,,11]       ; READ WORD CONTAINING BYTE SIZE
4004         GTFDB
4005         LDB     D,[300600,,-1(P)]       ; GET BYTE SIZE
4006         MOVE    B,(P)
4007         SUB     P,[2,,2]
4008         POP     P,C
4009         CAIE    D,7             ; SEVEN BIT BYTES?
4010         JRST    BUFGO1          ; NO, DONT HACK
4011         MOVE    D,C
4012         IDIVI   B,5             ; C IS NUMBER IN LAST WORD IF NOT EVEN
4013         SKIPN   C
4014         MOVEI   C,5
4015         ADDI    C,-5(D)         ; FIXUP C FOR WINNAGE
4016 BUFGO1: POP     P,D
4017         POP     P,B
4018 ]
4019 ; RESET THE BYTE POINTER IN THE CHANNEL.
4020 ; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D
4021 BUFGOO: HRLI    D,010700        ; GENERATE VIRGIN LH
4022         SUBI    D,1
4023
4024         MOVEM   D,BUFSTR(B)     ; STASH IN THE BUFFER BYTE PNTR SLOT
4025 IFE ITS,        HRRM    C,LSTCH-1(B)    ; SAVE IT
4026         MOVEI   A,BUFLNT*5-1
4027 BUFROK: POP     P,D             ;RESTORE D
4028         POP     P,C             ;RESTORE C
4029
4030
4031 ; HERE IF THERE ARE CHARS IN BUFFER
4032 GTGCHR: HRRM    A,BUFSTR-1(B)
4033         ILDB    A,BUFSTR(B)     ; GET A CHAR FROM BUFFER
4034
4035 IFN ITS,[
4036         CAIE    A,3             ; EOF?
4037         POPJ    P,              ; AND RETURN
4038         LDB     A,[600,,STATUS(B)]      ; CHECK FOR TTY
4039         CAILE   A,2             ; SKIP IF TTY
4040 ]
4041 IFE ITS,[
4042         PUSH    P,0
4043         HRRZ    0,LSTCH-1(B)
4044         SOJL    0,.+4
4045         HRRM    0,LSTCH-1(B)
4046         POP     P,0
4047         POPJ    P,
4048
4049         POP     P,0
4050         MOVSI   A,-1
4051         SKIPN   BUFRIN(B)
4052 ]
4053         JRST    .+3
4054 RETEO1: HRRI    A,3
4055         POPJ    P,
4056
4057         HRRZ    A,BUFSTR(B)     ; SEE IF RSUBR START BIT IS ON
4058         HRRZ    A,(A)
4059         TRNN    A,1
4060         MOVSI   A,-1
4061         JRST    RETEO1
4062
4063 IFN ITS,[
4064 PGBUFO:
4065 PGBUFI:
4066 ]
4067 IFE ITS,[
4068 PGBUFO: SKIPA   D,[SOUT]
4069 PGBUFI: MOVE    D,[SIN]
4070 ]
4071         SKIPGE  A,BUFSTR(B)     ; POINT TO CURRENT BUFFER POSIT
4072         SUBI    A,1             ; FOR 440700 AND 010700 START
4073         SUBI    A,BUFLNT-1      ; CALCULATE PNTR TO BEG OF BUFFER
4074         HRLI    A,-BUFLNT       ; IOT (AOBJN) PNTR IN A
4075         MOVSI   C,004400
4076 IFN ITS,[
4077 PGBIOO:
4078 PGBIOI: MOVE    D,A             ; COPY FOR LATER
4079         MOVSI   C,TUVEC         ; PREPARE TO HANDDLE INTS
4080         MOVE    PVP,PVSTOR+1
4081         MOVEM   C,DSTO(PVP)
4082         MOVEM   C,ASTO(PVP)
4083         MOVSI   C,TCHAN
4084         MOVEM   C,BSTO(PVP)
4085
4086 ; BUILD .IOT INSTR
4087         MOVE    C,CHANNO(B)     ; CHANNEL NUMBER IN C
4088         ROT     C,23.           ; MOVE INTO AC FIELD
4089         IOR     C,[.IOT 0,A]    ; IOR IN SKELETON .IOT
4090
4091 ; DO THE .IOT
4092         ENABLE                  ; ALLOW INTS
4093         XCT     C               ; EXECUTE THE .IOT INSTR
4094         DISABLE
4095         MOVE    PVP,PVSTOR+1
4096         SETZM   BSTO(PVP)
4097         SETZM   ASTO(PVP)
4098         SETZM   DSTO(PVP)
4099         POPJ    P,
4100 ]
4101
4102 IFE ITS,[
4103 PGBIOT: PUSH    P,D
4104         PUSH    TP,$TCHAN
4105         PUSH    TP,B
4106         PUSH    P,C
4107         HRRZS   (P)
4108         HRRI    C,-1(A)         ; POINT TO BUFFER
4109         HLRE    D,A             ; XTRA POINTER
4110         MOVNS   D
4111         HRLI    D,TCHSTR
4112         MOVE    PVP,PVSTOR+1
4113         MOVEM   D,BSTO(PVP)
4114         MOVE    D,[PUSHJ P,FIXACS]
4115         MOVEM   D,ONINT
4116         MOVSI   D,TUVEC
4117         MOVEM   D,DSTO(PVP)
4118         MOVE    D,A
4119         MOVE    A,CHANNO(B)     ; FILE JFN
4120         MOVE    B,C
4121         HLRE    C,D             ; - COUNT TO C
4122         SKIPE   (P)
4123          MOVN   C,(P)           ; REAL DESIRED COUNT
4124         SUB     P,[1,,1]
4125         ENABLE
4126         XCT     (P)             ; DO IT TO IT
4127         DISABLE
4128         MOVE    PVP,PVSTOR+1
4129         SETZM   BSTO(PVP)
4130         SETZM   DSTO(PVP)
4131         SETZM   ONINT
4132         MOVEI   A,1(B)
4133         MOVE    B,(TP)
4134         SUB     TP,[2,,2]
4135         SUB     P,[1,,1]
4136         JUMPGE  C,CPOPJ         ; NO EOF YET
4137         HRLI    A,(C)           ; LOOK LIKE AN AOBJN PNTR
4138         POPJ    P,
4139
4140 FIXACS: PUSH    P,PVP
4141         MOVE    PVP,PVSTOR+1
4142         MOVNS   C
4143         HRRM    C,BSTO(PVP)
4144         MOVNS   C
4145         POP     P,PVP
4146         POPJ    P,
4147
4148 PGBIOO: SKIPA   D,[SOUT]
4149 PGBIOI: MOVE    D,[SIN]
4150         HRLI    C,004400
4151         JRST    PGBIOT
4152 DOIOTO: PUSH    P,[SOUT]
4153 DOIOTC: PUSH    P,B
4154         PUSH    P,C
4155         EXCH    A,B
4156         MOVE    A,CHANNO(A)
4157         HLRE    C,B
4158         HRLI    B,444400
4159         XCT     -2(P)
4160         HRL     B,C
4161         MOVE    A,B
4162 DOIOTE: POP     P,C
4163         POP     P,B
4164         SUB     P,[1,,1]
4165         POPJ    P,
4166 DOIOTI: PUSH    P,[SIN]
4167         JRST    DOIOTC
4168 ]
4169 \f
4170 ; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE
4171
4172 PUTCHR: PUSH    P,A
4173         GETYP   A,BUFSTR-1(B)   ; CHECK TYPE OF ARG
4174         CAIE    A,TCHSTR        ; MUST BE STRING
4175         JRST    BDCHAN
4176
4177         HRRZ    A,BUFSTR-1(B)   ; GET CHAR COUNT
4178         JUMPE   A,REBUFF        ; PREV RESET BUFF, UNDO SAME
4179
4180 PUTCH1: POP     P,A             ; RESTORE CHAR
4181         CAMN    A,[-1]          ; SPECIAL HACK?
4182         JRST    PUTCH2          ; YES GO HANDLE
4183         IDPB    A,BUFSTR(B)     ; STUFF IT
4184 PUTCH3: SOS     A,BUFSTR-1(B)   ; COUNT DOWN STRING
4185         TRNE    A,-1            ; SKIP IF FULL
4186         POPJ    P,
4187
4188 ; HERE TO FLUSH OUT A BUFFER
4189
4190         PUSH    P,C
4191         PUSH    P,D
4192         PUSHJ   P,PGBUFO        ; SETUP AND DO IOT
4193         HRLI    D,010700        ; POINT INTO BUFFER
4194         SUBI    D,1
4195         MOVEM   D,BUFSTR(B)     ; STORE IT
4196         MOVEI   A,BUFLNT*5      ; RESET  COUNT
4197         HRRM    A,BUFSTR-1(B)
4198         POP     P,D
4199         POP     P,C
4200         POPJ    P,
4201
4202 ;HERE TO DA ^C AND TURN ON MAGIC BIT
4203
4204 PUTCH2: MOVEI   A,3
4205         IDPB    A,BUFSTR(B)     ; ZAP OUT THE ^C
4206         MOVEI   A,1             ; GET BIT
4207 IFE ITS,[
4208         PUSH    P,C
4209         HRRZ    C,BUFSTR(B)
4210         IORM    A,(C)
4211         POP     P,C
4212 ]
4213 IFN ITS,[
4214         IORM    A,@BUFSTR(B)    ; ON GOES THE BIT
4215 ]
4216         JRST    PUTCH3
4217
4218 ; RESET A FUNNY BUF
4219
4220 REBUFF: MOVEI   A,BUFLNT*5              ; 1ST COUNT
4221         HRRM    A,BUFSTR-1(B)
4222         HRRZ    A,BUFSTR(B)             ; NOW POINTER
4223         SUBI    A,BUFLNT+1
4224         HRLI    A,010700
4225         MOVEM   A,BUFSTR(B)             ; STORE BACK
4226         JRST    PUTCH1
4227
4228
4229 ; HERE TO FLUSH FINAL BUFFER
4230
4231 BFCLOS: HRRZ    C,-2(B)         ; THIS BUFFER FLUSHER THE WORK OF NDR
4232         MOVEI   A,0
4233         TRNE    C,C.TTY
4234          POPJ   P,
4235         TRNE    C,C.DISK
4236          MOVEI  A,1
4237         PUSH    P,A             ; SAVE THE RESULT OF OUR TEST
4238         JUMPN   A,BFCLNN        ; DONT HAVE TO CHECK NET STATE
4239         PUSH    TP,$TCHAN
4240         PUSH    TP,B            ; SAVE CHANNEL
4241         PUSHJ   P,INSTAT        ; GET CURRENT NETWORK STATE
4242         MOVE    A,(B)           ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE
4243         POP     TP,B            ; RESTORE B
4244         POP     TP,
4245         CAIE    A,5             ; IS NET IN OPEN STATE?
4246         CAIN    A,6             ; OR ELSE IS IT IN RFNM WAIT STATE
4247         JRST    BFCLNN          ; IF SO TO THE IOT
4248         POP     P,              ; ELSE FLUSH CRUFT AND DONT IOT
4249         POPJ    P,              ; RETURN DOING NO IOT
4250 BFCLNN: MOVEI   C,BUFLNT*5      ; NEW BUFFER FLUSHER BY NDR
4251         HRRZ    D,BUFSTR-1(B)   ; SO THAT NET ALSO WORKS RIGHT
4252         SUBI    C,(D)           ; GET NUMBER OF CHARS
4253         IDIVI   C,5             ; NUMBER OF FULL WORDS AND REST
4254         PUSH    P,D             ; SAVE NUMBER OF ODD CHARS
4255         SKIPGE  A,BUFSTR(B)     ; GET CURRENT BUF POSITION
4256         SUBI    A,1             ; FIX FOR 440700 BYTE POINTER
4257 IFE ITS,[
4258         HRRO    D,A
4259         PUSH    P,(D)
4260 ]
4261 IFN ITS,[
4262         PUSH    P,(A)           ; SAVE THE ODD WORD OF BUFFER
4263 ]
4264         MOVEI   D,BUFLNT
4265         SUBI    D,(C)
4266         SKIPE   -1(P)
4267         SUBI    A,1
4268         ADDI    D,1(A)          ; FIX UP FOR POSSIBLE ODD CHARS
4269         PUSH    TP,$TUVEC
4270         PUSH    TP,D            ; PUSH THE DOPE VECTOR ONTO THE STACK
4271         JUMPE   C,BFCLSR        ; IN CASE THERE ARE NO FULL WORDS TO DO
4272         HRL     A,C
4273         TLO     A,400000
4274         MOVE    E,[SETZ BUFLNT(A)]
4275         SUBI    E,(C)   ; FIX UP FOR BACKWARDS BLT
4276         POP     A,@E            ; AMAZING GRACE
4277         TLNE    A,377777
4278         JRST    .-2
4279         HRRO    A,D             ; SET UP AOBJN POINTER
4280         SUBI    A,(C)
4281         TLC     A,-1(C)
4282         PUSHJ   P,PGBIOO        ; DO THE IOT OF ALL THE FULL WORDS
4283 BFCLSR: HRRO    A,(TP)          ; GET IOT PTR FOR REST OF JUNK
4284         SUBI    A,1             ; POINT TO WORD BEFORE DOPE WORDS
4285         POP     P,0             ; GET BACK ODD WORD
4286         POP     P,C             ; GET BACK ODD CHAR COUNT
4287         POP     P,D             ; FLAG FOR NET OR DSK
4288         JUMPN   D,BFCDSK        ; GO FINISH OFF DSK
4289         JUMPE   C,BFCLSD        ; IF NO ODD CHARS FINISH UP
4290         MOVEI   D,7
4291         IMULI   D,(C)           ; FIND NO OF BITS TO SHIFT
4292         LSH     0,-43(D)        ; SHIFT BITS TO RIGHT PLACE
4293         MOVEM   0,(A)   ; STORE IN STRING
4294         SUBI    C,5             ; HOW MANY CHAR POSITIONS TO SKIP
4295         MOVNI   C,(C)           ; MAKE C POSITIVE
4296         LSH     C,17
4297         TLC     A,(C)           ; MUNG THE AOBJN POINTER TO KLUDGE
4298         PUSHJ   P,PGBIOO        ; DO IOT OF ODD CHARS
4299         MOVEI   C,0
4300 BFCLSD: HRRZ    A,(TP)          ; GET PTR TO DOPE WORD
4301         SUBI    A,BUFLNT+1
4302         JUMPLE  C,.+3
4303         SKIPE   ACCESS(B)
4304         MOVEM   0,1(A)          ; LAST WORD BACK IN BFR
4305         HRLI    A,010700        ; AOBJN POINTER TO FIRST OF BUFFER
4306         MOVEM   A,BUFSTR(B)
4307         MOVEI   A,BUFLNT*5
4308         HRRM    A,BUFSTR-1(B)
4309         SKIPN   ACCESS(B)
4310          JRST   BFCLSY
4311         JUMPL   C,BFCLSY
4312         JUMPE   C,BFCLSZ
4313         IBP     BUFSTR(B)
4314         SOS     BUFSTR-1(B)
4315         SOJG    C,.-2
4316 BFCLSY: MOVE    A,CHANNO(B)
4317         MOVE    C,B
4318 IFE ITS,[
4319         RFPTR
4320         FATAL RFPTR FAILED
4321         HRRZ    F,LSTCH-1(C)    ; PREVIOUS HIGH
4322         MOVE    G,C             ; SAVE CHANNEL
4323         MOVE    C,B
4324         CAML    F,B
4325          MOVE   C,F
4326         MOVE    F,B
4327         HRLI    A,400000
4328         CLOSF
4329         JFCL
4330         MOVNI   B,1
4331         HRLI    A,12
4332         CHFDB
4333         MOVE    B,STATUS(G)
4334         ANDI    A,-1
4335         OPENF
4336         FATAL OPENF LOSES
4337         MOVE    C,F
4338         IDIVI   C,5
4339         MOVE    B,C
4340         SFPTR
4341         FATAL SFPTR FAILED
4342         MOVE    B,G
4343 ]
4344 IFN ITS,[
4345         DOTCAL  RFPNTR,[A,[2000,,B]]
4346          .LOSE  %LSFIL          ;PRESUMABLY LOSSAGE MATTERS
4347         SUBI    B,1
4348         DOTCAL  ACCESS,[A,B]
4349          .LOSE  %LSFIL          ;PRESUMABLY LOSSAGE MATTERS
4350         MOVE    B,C
4351 ]
4352 BFCLSZ: SUB     TP,[2,,2]
4353         POPJ    P,
4354
4355 BFCDSK: TRZ     0,1
4356         PUSH    P,C
4357 IFE ITS,[
4358         PUSH    TP,$TCHAN
4359         PUSH    TP,B
4360         PUSH    P,0             ; WORD OF CHARS
4361         MOVE    A,CHANNO(B)
4362         MOVEI   B,7             ; MAKE BYTE SIZE 7
4363         SFBSZ
4364         JFCL
4365         HRROI   B,(P)
4366         MOVNS   C
4367         SKIPE   C
4368         SOUT
4369         MOVE    B,(TP)
4370         SUB     P,[1,,1]
4371         SUB     TP,[2,,2]
4372 ]
4373 IFN ITS,[
4374         MOVE    D,[440700,,A]
4375         DOTCAL  SIOT,[CHANNO(B),D,C]
4376          .LOSE  %LSFIL          ;PRESUMABLY LOSSAGE MATTERS
4377 ]
4378         POP     P,C
4379         JUMPN   C,BFCLSD
4380 BFCDS1: MOVNI   C,1             ; INDICATE NOT TOHACK BUFFER
4381         JRST    BFCLSD
4382
4383 BFCLS1: HRRZ    C,DIRECT-1(B)
4384         MOVSI   0,(JFCL)
4385         CAIE    C,6
4386         MOVE    0,[AOS ACCESS(B)]
4387         PUSH    P,0
4388         HRRZ    C,BUFSTR-1(B)
4389         IDIVI   C,5
4390         JUMPE   D,BCLS11
4391         MOVEI   A,40            ; PAD WITH SPACES
4392         PUSHJ   P,PUTCHR
4393         XCT     (P)             ; AOS ACCESS IF NECESSARY
4394         SOJG    D,.-3           ; TO END OF WORD\r
4395 BCLS11: POP     P,0
4396         HLLZS   ACCESS-1(B)
4397         HRRZ    C,BUFSTR-1(B)
4398         CAIE    C,BUFLNT*5
4399         PUSHJ   P,BFCLOS
4400         POPJ    P,
4401
4402 \f
4403 ; HERE TO GET A TTY BUFFER
4404
4405 GETTTY: SKIPN   C,EXBUFR(B)     ; SKIP IF BUFFERS BACKED UP
4406         JRST    TTYWAI
4407         HRRZ    D,(C)           ; CDR THE LIST
4408         GETYP   A,(C)           ; CHECK TYPE
4409         CAIE    A,TDEFER        ; MUST BE DEFERRED
4410         JRST    BDCHAN
4411         MOVE    C,1(C)          ; GET DEFERRED GOODIE
4412         GETYP   A,(C)           ; BETTER BE CHSTR
4413         CAIE    A,TCHSTR
4414         JRST    BDCHAN
4415         MOVE    A,(C)           ; GET FULL TYPE WORD
4416         MOVE    C,1(C)
4417         MOVEM   D,EXBUFR(B)     ; STORE CDR'D LIST
4418         MOVEM   A,BUFSTR-1(B)   ; MAKE CURRENT BUFFER
4419         MOVEM   C,BUFSTR(B)
4420         HRRM    A,LSTCH-1(B)
4421         SOJA    A,BUFROK
4422
4423 TTYWAI: PUSHJ   P,TTYBLK        ; BLOCKED FOR TTY I/O
4424         JRST    GETTTY          ; SHOULD ONLY RETURN HAPPILY
4425
4426 \f;INTERNAL DEVICE READ ROUTINE.
4427
4428 ;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,
4429 ;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER,
4430 ;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE"
4431
4432 ;H. BRODIE 8/31/72
4433
4434 GTINTC: PUSH    TP,$TCHAN       ;SAVE THE CHANNEL...WE'LL CLOBBER B
4435         PUSH    TP,B
4436         PUSH    P,C     ;AND SAVE THE OTHER ACS
4437         PUSH    P,D
4438         PUSH    P,E
4439         PUSH    P,0
4440         PUSH    TP,INTFCN-1(B)
4441         PUSH    TP,INTFCN(B)
4442         MCALL   1,APPLY
4443         GETYP   A,A
4444         CAIE    A,TCHRS
4445         JRST    BADRET
4446         MOVE    A,B
4447 INTRET: POP     P,0             ;RESTORE THE ACS
4448         POP     P,E
4449         POP     P,D
4450         POP     P,C
4451         POP     TP,B            ;RESTORE THE CHANNEL
4452         SUB     TP,[1,,1]       ;FLUSH $TCHAN...WE DON'T NEED IT
4453         POPJ    P,
4454
4455
4456 BADRET: ERRUUO  EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT
4457
4458 ;INTERNAL DEVICE PRINT ROUTINE.
4459
4460 ;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR)
4461 ;TO THE CURRENT CHARACTER BEING "PRINTED".
4462
4463 PTINTC: PUSH    TP,$TCHAN       ;SAVE THE CHANNEL...WE'LL CLOBBER B
4464         PUSH    TP,B
4465         PUSH    P,C     ;AND SAVE THE OTHER ACS
4466         PUSH    P,D
4467         PUSH    P,E
4468         PUSH    P,0
4469         PUSH    TP,INTFCN-1(B)  ;PUSH TYPE OF GIVEN OBJ
4470         PUSH    TP,INTFCN(B)    ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.)
4471         PUSH    TP,$TCHRS       ;PUSH THE TYPE "CHARACTER"
4472         PUSH    TP,A            ;PUSH THE CHAR
4473         MCALL   2,APPLY         ;APPLY THE FUNCTION TO THE CHAR
4474         JRST    INTRET
4475
4476
4477 \f
4478 ; ROUTINE TO FLUSH OUT A PRINT BUFFER
4479
4480 MFUNCTION BUFOUT,SUBR
4481
4482         ENTRY   1
4483
4484         GETYP   0,(AB)
4485         CAIE    0,TCHAN
4486         JRST    WTYP1
4487
4488         MOVE    B,1(AB)
4489 ;       MOVEI   B,DIRECT-1(B)
4490 ;       PUSHJ   P,CHRWRD        ; GET DIR NAME
4491 ;       JFCL
4492 ;       CAMN    B,[ASCII /PRINT/]
4493 ;       JRST    .+3
4494 ;       CAME    B,[<ASCII /PRINT/>+1]
4495 ;       JRST    WRONGD
4496 ;       TRNE    B,1             ; SKIP IF PRINT
4497 ;       PUSH    P,[JFCL]
4498 ;       TRNN    B,1             ; SKIP IF PRINTB
4499 ;       PUSH    P,[AOS ACCESS(B)]
4500         HRRZ    0,-2(B)
4501         TRNN    0,C.PRIN
4502          JRST   WRONGD
4503 ;       TRNE    0,C.BIN         ; SKIP IF PRINT
4504 ;        PUSH   P,[JFCL]
4505 ;       TRNN    0,C.BIN         ; SKIP IF PRINTB
4506 ;        PUSH   P,[AOS ACCESS(B)]
4507 ;       MOVE    B,1(AB)
4508 ;       GETYP   0,BUFSTR-1(B)
4509 ;       CAIN    0,TCHSTR
4510 ;       SKIPN   A,BUFSTR(B)             ; BYTE POINTER?
4511 ;       JRST    BFIN1
4512 ;       HRRZ    C,BUFSTR-1(B)   ; CHARS LEFT
4513 ;       IDIVI   C,5             ; MULTIPLE OF 5?
4514 ;       JUMPE   D,BFIN2         ; YUP NO EXTRAS
4515
4516 ;       MOVEI   A,40            ; PAD WITH SPACES
4517 ;       PUSHJ   P,PUTCHR        ; OUT IT GOES
4518 ;       XCT     (P)             ; MAYBE BUMP ACCESS
4519 ;       SOJG    D,.-3           ; FILL
4520
4521 BFIN2:  PUSHJ   P,BFCLOS        ; WRITE OUT BUFFER
4522
4523 BFIN1:  MOVSI   A,TCHAN
4524         JRST    FINIS
4525
4526
4527
4528 ; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL
4529
4530 MFUNCTION FILLNT,SUBR,[FILE-LENGTH]
4531         ENTRY   1
4532
4533         GETYP   0,(AB)
4534         CAIE    0,TCHAN
4535         JRST    WTYP1
4536         MOVE    B,1(AB)
4537         PUSHJ   P,CFILLE
4538         JRST    FINIS
4539
4540 CFILLE:
4541 IFN 0,[
4542         MOVEI   B,DIRECT-1(B)   ; GET CHANNEL TYPE
4543         PUSHJ   P,CHRWRD
4544         JFCL
4545         CAME    B,[ASCIZ /READ/]
4546         JRST    .+3
4547         PUSH    P,[5]           ; MULTIPLICATIVE FACTOR FOR READ
4548         JRST    .+4
4549         CAME    B,[ASCII /READB/]
4550         JRST    WRONGD
4551         PUSH    P,[1]           ; MULTIPLICATIVE FACTOR FOR READ
4552 ]
4553         MOVE    C,-2(B)         ; GET BITS
4554         MOVEI   D,5             ; ASSUME ASCII
4555         TRNE    C,C.BIN         ; SKIP IF NOT BINARY
4556         MOVEI   D,1
4557         PUSH    P,D
4558         MOVE    C,B
4559 IFN ITS,[
4560         .CALL   FILL1
4561         JRST    FILLOS          ; GIVE HIM A NICE FALSE
4562 ]
4563 IFE ITS,[
4564         MOVE    A,CHANNO(C)
4565         PUSH    P,[0]
4566         MOVEI   C,(P)
4567         MOVE    B,[1,,11]       ; READ WORD CONTAINING BYTE SIZE
4568         GTFDB
4569         LDB     D,[300600,,(P)] ; GET BYTE SIZE
4570         JUMPN   D,.+2
4571          MOVEI  D,36.           ; HANDLE "0" BYTE SIZE
4572         SUB     P,[1,,1]
4573         SIZEF
4574         JRST    FILLOS
4575 ]
4576         POP     P,C
4577 IFN ITS,        IMUL    B,C
4578 IFE ITS,[
4579         CAIN    C,5
4580         CAIE    D,7
4581         JRST    NOTASC
4582 ]
4583 YESASC: MOVE    A,$TFIX
4584         POPJ    P,
4585
4586 IFE ITS,[
4587 NOTASC: MOVEI   0,36.
4588         IDIV    0,D             ; BYTES PER WORD
4589         IDIVM   B,0
4590         IMUL    C,0
4591         MOVE    B,C
4592         JRST    YESASC
4593 ]
4594
4595 IFN ITS,[
4596 FILL1:  SETZ                    ; BLOCK FOR .CALL TO FILLEN
4597         SIXBIT /FILLEN/
4598         CHANNO  (C)
4599         SETZM   B
4600
4601 FILLOS: MOVE    A,CHANNO(C)
4602         MOVE    B,[.STATUS A]           ;MAKE A CALL TO STATUS TO FIND REASON
4603         LSH     A,23.                   ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE
4604         IOR     B,A                     ;FIX UP .STATUS
4605         XCT     B
4606         MOVE    B,C
4607         PUSHJ   P,GFALS
4608         POP     P,
4609         POPJ    P,
4610 ]
4611 IFE ITS,[
4612 FILLOS: MOVE    B,C
4613         PUSHJ   P,TGFALS
4614         POP     P,
4615         POPJ    P,
4616 ]
4617
4618
4619 \f; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS
4620
4621 ;CALLING ROUTINE:       AC-A contains pointer to block of SIXBIT data
4622 ;                       DIR ? DEV ? FNM1 ? FNM2 ? SNM
4623 ;RETURNED VALUE :       AC-A = <channel #, or -1 if no channel available>
4624 IFN ITS,[
4625 MOPEN:  PUSH    P,B
4626         PUSH    P,C
4627         MOVE    C,FRSTCH        ; skip gc and tty channels
4628 CNLP:   DOTCAL  STATUS,[C,[2000,,B]]
4629          .LOSE  %LSFIL
4630         ANDI    B,77
4631         JUMPE   B,CHNFND        ; found unused channel ?
4632         ADDI    C,1             ; try another channel
4633         CAIG    C,17            ; are all the channels used ?
4634          JRST   CNLP
4635         SETO    C,              ; all channels used so C = -1
4636         JRST    CHNFUL
4637 CHNFND: MOVEI   B,(C)
4638         HLL     B,(A)           ; M.DIR slot
4639         DOTCAL  OPEN,[B,1(A),2(A),3(A),4(A)]
4640          SKIPA
4641         AOS     -2(P)           ; successful  skip when returning
4642 CHNFUL: MOVE    A,C
4643         POP     P,C
4644         POP     P,B
4645         POPJ    P,
4646
4647 MIOT:   DOTCAL  IOT,[A,B]
4648          JFCL
4649         POPJ    P,
4650
4651 MCLOSE: DOTCAL  CLOSE,[A]
4652          JFCL
4653         POPJ    P,
4654
4655 IMPURE
4656
4657 FRSTCH: 1
4658
4659 PURE
4660 ]
4661 \f;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O
4662
4663 NOTNET:
4664 BADCHN: ERRUUO  EQUOTE BAD-CHANNEL
4665 BDCHAN: ERRUUO  EQUOTE BAD-INPUT-BUFFER
4666
4667 WRONGD: ERRUUO  EQUOTE WRONG-DIRECTION-CHANNEL
4668
4669 CHNCLS: ERRUUO  EQUOTE CHANNEL-CLOSED
4670
4671 BAD6:   ERRUUO  EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME
4672
4673 DISLOS: MOVE    C,$TCHSTR
4674         MOVE    D,CHQUOTE [DISPLAY NOT AVAILABLE]
4675         PUSHJ   P,INCONS
4676         MOVSI   A,TFALSE
4677         JRST    OPNRET
4678
4679 NOCHAN: ERRUUO  EQUOTE ITS-CHANNELS-EXHAUSTED
4680
4681 MODE1:  232020,,202020
4682 MODE2:  232023,,330320
4683
4684 END
4685
4686 \f