<mdl.int>/fopen.mid.60

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