<mdl.int>/fopen.mid.62

   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         PUSH    P,C
3426         PUSHJ   P,PGBIOO
3427         POP     P,C
3428         JUMPE   C,.+3
3429         HLRE    C,1(AB)
3430         MOVNS   C
3431         ADDM    C,ACCESS(B)
3432 BYTO1:  MOVE    A,(AB)          ; RET VECTOR ETC.
3433         MOVE    B,1(AB)
3434         JRST    FINIS
3435
3436 BYTO:
3437 IFE ITS,[
3438         MOVE    A,1(B)
3439         RFBSZ
3440         FATAL RFBSZ-FAILURE
3441         PUSH    P,B
3442         LDB     B,[300600,,1(AB)]
3443         SFBSZ
3444         FATAL SFBSZ-FAILURE
3445         MOVE    B,3(AB)
3446         HRRZ    A,(AB)          ; GET BYTE SIZE
3447         MOVNS   A
3448         MOVSS   A               ; MAKE FUNNY BYTE POINTER
3449         HRR     A,1(AB)
3450         ADDI    A,1             ; COMPENSATE FOR PGBIOT DOING THE WRONG THING
3451         HLL     C,1(AB)         ; GET START OF BPTR
3452         MOVE    D,[SOUT]
3453         PUSHJ   P,PGBIOT
3454         LDB     D,[300600,,1(AB)]
3455         MOVEI   C,36.
3456         IDIVM   C,D
3457         HRRZ    C,(AB)
3458         IDIVI   C,(D)
3459         ADDM    C,ACCESS(B)
3460         MOVE    A,1(B)
3461         POP     P,B
3462         SFBSZ
3463         FATAL SFBSZ-FAILURE
3464         JRST    BYTO1
3465 ]
3466
3467 BINEOF: PUSH    TP,EOFCND-1(B)
3468         PUSH    TP,EOFCND(B)
3469         PUSH    TP,$TCHAN
3470         PUSH    TP,B
3471         MCALL   1,FCLOSE        ; CLOSE THE LOSER
3472         MCALL   1,EVAL
3473         JRST    FINIS
3474
3475 OPENIT: PUSH    P,E
3476         PUSHJ   P,OPNCHN        ;TRY TO OPEN THE LOSER
3477         JUMPE   B,CHNCLS        ;FAIL
3478         POP     P,E
3479         POPJ    P,
3480 \f; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE
3481 ; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF
3482 ; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS.
3483
3484 R1CHAR: SKIPN   A,LSTCH(B)              ; CHAR READING ROUTINE FOR FCOPY
3485         PUSHJ   P,RXCT
3486         TLO     A,200000                ; ^@ BUG
3487         MOVEM   A,LSTCH(B)
3488         TLZ     A,200000
3489         JUMPL   A,.+2                   ; IN CASE OF -1 ON STY
3490         TRZN    A,400000                ; EXCL HACKER
3491         JRST    .+4
3492         MOVEM   A,LSTCH(B)              ; SAVE DE-EXCLED CHAR
3493         MOVEI   A,"!
3494         JRST    .+2
3495         SETZM   LSTCH(B)
3496         PUSH    P,C
3497         HRRZ    C,DIRECT-1(B)
3498         CAIE    C,5                     ; IF DIRECTION IS 5 LONG THEN READB
3499         JRST    R1CH1
3500         AOS     C,ACCESS-1(B)
3501         CAMN    C,[TFIX,,1]
3502         AOS     ACCESS(B)               ; EVERY FIFTY INCREMENT
3503         CAMN    C,[TFIX,,5]
3504         HLLZS   ACCESS-1(B)
3505         JRST    .+2
3506 R1CH1:  AOS     ACCESS(B)
3507         POP     P,C
3508         POPJ    P,
3509
3510 W1CHAR: CAIE    A,15            ; CHAR WRITING ROUTINE, TEST FOR CR
3511         JRST    .+3
3512         SETOM   CHRPOS(B)
3513         AOSA    LINPOS(B)
3514         CAIE    A,12                    ; TEST FOR LF
3515         AOS     CHRPOS(B)               ; IF NOT LF AOS CHARACTE5R POSITION
3516         CAIE    A,14                    ; TEST FOR FORM FEED
3517         JRST    .+3
3518         SETZM   CHRPOS(B)               ; IF FORM FEED ZERO CHARACTER POSITION
3519         SETZM   LINPOS(B)               ; AND LINE POSITION
3520         CAIE    A,11                    ; IS THIS A TAB?
3521         JRST    .+6
3522         MOVE    C,CHRPOS(B)
3523         ADDI    C,7
3524         IDIVI   C,8.
3525         IMULI   C,8.                    ; FIX UP CHAR POS FOR TAB
3526         MOVEM   C,CHRPOS(B)             ; AND SAVE
3527         PUSH    P,C
3528         HRRZ    C,-2(B)                 ; GET BITS
3529         TRNN    C,C.BIN                 ; SIX LONG MUST BE PRINTB
3530         JRST    W1CH1
3531         AOS     C,ACCESS-1(B)
3532         CAMN    C,[TFIX,,1]
3533         AOS     ACCESS(B)
3534         CAMN    C,[TFIX,,5]
3535         HLLZS   ACCESS-1(B)
3536         JRST    .+2
3537 W1CH1:  AOS     ACCESS(B)
3538         PUSH    P,A
3539         PUSHJ   P,WXCT
3540         POP     P,A
3541         POP     P,C
3542         POPJ    P,
3543
3544 R1C:    SUBM    M,(P)                   ;LITTLE ENTRY FOR COMPILED STUFF
3545 ;       PUSH    TP,$TCHAN               ;SAVE THE CHANNEL TO BLESS IT
3546 ;       PUSH    TP,B
3547 ;       MOVEI   B,DIRECT-1(B)
3548 ;       PUSHJ   P,CHRWRD
3549 ;       JFCL
3550 ;       CAME    B,[ASCIZ /READ/]
3551 ;       CAMN    B,[ASCII /READB/]
3552 ;       JRST    .+2
3553 ;       JRST    BADCHN
3554         HRRZ    A,-2(B)                 ; GET MODE BITS
3555         TRNN    A,C.READ
3556          JRST   BADCHN
3557         SKIPN   IOINS(B)                ; IS THE CHANNEL OPEN
3558         PUSHJ   P,OPENIT                ; NO, GO DO IT
3559         PUSHJ   P,GRB                   ; MAKE SURE WE HAVE A READ BUFFER
3560         PUSHJ   P,R1CHAR                ; AND GET HIM A CHARACTER
3561         JRST    MPOPJ                   ; THATS ALL FOLKS
3562
3563 W1C:    SUBM    M,(P)
3564         PUSHJ   P,W1CI
3565         JRST    MPOPJ
3566
3567 W1CI:
3568 ;       PUSH    TP,$TCHAN
3569 ;       PUSH    TP,B
3570         PUSH    P,A                     ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR
3571 ;       MOVEI   B,DIRECT-1(B)
3572 ;       PUSHJ   P,CHRWRD                ; INTERNAL CALL TO W1CHAR
3573 ;       JFCL
3574 ;       CAME    B,[ASCII /PRINT/]
3575 ;       CAMN    B,[<ASCII /PRINT/>+1]
3576 ;       JRST    .+2
3577 ;       JRST    BADCHN
3578 ;       POP     TP,B
3579 ;       POP     TP,(TP)
3580         HRRZ    A,-2(B)
3581         TRNN    A,C.PRIN
3582          JRST   BADCHN
3583         SKIPN   IOINS(B)                ; MAKE SURE THAT IT IS OPEN
3584         PUSHJ   P,OPENIT
3585         PUSHJ   P,GWB
3586         POP     P,A                     ; GET THE CHAR TO DO
3587         JRST    W1CHAR
3588
3589 ; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT
3590 ; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH.
3591
3592
3593 WXCT:
3594 RXCT:   XCT     IOINS(B)                ; READ IT
3595         SKIPN   SCRPTO(B)
3596         POPJ    P,
3597
3598 DOSCPT: PUSH    TP,$TCHAN
3599         PUSH    TP,B
3600         PUSH    P,A                     ; AND SAVE THE CHAR AROUND
3601
3602         SKIPN   SCRPTO(B)               ; IF ZERO FORGET IT
3603         JRST    SCPTDN                  ; THATS ALL THERE IS TO IT
3604         PUSH    P,C                     ; SAVE AN ACCUMULATOR FOR CLEANLINESS
3605         GETYP   C,SCRPTO-1(B)           ; IS IT A LIST
3606         CAIE    C,TLIST
3607         JRST    BADCHN
3608         PUSH    TP,$TLIST
3609         PUSH    TP,[0]          ; SAVE A SLOT FOR THE LIST
3610         MOVE    C,SCRPTO(B)             ; GET THE LIST OF SCRIPT CHANNELS
3611 SCPT1:  GETYP   B,(C)                   ; GET THE TYPE OF THIS SCRIPT CHAN
3612         CAIE    B,TCHAN
3613         JRST    BADCHN                  ; IF IT ISN'T A CHANNEL, COMPLAIN
3614         HRRZ    B,(C)                   ; GET THE REST OF THE LIST IN B
3615         MOVEM   B,(TP)                  ; AND STORE ON STACK
3616         MOVE    B,1(C)                  ; GET THE CHANNEL IN B
3617         MOVE    A,-1(P)                 ; AND THE CHARACTER IN A
3618         PUSHJ   P,W1CI          ; GO TO INTERNAL W1C, IT BLESSES GOODIES
3619         SKIPE   C,(TP)                  ; GET THE REST OF LIST OF CHANS
3620         JRST    SCPT1                   ; AND CYCLE THROUGH
3621         SUB     TP,[2,,2]               ; CLEAN OFF THE LIST OF CHANS
3622         POP     P,C                     ; AND RESTORE ACCUMULATOR C
3623 SCPTDN: POP     P,A                     ; RESTORE THE CHARACTER
3624         POP     TP,B                    ; AND THE ORIGINAL CHANNEL
3625         POP     TP,(TP)
3626         POPJ    P,                      ; AND THATS ALL
3627
3628
3629 ; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT
3630 ; ON THE INPUT CHANNEL
3631 ; CALL IS <FILECOPY IN OUT> WHERE DEFAULTS ARE INCHAN AND OUTCHAN
3632
3633         MFUNCTION       FCOPY,SUBR,[FILECOPY]
3634
3635         ENTRY
3636         HLRE    0,AB
3637         CAMGE   0,[-4]
3638         JRST    WNA                     ; TAKES FROM 0 TO 2 ARGS
3639
3640         JUMPE   0,.+4                   ; NO FIRST ARG?
3641         PUSH    TP,(AB)
3642         PUSH    TP,1(AB)                ; SAVE IN CHAN
3643         JRST    .+6
3644         MOVE    A,$TATOM
3645         MOVE    B,IMQUOTE INCHAN
3646         PUSHJ   P,IDVAL
3647         PUSH    TP,A
3648         PUSH    TP,B
3649         HLRE    0,AB                    ; CHECK FOR SECOND ARG
3650         CAML    0,[-2]                  ; WAS THERE MORE THAN ONE ARG?
3651         JRST    .+4
3652         PUSH    TP,2(AB)                ; SAVE SECOND ARG
3653         PUSH    TP,3(AB)
3654         JRST    .+6
3655         MOVE    A,$TATOM                ; LOOK UP OUTCHAN AS DEFAULT
3656         MOVE    B,IMQUOTE OUTCHAN
3657         PUSHJ   P,IDVAL
3658         PUSH    TP,A
3659         PUSH    TP,B                    ; AND SAVE IT
3660
3661         MOVE    A,-3(TP)
3662         MOVE    B,-2(TP)                ; INPUT CHANNEL
3663         MOVEI   0,C.READ                        ; INDICATE INPUT
3664         PUSHJ   P,CHKCHN                ; CHECK FOR GOOD CHANNEL
3665         MOVE    A,-1(TP)
3666         MOVE    B,(TP)                  ; GET OUT CHAN
3667         MOVEI   0,C.PRIN                ; INDICATE OUT CHAN
3668         PUSHJ   P,CHKCHN                ; CHECK FOR GOOD OUT CHAN
3669
3670         PUSH    P,[0]                   ; COUNT OF CHARS OUTPUT
3671
3672         MOVE    B,-2(TP)
3673         PUSHJ   P,GRB                   ; MAKE SURE WE HAVE READ BUFF
3674         MOVE    B,(TP)
3675         PUSHJ   P,GWB                   ; MAKE SURE WE HAVE WRITE BUFF
3676
3677 FCLOOP: INTGO
3678         MOVE    B,-2(TP)
3679         PUSHJ   P,R1CHAR                ; GET A CHAR
3680         JUMPL   A,FCDON                 ; IF A NEG NUMBER WE GOT EOF
3681         MOVE    B,(TP)                  ; GET OUT CHAN
3682         PUSHJ   P,W1CHAR                ; SPIT IT OUT
3683         AOS     (P)                     ; INCREMENT COUNT
3684         JRST    FCLOOP
3685
3686 FCDON:  SUB     TP,[2,,2]               ; POP OFF OUTCHAN
3687         MCALL   1,FCLOSE                ; CLOSE INCHAN
3688         MOVE    A,$TFIX
3689         POP     P,B                     ; GET CHAR COUNT TO RETURN
3690         JRST FINIS
3691
3692 CHKCHN: PUSH    P,0                     ; CHECK FOR GOOD TASTING CHANNEL
3693         PUSH    TP,A
3694         PUSH    TP,B
3695         GETYP   C,A
3696         CAIE    C,TCHAN
3697         JRST    CHKBDC                  ; GO COMPLAIN IN RIGHT WAY
3698 ;       MOVEI   B,DIRECT-1(B)
3699 ;       PUSHJ   P,CHRWRD
3700 ;       JRST    CHKBDC
3701 ;       MOVE    C,(P)                   ; GET CHAN DIRECT
3702         HRRZ    C,-2(B)                 ; MODE BITS
3703         TDNN    C,0
3704         JRST    CHKBDC
3705 ;       CAMN    B,CHKT(C)
3706 ;       JRST    .+4
3707 ;       ADDI    C,2                     ; TEST FOR READB OR PRINTB ALSO
3708 ;       CAME    B,CHKT(C)               ; TEST FOR CORRECT DIRECT
3709 ;       JRST    CHKBDC
3710         MOVE    B,(TP)
3711         SKIPN   IOINS(B)                ; MAKE SURE IT IS OPEN
3712         PUSHJ   P,OPENIT                ; IF ZERO IOINS GO OPEN IT
3713         SUB     TP,[2,,2]
3714         POP     P,                      ; CLEAN UP STACKS
3715         POPJ    P,
3716
3717 CHKT:   ASCIZ /READ/
3718         ASCII /PRINT/
3719         ASCII /READB/
3720         <ASCII /PRINT/>+1
3721
3722 CHKBDC: POP     P,E
3723         MOVNI   D,2
3724         IMULI   D,1(E)
3725         HLRE    0,AB
3726         CAMLE   0,D                     ; SEE IF THIS WAS HIS ARG OF DEFAULT
3727         JRST    BADCHN
3728         JUMPE   E,WTYP1
3729         JRST    WTYP2
3730
3731 \f; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB,
3732 ; THAT IS THEY READ INTO AND OUT OF STRINGS.  IN ADDITION BOTH ACCEPT
3733 ; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF
3734 ; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING.
3735
3736 ; FORMAT IS <READSTRING .STRING .INCHANNEL .EOFCOND .MAXCHARS>
3737 ; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN
3738
3739 ; FORMAT FOR PRINTSTRING IS <PRINTSTRING .STRING .OUTCHANNEL .MAXCHARS>
3740
3741 ; THESE WERE CODED 9/16/73 BY NEAL D. RYAN
3742
3743         MFUNCTION       RSTRNG,SUBR,READSTRING
3744
3745         ENTRY
3746         PUSH    P,[0]           ; FLAG TO INDICATE READING
3747         HLRE    0,AB
3748         CAMG    0,[-1]
3749         CAMG    0,[-9]
3750         JRST    WNA             ; CHECK THAT IT HAS FROM 1 TO 4 ARGS
3751         JRST    STRIO1
3752
3753         MFUNCTION       PSTRNG,SUBR,PRINTSTRING
3754
3755         ENTRY
3756         PUSH    P,[1]           ; FLAG TO INDICATE WRITING
3757         HLRE    0,AB
3758         CAMG    0,[-1]
3759         CAMG    0,[-7]
3760         JRST    WNA             ; CHECK THAT IT HAS FROM 1 TO 3 ARGS
3761
3762 STRIO1: PUSH    TP,[0]          ; SAVE SLOT ON STACK
3763         PUSH    TP,[0]
3764         GETYP   0,(AB)
3765         CAIE    0,TCHSTR                ; MAKE SURE WE GOT STRING
3766         JRST    WTYP1
3767         HRRZ    0,(AB)          ; CHECK FOR EMPTY STRING
3768         SKIPN   (P)
3769         JUMPE   0,MTSTRN
3770         HLRE    0,AB
3771         CAML    0,[-2]          ; WAS A CHANNEL GIVEN
3772         JRST    STRIO2
3773         GETYP   0,2(AB)
3774         SKIPN   (P)             ; SKIP IF PRINT
3775         JRST    TESTIN
3776         CAIN    0,TTP           ; SEE IF FLATSIZE HACK
3777         JRST    STRIO9
3778 TESTIN: CAIE    0,TCHAN
3779         JRST    WTYP2           ; SECOND ARG NOT CHANNEL
3780         MOVE    B,3(AB)
3781         HRRZ    B,-2(B)
3782         MOVNI   E,1             ; CHECKING FOR GOOD DIRECTION
3783         TRNE    B,C.READ                ; SKIP IF NOT READ
3784         MOVEI   E,0
3785         TRNE    B,C.PRIN                ; SKIP IF NOT PRINT
3786         MOVEI   E,1
3787         CAME    E,(P)
3788         JRST    WRONGD          ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE
3789 STRIO9: PUSH    TP,2(AB)
3790         PUSH    TP,3(AB)        ; PUSH ON CHANNEL
3791         JRST    STRIO3
3792 STRIO2: MOVE    B,IMQUOTE INCHAN
3793         MOVSI   A,TCHAN
3794         SKIPE   (P)
3795         MOVE    B,IMQUOTE OUTCHAN
3796         PUSHJ   P,IDVAL
3797         GETYP   0,A
3798         SKIPN   (P)             ; SKIP IF PRINTSTRING
3799         JRST    TESTI2
3800         CAIN    0,TTP           ; SKIP IF NOT FLATSIZE HACK
3801         JRST    STRIO8
3802 TESTI2: CAIE    0,TCHAN
3803         JRST    BADCHN          ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL
3804 STRIO8: PUSH    TP,A
3805         PUSH    TP,B
3806 STRIO3: MOVE    B,(TP)          ; GET CHANNEL
3807         SKIPN   E,IOINS(B)
3808         PUSHJ   P,OPENIT                ; IF NOT GO OPEN
3809         MOVE    E,IOINS(B)
3810         CAMN    E,[JRST CHNCLS]
3811         JRST    CHNCLS          ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED
3812 STRIO4: HLRE    0,AB
3813         CAML    0,[-4]
3814         JRST    STRIO5          ; NO COUNT TO WORRY ABOUT
3815         GETYP   0,4(AB)
3816         MOVE    E,4(AB)
3817         MOVE    C,5(AB)
3818         CAIE    0,TCHSTR
3819         CAIN    0,TFIX          ; BETTER BE A FIXED NUMBER
3820         JRST    .+2
3821         JRST    WTYP3
3822         HRRZ    D,(AB)          ; GET ACTUAL STRING LENGTH
3823         CAIN    0,TFIX
3824         JRST    .+7
3825         SKIPE   (P)     ; TEST FOR WRITING
3826         JRST    .-7             ; IF WRITING WE GOT TROUBLE
3827         PUSH    P,D             ; ACTUAL STRING LENGTH
3828         MOVEM   E,(TB)  ; STUFF HIS FUNNY DELIM STRING
3829         MOVEM   C,1(TB)
3830         JRST    STRIO7
3831         CAML    D,C             ; MAKE SURE THE STRING IS LONG ENOUGH
3832         JRST    .+2             ; WIN
3833         ERRUUO  EQUOTE COUNT-GREATER-THAN-STRING-SIZE
3834         PUSH    P,C     ; PUSH ON MAX COUNT
3835         JRST    STRIO7
3836 STRIO5:
3837 STRIO6: HRRZ    C,(AB)  ; GET CHAR COUNT
3838         PUSH    P,C             ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN
3839 STRIO7: HLRE    0,AB
3840         CAML    0,[-6]
3841         JRST    .+6
3842         MOVE    B,(TP)          ; GET THE CHANNEL
3843         MOVE    0,6(AB)
3844         MOVEM   0,EOFCND-1(B)   ; STUFF IN SLOT IN CHAN
3845         MOVE    0,7(AB)
3846         MOVEM   0,EOFCND(B)
3847         PUSH    TP,(AB)         ; PUSH ON STRING
3848         PUSH    TP,1(AB)
3849         PUSH    P,[0]           ; PUSH ON CURRENT COUNT OF CHARS DONE
3850         MOVE    0,-2(P)         ; GET READ OR WRITE FLAG
3851         JUMPN   0,OUTLOP        ; GO WRITE STUFF
3852
3853         MOVE    B,-2(TP)        ; GET CHANNEL
3854         PUSHJ   P,GRB           ; MAKE SURE WE HAVE BUFF
3855         SKIPGE  A,LSTCH(B)      ; CHECK FOR EOF ALREADY READ PREVIOUSLY
3856         JRST    SRDOEF          ; GO DOES HIS EOF HACKING
3857 INLOP:  INTGO
3858         MOVE    B,-2(TP)        ; GET CHANNEL
3859         MOVE    C,-1(P)         ; MAX COUNT
3860         CAMG    C,(P)           ; COMPARE WITH COUNT DONE
3861         JRST    STREOF          ; WE HAVE FINISHED
3862         PUSHJ   P,R1CHAR        ; GET A CHAR
3863         JUMPL   A,INEOF         ; EOF HIT
3864         MOVE    C,1(TB)
3865         HRRZ    E,(TB)          ; DO WE HAVE A STRING TO WORRY US?
3866         SOJL    E,INLNT         ; GO FINISH STUFFING
3867         ILDB    D,C
3868         CAME    D,A
3869         JRST    .-3
3870         JRST    INEOF
3871 INLNT:  IDPB    A,(TP)          ; STUFF IN STRING
3872         SOS     -1(TP)          ; DECREMENT STRING COUNT
3873         AOS     (P)             ; INCREMENT CHAR COUNT
3874         JRST    INLOP
3875
3876 INEOF:  SKIPE   C,LSTCH(B)      ; IS THIS AN ! AND IS THERE A CHAR THERE
3877         JRST    .+3             ; YES
3878         MOVEM   A,LSTCH(B)      ; NO SAVE THE CHAR
3879         JRST    .+3
3880         ADDI    C,400000
3881         MOVEM   C,LSTCH(B)
3882         MOVSI   C,200000
3883         IORM    C,LSTCH(B)
3884         HRRZ    C,DIRECT-1(B)   ; GET THE TYPE OF CHAN
3885         CAIN    C,5             ; IS IT READB?
3886         JRST    .+3
3887         SOS     ACCESS(B)       ; FIX UP ACCESS FOR READ CHANNEL
3888         JRST    STREOF          ; AND THATS IT
3889         HRRZ    C,ACCESS-1(B)   ; FOR A READB ITS WORSE
3890         MOVEI   D,5
3891         SKIPG   C
3892         HRRM    D,ACCESS-1(B)   ; CHANGE A 0 TO A FIVE
3893         SOS     C,ACCESS-1(B)
3894         CAMN    C,[TFIX,,0]
3895         SOS     ACCESS(B)       ; AND SOS THE WORD COUNT MAYBE
3896         JRST    STREOF
3897
3898 SRDOEF: SETZM   LSTCH(B)        ; IN CASE OF -1, FLUSH IT
3899         AOJE    A,INLOP         ; SKIP OVER -1 ON PTY'S
3900         SUB     TP,[6,,6]
3901         SUB     P,[3,,3]        ; POP JUNK OFF STACKS
3902         PUSH    TP,EOFCND-1(B)
3903         PUSH    TP,EOFCND(B)    ; WHAT WE NEED TO EVAL
3904         PUSH    TP,$TCHAN
3905         PUSH    TP,B
3906         MCALL   1,FCLOSE        ; CLOSE THE LOOSING CHANNEL
3907         MCALL   1,EVAL          ; EVAL HIS EOF JUNK
3908         JRST    FINIS
3909
3910 OUTLOP: MOVE    B,-2(TP)
3911 OUTLP1: INTGO
3912         MOVE    A,-3(TP)                ; GET CHANNEL
3913         MOVE    B,-2(TP)
3914         MOVE    C,-1(P)         ; MAX COUNT TO DO
3915         CAMG    C,(P)           ; HAVE WE DONE ENOUGH
3916         JRST    STREOF
3917         ILDB    D,(TP)          ; GET THE CHAR
3918         SOS     -1(TP)          ; SUBTRACT FROM STRING LENGTH
3919         AOS     (P)             ; INC COUNT OF CHARS DONE
3920         PUSHJ   P,CPCH1         ; GO STUFF CHAR
3921         JRST    OUTLP1
3922
3923 STREOF: MOVE    A,$TFIX
3924         POP     P,B             ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE
3925         SUB     P,[2,,2]
3926         SUB     TP,[6,,6]
3927         JRST    FINIS
3928
3929
3930 GWB:    SKIPE   BUFSTR(B)
3931         POPJ    P,
3932         PUSH    TP,$TCHAN
3933         PUSH    TP,B            ; GET US A WRITE BUFFER ON PRINTB CHAN
3934         MOVEI   A,BUFLNT
3935         PUSHJ   P,IBLOCK
3936         MOVSI   A,TWORD+.VECT.
3937         MOVEM   A,BUFLNT(B)
3938         SETOM   (B)
3939         MOVEI   C,1(B)
3940         HRLI    C,(B)
3941         BLT     C,BUFLNT-1(B)
3942         MOVEI   C,-1(B)
3943         HRLI    C,010700
3944         MOVE    B,(TP)
3945         MOVEI   0,C.BUF
3946         IORM    0,-2(B)
3947         MOVEM   C,BUFSTR(B)
3948         MOVE    C,[TCHSTR,,BUFLNT*5]
3949         MOVEM   C,BUFSTR-1(B)
3950         SUB     TP,[2,,2]
3951         POPJ    P,
3952
3953
3954 GRB:    SKIPE   BUFSTR(B)
3955         POPJ    P,
3956         PUSH    TP,$TCHAN
3957         PUSH    TP,B            ; GET US A READ BUFFER
3958         MOVEI   A,BUFLNT
3959         PUSHJ   P,IBLOCK
3960         MOVEI   C,BUFLNT-1(B)
3961         POP     TP,B
3962         MOVEI   0,C.BUF
3963         IORM    0,-2(B)
3964         HRLI    C,010700
3965         MOVEM   C,BUFSTR(B)
3966         MOVSI   C,TCHSTR
3967         MOVEM   C,BUFSTR-1(B)
3968         SUB     TP,[1,,1]
3969         POPJ    P,
3970
3971 MTSTRN: ERRUUO  EQUOTE EMPTY-STRING
3972
3973 \f; INPUT UNBUFFERING ROUTINE.  THIS DOES THE CHARACTER UNBUFFERING
3974 ; FOR INPUT.  THE OPEN ROUTINE SETUPS A PUSHJ P, TO
3975 ; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE.
3976
3977 ; H. BRODIE 7/19/72
3978
3979 ; CALLING SEQ:
3980 ;       PUSHJ   P,GETCHR
3981 ;               B/ AOBJN PNTR TO CHANNEL VECTOR
3982 ;               RETURNS NEXT CHARACTER IN AC A.
3983 ;       ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND
3984 ;       TRANSMITS ONLY ^C ON SUCCESSIVE CALLS
3985
3986
3987 GETCHR:
3988 ; FIRST GRAB THE BUFFER
3989 ;       GETYP   A,BUFSTR-1(B)   ; GET TYPE WORD
3990 ;       CAIN    A,TCHSTR        ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER)
3991 ;       JRST    GTGBUF          ; IS GOOD BUFFER...SKIP ERROR RETURN
3992 GTGBUF: HRRZ    A,BUFSTR-1(B)   ; GET LENGTH OF STRING
3993         SOJGE   A,GTGCHR        ; JUMP IF STILL MORE
3994
3995 ; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS)
3996 ; GENERATE AN .IOT POINTER
3997 ;FIRST SAVE C AND D AS I WILL CLOBBER THEM
3998 NEWBUF: PUSH    P,C
3999         PUSH    P,D
4000 IFN ITS,[
4001         LDB     C,[600,,STATUS(B)]      ; GET TYPE
4002         CAIG    C,2             ; SKIP IF NOT TTY
4003 ]
4004 IFE ITS,[
4005         SKIPE   BUFRIN(B)
4006 ]
4007         JRST    GETTTY          ; GET A TTY BUFFER
4008
4009         PUSHJ   P,PGBUFI        ; RE-FILL BUFFER
4010
4011 IFE ITS,        MOVEI   C,-1
4012         JUMPGE  A,BUFGOO        ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL
4013 IFN ITS,[
4014         MOVEI   C,1             ; MAKE SURE LAST EOF REALLY ENDS IT
4015         ANDCAM  C,-1(A)
4016 ]
4017         MOVSI   C,014000        ; GET A ^C
4018         MOVEM   C,(A)           ;FAKE AN EOF
4019
4020 IFE ITS,[
4021         HLRE    C,A             ; HOW MUCH LEFT
4022         ADDI    C,BUFLNT        ; # OF WORDS TO C
4023         IMULI   C,5             ; TO CHARS
4024         PUSH    P,0
4025         MOVEI   0,1
4026         SKIPE   C
4027         ANDCAM  0,-1(1)
4028         POP     P,0
4029         MOVE    A,-2(B)         ; GET BITS
4030         TRNE    A,C.BIN         ; CAN'T HELP A BINARY CHANNEL
4031         JRST    BUFGOO
4032         MOVE    A,CHANNO(B)
4033         PUSH    P,B
4034         PUSH    P,D
4035         PUSH    P,C
4036         PUSH    P,[0]
4037         PUSH    P,[0]
4038         MOVEI   C,-1(P)
4039         MOVE    B,[2,,11]       ; READ WORD CONTAINING BYTE SIZE
4040         GTFDB
4041         LDB     D,[300600,,-1(P)]       ; GET BYTE SIZE
4042         MOVE    B,(P)
4043         SUB     P,[2,,2]
4044         POP     P,C
4045         CAIE    D,7             ; SEVEN BIT BYTES?
4046         JRST    BUFGO1          ; NO, DONT HACK
4047         MOVE    D,C
4048         IDIVI   B,5             ; C IS NUMBER IN LAST WORD IF NOT EVEN
4049         SKIPN   C
4050         MOVEI   C,5
4051         ADDI    C,-5(D)         ; FIXUP C FOR WINNAGE
4052 BUFGO1: POP     P,D
4053         POP     P,B
4054 ]
4055 ; RESET THE BYTE POINTER IN THE CHANNEL.
4056 ; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D
4057 BUFGOO: HRLI    D,010700        ; GENERATE VIRGIN LH
4058         SUBI    D,1
4059
4060         MOVEM   D,BUFSTR(B)     ; STASH IN THE BUFFER BYTE PNTR SLOT
4061 IFE ITS,        HRRM    C,LSTCH-1(B)    ; SAVE IT
4062         MOVEI   A,BUFLNT*5-1
4063 BUFROK: POP     P,D             ;RESTORE D
4064         POP     P,C             ;RESTORE C
4065
4066
4067 ; HERE IF THERE ARE CHARS IN BUFFER
4068 GTGCHR: HRRM    A,BUFSTR-1(B)
4069         ILDB    A,BUFSTR(B)     ; GET A CHAR FROM BUFFER
4070
4071 IFN ITS,[
4072         CAIE    A,3             ; EOF?
4073         POPJ    P,              ; AND RETURN
4074         LDB     A,[600,,STATUS(B)]      ; CHECK FOR TTY
4075         CAILE   A,2             ; SKIP IF TTY
4076 ]
4077 IFE ITS,[
4078         PUSH    P,0
4079         HRRZ    0,LSTCH-1(B)
4080         SOJL    0,.+4
4081         HRRM    0,LSTCH-1(B)
4082         POP     P,0
4083         POPJ    P,
4084
4085         POP     P,0
4086         MOVSI   A,-1
4087         SKIPN   BUFRIN(B)
4088 ]
4089         JRST    .+3
4090 RETEO1: HRRI    A,3
4091         POPJ    P,
4092
4093         HRRZ    A,BUFSTR(B)     ; SEE IF RSUBR START BIT IS ON
4094         HRRZ    A,(A)
4095         TRNN    A,1
4096         MOVSI   A,-1
4097         JRST    RETEO1
4098
4099 IFN ITS,[
4100 PGBUFO:
4101 PGBUFI:
4102 ]
4103 IFE ITS,[
4104 PGBUFO: SKIPA   D,[SOUT]
4105 PGBUFI: MOVE    D,[SIN]
4106 ]
4107         SKIPGE  A,BUFSTR(B)     ; POINT TO CURRENT BUFFER POSIT
4108         SUBI    A,1             ; FOR 440700 AND 010700 START
4109         SUBI    A,BUFLNT-1      ; CALCULATE PNTR TO BEG OF BUFFER
4110         HRLI    A,-BUFLNT       ; IOT (AOBJN) PNTR IN A
4111         MOVSI   C,004400
4112 IFN ITS,[
4113 PGBIOO:
4114 PGBIOI: MOVE    D,A             ; COPY FOR LATER
4115         MOVSI   C,TUVEC         ; PREPARE TO HANDDLE INTS
4116         MOVE    PVP,PVSTOR+1
4117         MOVEM   C,DSTO(PVP)
4118         MOVEM   C,ASTO(PVP)
4119         MOVSI   C,TCHAN
4120         MOVEM   C,BSTO(PVP)
4121
4122 ; BUILD .IOT INSTR
4123         MOVE    C,CHANNO(B)     ; CHANNEL NUMBER IN C
4124         ROT     C,23.           ; MOVE INTO AC FIELD
4125         IOR     C,[.IOT 0,A]    ; IOR IN SKELETON .IOT
4126
4127 ; DO THE .IOT
4128         ENABLE                  ; ALLOW INTS
4129         XCT     C               ; EXECUTE THE .IOT INSTR
4130         DISABLE
4131         MOVE    PVP,PVSTOR+1
4132         SETZM   BSTO(PVP)
4133         SETZM   ASTO(PVP)
4134         SETZM   DSTO(PVP)
4135         POPJ    P,
4136 ]
4137
4138 IFE ITS,[
4139 PGBIOT: PUSH    P,D
4140         PUSH    TP,$TCHAN
4141         PUSH    TP,B
4142         PUSH    P,C
4143         HRRZS   (P)
4144         HRRI    C,-1(A)         ; POINT TO BUFFER
4145         HLRE    D,A             ; XTRA POINTER
4146         MOVNS   D
4147         HRLI    D,TCHSTR
4148         MOVE    PVP,PVSTOR+1
4149         MOVEM   D,BSTO(PVP)
4150         MOVE    D,[PUSHJ P,FIXACS]
4151         MOVEM   D,ONINT
4152         MOVSI   D,TUVEC
4153         MOVEM   D,DSTO(PVP)
4154         MOVE    D,A
4155         MOVE    A,CHANNO(B)     ; FILE JFN
4156         MOVE    B,C
4157         HLRE    C,D             ; - COUNT TO C
4158         SKIPE   (P)
4159          MOVN   C,(P)           ; REAL DESIRED COUNT
4160         SUB     P,[1,,1]
4161         ENABLE
4162         XCT     (P)             ; DO IT TO IT
4163         DISABLE
4164         MOVE    PVP,PVSTOR+1
4165         SETZM   BSTO(PVP)
4166         SETZM   DSTO(PVP)
4167         SETZM   ONINT
4168         MOVEI   A,1(B)
4169         MOVE    B,(TP)
4170         SUB     TP,[2,,2]
4171         SUB     P,[1,,1]
4172         JUMPGE  C,CPOPJ         ; NO EOF YET
4173         HRLI    A,(C)           ; LOOK LIKE AN AOBJN PNTR
4174         POPJ    P,
4175
4176 FIXACS: PUSH    P,PVP
4177         MOVE    PVP,PVSTOR+1
4178         MOVNS   C
4179         HRRM    C,BSTO(PVP)
4180         MOVNS   C
4181         POP     P,PVP
4182         POPJ    P,
4183
4184 PGBIOO: SKIPA   D,[SOUT]
4185 PGBIOI: MOVE    D,[SIN]
4186         HRLI    C,004400
4187         JRST    PGBIOT
4188 DOIOTO: PUSH    P,[SOUT]
4189 DOIOTC: PUSH    P,B
4190         PUSH    P,C
4191         EXCH    A,B
4192         MOVE    A,CHANNO(A)
4193         HLRE    C,B
4194         HRLI    B,444400
4195         XCT     -2(P)
4196         HRL     B,C
4197         MOVE    A,B
4198 DOIOTE: POP     P,C
4199         POP     P,B
4200         SUB     P,[1,,1]
4201         POPJ    P,
4202 DOIOTI: PUSH    P,[SIN]
4203         JRST    DOIOTC
4204 ]
4205 \f
4206 ; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE
4207
4208 PUTCHR: PUSH    P,A
4209         GETYP   A,BUFSTR-1(B)   ; CHECK TYPE OF ARG
4210         CAIE    A,TCHSTR        ; MUST BE STRING
4211         JRST    BDCHAN
4212
4213         HRRZ    A,BUFSTR-1(B)   ; GET CHAR COUNT
4214         JUMPE   A,REBUFF        ; PREV RESET BUFF, UNDO SAME
4215
4216 PUTCH1: POP     P,A             ; RESTORE CHAR
4217         CAMN    A,[-1]          ; SPECIAL HACK?
4218         JRST    PUTCH2          ; YES GO HANDLE
4219         IDPB    A,BUFSTR(B)     ; STUFF IT
4220 PUTCH3: SOS     A,BUFSTR-1(B)   ; COUNT DOWN STRING
4221         TRNE    A,-1            ; SKIP IF FULL
4222         POPJ    P,
4223
4224 ; HERE TO FLUSH OUT A BUFFER
4225
4226         PUSH    P,C
4227         PUSH    P,D
4228         PUSHJ   P,PGBUFO        ; SETUP AND DO IOT
4229         HRLI    D,010700        ; POINT INTO BUFFER
4230         SUBI    D,1
4231         MOVEM   D,BUFSTR(B)     ; STORE IT
4232         MOVEI   A,BUFLNT*5      ; RESET  COUNT
4233         HRRM    A,BUFSTR-1(B)
4234         POP     P,D
4235         POP     P,C
4236         POPJ    P,
4237
4238 ;HERE TO DA ^C AND TURN ON MAGIC BIT
4239
4240 PUTCH2: MOVEI   A,3
4241         IDPB    A,BUFSTR(B)     ; ZAP OUT THE ^C
4242         MOVEI   A,1             ; GET BIT
4243 IFE ITS,[
4244         PUSH    P,C
4245         HRRZ    C,BUFSTR(B)
4246         IORM    A,(C)
4247         POP     P,C
4248 ]
4249 IFN ITS,[
4250         IORM    A,@BUFSTR(B)    ; ON GOES THE BIT
4251 ]
4252         JRST    PUTCH3
4253
4254 ; RESET A FUNNY BUF
4255
4256 REBUFF: MOVEI   A,BUFLNT*5              ; 1ST COUNT
4257         HRRM    A,BUFSTR-1(B)
4258         HRRZ    A,BUFSTR(B)             ; NOW POINTER
4259         SUBI    A,BUFLNT+1
4260         HRLI    A,010700
4261         MOVEM   A,BUFSTR(B)             ; STORE BACK
4262         JRST    PUTCH1
4263
4264
4265 ; HERE TO FLUSH FINAL BUFFER
4266
4267 BFCLOS: HRRZ    C,-2(B)         ; THIS BUFFER FLUSHER THE WORK OF NDR
4268         MOVEI   A,0
4269         TRNE    C,C.TTY
4270          POPJ   P,
4271         TRNE    C,C.DISK
4272          MOVEI  A,1
4273         PUSH    P,A             ; SAVE THE RESULT OF OUR TEST
4274         JUMPN   A,BFCLNN        ; DONT HAVE TO CHECK NET STATE
4275         PUSH    TP,$TCHAN
4276         PUSH    TP,B            ; SAVE CHANNEL
4277         PUSHJ   P,INSTAT        ; GET CURRENT NETWORK STATE
4278         MOVE    A,(B)           ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE
4279         POP     TP,B            ; RESTORE B
4280         POP     TP,
4281         CAIE    A,5             ; IS NET IN OPEN STATE?
4282         CAIN    A,6             ; OR ELSE IS IT IN RFNM WAIT STATE
4283         JRST    BFCLNN          ; IF SO TO THE IOT
4284         POP     P,              ; ELSE FLUSH CRUFT AND DONT IOT
4285         POPJ    P,              ; RETURN DOING NO IOT
4286 BFCLNN: MOVEI   C,BUFLNT*5      ; NEW BUFFER FLUSHER BY NDR
4287         HRRZ    D,BUFSTR-1(B)   ; SO THAT NET ALSO WORKS RIGHT
4288         SUBI    C,(D)           ; GET NUMBER OF CHARS
4289         IDIVI   C,5             ; NUMBER OF FULL WORDS AND REST
4290         PUSH    P,D             ; SAVE NUMBER OF ODD CHARS
4291         SKIPGE  A,BUFSTR(B)     ; GET CURRENT BUF POSITION
4292         SUBI    A,1             ; FIX FOR 440700 BYTE POINTER
4293 IFE ITS,[
4294         HRRO    D,A
4295         PUSH    P,(D)
4296 ]
4297 IFN ITS,[
4298         PUSH    P,(A)           ; SAVE THE ODD WORD OF BUFFER
4299 ]
4300         MOVEI   D,BUFLNT
4301         SUBI    D,(C)
4302         SKIPE   -1(P)
4303         SUBI    A,1
4304         ADDI    D,1(A)          ; FIX UP FOR POSSIBLE ODD CHARS
4305         PUSH    TP,$TUVEC
4306         PUSH    TP,D            ; PUSH THE DOPE VECTOR ONTO THE STACK
4307         JUMPE   C,BFCLSR        ; IN CASE THERE ARE NO FULL WORDS TO DO
4308         HRL     A,C
4309         TLO     A,400000
4310         MOVE    E,[SETZ BUFLNT(A)]
4311         SUBI    E,(C)   ; FIX UP FOR BACKWARDS BLT
4312         POP     A,@E            ; AMAZING GRACE
4313         TLNE    A,377777
4314         JRST    .-2
4315         HRRO    A,D             ; SET UP AOBJN POINTER
4316         SUBI    A,(C)
4317         TLC     A,-1(C)
4318         PUSHJ   P,PGBIOO        ; DO THE IOT OF ALL THE FULL WORDS
4319 BFCLSR: HRRO    A,(TP)          ; GET IOT PTR FOR REST OF JUNK
4320         SUBI    A,1             ; POINT TO WORD BEFORE DOPE WORDS
4321         POP     P,0             ; GET BACK ODD WORD
4322         POP     P,C             ; GET BACK ODD CHAR COUNT
4323         POP     P,D             ; FLAG FOR NET OR DSK
4324         JUMPN   D,BFCDSK        ; GO FINISH OFF DSK
4325         JUMPE   C,BFCLSD        ; IF NO ODD CHARS FINISH UP
4326         MOVEI   D,7
4327         IMULI   D,(C)           ; FIND NO OF BITS TO SHIFT
4328         LSH     0,-43(D)        ; SHIFT BITS TO RIGHT PLACE
4329         MOVEM   0,(A)   ; STORE IN STRING
4330         SUBI    C,5             ; HOW MANY CHAR POSITIONS TO SKIP
4331         MOVNI   C,(C)           ; MAKE C POSITIVE
4332         LSH     C,17
4333         TLC     A,(C)           ; MUNG THE AOBJN POINTER TO KLUDGE
4334         PUSHJ   P,PGBIOO        ; DO IOT OF ODD CHARS
4335         MOVEI   C,0
4336 BFCLSD: HRRZ    A,(TP)          ; GET PTR TO DOPE WORD
4337         SUBI    A,BUFLNT+1
4338         JUMPLE  C,.+3
4339         SKIPE   ACCESS(B)
4340         MOVEM   0,1(A)          ; LAST WORD BACK IN BFR
4341         HRLI    A,010700        ; AOBJN POINTER TO FIRST OF BUFFER
4342         MOVEM   A,BUFSTR(B)
4343         MOVEI   A,BUFLNT*5
4344         HRRM    A,BUFSTR-1(B)
4345         SKIPN   ACCESS(B)
4346          JRST   BFCLSY
4347         JUMPL   C,BFCLSY
4348         JUMPE   C,BFCLSZ
4349         IBP     BUFSTR(B)
4350         SOS     BUFSTR-1(B)
4351         SOJG    C,.-2
4352 BFCLSY: MOVE    A,CHANNO(B)
4353         MOVE    C,B
4354 IFE ITS,[
4355         RFPTR
4356         FATAL RFPTR FAILED
4357         HRRZ    F,LSTCH-1(C)    ; PREVIOUS HIGH
4358         MOVE    G,C             ; SAVE CHANNEL
4359         MOVE    C,B
4360         CAML    F,B
4361          MOVE   C,F
4362         MOVE    F,B
4363         HRLI    A,400000
4364         CLOSF
4365         JFCL
4366         MOVNI   B,1
4367         HRLI    A,12
4368         CHFDB
4369         MOVE    B,STATUS(G)
4370         ANDI    A,-1
4371         OPENF
4372         FATAL OPENF LOSES
4373         MOVE    C,F
4374         IDIVI   C,5
4375         MOVE    B,C
4376         SFPTR
4377         FATAL SFPTR FAILED
4378         MOVE    B,G
4379 ]
4380 IFN ITS,[
4381         DOTCAL  RFPNTR,[A,[2000,,B]]
4382          .LOSE  %LSFIL          ;PRESUMABLY LOSSAGE MATTERS
4383         SUBI    B,1
4384         DOTCAL  ACCESS,[A,B]
4385          .LOSE  %LSFIL          ;PRESUMABLY LOSSAGE MATTERS
4386         MOVE    B,C
4387 ]
4388 BFCLSZ: SUB     TP,[2,,2]
4389         POPJ    P,
4390
4391 BFCDSK: TRZ     0,1
4392         PUSH    P,C
4393 IFE ITS,[
4394         PUSH    TP,$TCHAN
4395         PUSH    TP,B
4396         PUSH    P,0             ; WORD OF CHARS
4397         MOVE    A,CHANNO(B)
4398         MOVEI   B,7             ; MAKE BYTE SIZE 7
4399         SFBSZ
4400         JFCL
4401         HRROI   B,(P)
4402         MOVNS   C
4403         SKIPE   C
4404         SOUT
4405         MOVE    B,(TP)
4406         SUB     P,[1,,1]
4407         SUB     TP,[2,,2]
4408 ]
4409 IFN ITS,[
4410         MOVE    D,[440700,,A]
4411         DOTCAL  SIOT,[CHANNO(B),D,C]
4412          .LOSE  %LSFIL          ;PRESUMABLY LOSSAGE MATTERS
4413 ]
4414         POP     P,C
4415         JUMPN   C,BFCLSD
4416 BFCDS1: MOVNI   C,1             ; INDICATE NOT TOHACK BUFFER
4417         JRST    BFCLSD
4418
4419 BFCLS1: HRRZ    C,DIRECT-1(B)
4420         MOVSI   0,(JFCL)
4421         CAIE    C,6
4422         MOVE    0,[AOS ACCESS(B)]
4423         PUSH    P,0
4424         HRRZ    C,BUFSTR-1(B)
4425         IDIVI   C,5
4426         JUMPE   D,BCLS11
4427         MOVEI   A,40            ; PAD WITH SPACES
4428         PUSHJ   P,PUTCHR
4429         XCT     (P)             ; AOS ACCESS IF NECESSARY
4430         SOJG    D,.-3           ; TO END OF WORD\r
4431 BCLS11: POP     P,0
4432         HLLZS   ACCESS-1(B)
4433         HRRZ    C,BUFSTR-1(B)
4434         CAIE    C,BUFLNT*5
4435         PUSHJ   P,BFCLOS
4436         POPJ    P,
4437
4438 \f
4439 ; HERE TO GET A TTY BUFFER
4440
4441 GETTTY: SKIPN   C,EXBUFR(B)     ; SKIP IF BUFFERS BACKED UP
4442         JRST    TTYWAI
4443         HRRZ    D,(C)           ; CDR THE LIST
4444         GETYP   A,(C)           ; CHECK TYPE
4445         CAIE    A,TDEFER        ; MUST BE DEFERRED
4446         JRST    BDCHAN
4447         MOVE    C,1(C)          ; GET DEFERRED GOODIE
4448         GETYP   A,(C)           ; BETTER BE CHSTR
4449         CAIE    A,TCHSTR
4450         JRST    BDCHAN
4451         MOVE    A,(C)           ; GET FULL TYPE WORD
4452         MOVE    C,1(C)
4453         MOVEM   D,EXBUFR(B)     ; STORE CDR'D LIST
4454         MOVEM   A,BUFSTR-1(B)   ; MAKE CURRENT BUFFER
4455         MOVEM   C,BUFSTR(B)
4456         HRRM    A,LSTCH-1(B)
4457         SOJA    A,BUFROK
4458
4459 TTYWAI: PUSHJ   P,TTYBLK        ; BLOCKED FOR TTY I/O
4460         JRST    GETTTY          ; SHOULD ONLY RETURN HAPPILY
4461
4462 \f;INTERNAL DEVICE READ ROUTINE.
4463
4464 ;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,
4465 ;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER,
4466 ;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE"
4467
4468 ;H. BRODIE 8/31/72
4469
4470 GTINTC: PUSH    TP,$TCHAN       ;SAVE THE CHANNEL...WE'LL CLOBBER B
4471         PUSH    TP,B
4472         PUSH    P,C     ;AND SAVE THE OTHER ACS
4473         PUSH    P,D
4474         PUSH    P,E
4475         PUSH    P,0
4476         PUSH    TP,$TCHAN
4477         PUSH    TP,B
4478         MCALL   1,INTFCN-1(B)
4479         GETYP   A,A
4480         CAIE    A,TCHRS
4481         JRST    BADRET
4482         MOVE    A,B
4483 INTRET: POP     P,0             ;RESTORE THE ACS
4484         POP     P,E
4485         POP     P,D
4486         POP     P,C
4487         POP     TP,B            ;RESTORE THE CHANNEL
4488         SUB     TP,[1,,1]       ;FLUSH $TCHAN...WE DON'T NEED IT
4489         POPJ    P,
4490
4491
4492 BADRET: ERRUUO  EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT
4493
4494 ;INTERNAL DEVICE PRINT ROUTINE.
4495
4496 ;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR)
4497 ;TO THE CURRENT CHARACTER BEING "PRINTED".
4498
4499 PTINTC: PUSH    TP,$TCHAN       ;SAVE THE CHANNEL...WE'LL CLOBBER B
4500         PUSH    TP,B
4501         PUSH    P,C     ;AND SAVE THE OTHER ACS
4502         PUSH    P,D
4503         PUSH    P,E
4504         PUSH    P,0
4505         PUSH    TP,$TCHRS       ;PUSH THE TYPE "CHARACTER"
4506         PUSH    TP,A            ;PUSH THE CHAR
4507         PUSH    TP,$TCHAN       ;PUSH THE CHANNEL
4508         PUSH    TP,B
4509         MCALL   2,INTFCN-1(B)   ;APPLY THE FUNCTION TO THE CHAR
4510         JRST    INTRET
4511
4512
4513 \f
4514 ; ROUTINE TO FLUSH OUT A PRINT BUFFER
4515
4516 MFUNCTION BUFOUT,SUBR
4517
4518         ENTRY   1
4519
4520         GETYP   0,(AB)
4521         CAIE    0,TCHAN
4522         JRST    WTYP1
4523
4524         MOVE    B,1(AB)
4525 ;       MOVEI   B,DIRECT-1(B)
4526 ;       PUSHJ   P,CHRWRD        ; GET DIR NAME
4527 ;       JFCL
4528 ;       CAMN    B,[ASCII /PRINT/]
4529 ;       JRST    .+3
4530 ;       CAME    B,[<ASCII /PRINT/>+1]
4531 ;       JRST    WRONGD
4532 ;       TRNE    B,1             ; SKIP IF PRINT
4533 ;       PUSH    P,[JFCL]
4534 ;       TRNN    B,1             ; SKIP IF PRINTB
4535 ;       PUSH    P,[AOS ACCESS(B)]
4536         HRRZ    0,-2(B)
4537         TRNN    0,C.PRIN
4538          JRST   WRONGD
4539 ;       TRNE    0,C.BIN         ; SKIP IF PRINT
4540 ;        PUSH   P,[JFCL]
4541 ;       TRNN    0,C.BIN         ; SKIP IF PRINTB
4542 ;        PUSH   P,[AOS ACCESS(B)]
4543 ;       MOVE    B,1(AB)
4544 ;       GETYP   0,BUFSTR-1(B)
4545 ;       CAIN    0,TCHSTR
4546 ;       SKIPN   A,BUFSTR(B)             ; BYTE POINTER?
4547 ;       JRST    BFIN1
4548 ;       HRRZ    C,BUFSTR-1(B)   ; CHARS LEFT
4549 ;       IDIVI   C,5             ; MULTIPLE OF 5?
4550 ;       JUMPE   D,BFIN2         ; YUP NO EXTRAS
4551
4552 ;       MOVEI   A,40            ; PAD WITH SPACES
4553 ;       PUSHJ   P,PUTCHR        ; OUT IT GOES
4554 ;       XCT     (P)             ; MAYBE BUMP ACCESS
4555 ;       SOJG    D,.-3           ; FILL
4556
4557 BFIN2:  PUSHJ   P,BFCLOS        ; WRITE OUT BUFFER
4558
4559 BFIN1:  MOVSI   A,TCHAN
4560         JRST    FINIS
4561
4562
4563
4564 ; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL
4565
4566 MFUNCTION FILLNT,SUBR,[FILE-LENGTH]
4567         ENTRY   1
4568
4569         GETYP   0,(AB)
4570         CAIE    0,TCHAN
4571         JRST    WTYP1
4572         MOVE    B,1(AB)
4573         PUSHJ   P,CFILLE
4574         JRST    FINIS
4575
4576 CFILLE:
4577 IFN 0,[
4578         MOVEI   B,DIRECT-1(B)   ; GET CHANNEL TYPE
4579         PUSHJ   P,CHRWRD
4580         JFCL
4581         CAME    B,[ASCIZ /READ/]
4582         JRST    .+3
4583         PUSH    P,[5]           ; MULTIPLICATIVE FACTOR FOR READ
4584         JRST    .+4
4585         CAME    B,[ASCII /READB/]
4586         JRST    WRONGD
4587         PUSH    P,[1]           ; MULTIPLICATIVE FACTOR FOR READ
4588 ]
4589         MOVE    C,-2(B)         ; GET BITS
4590         MOVEI   D,5             ; ASSUME ASCII
4591         TRNE    C,C.BIN         ; SKIP IF NOT BINARY
4592         MOVEI   D,1
4593         PUSH    P,D
4594         MOVE    C,B
4595 IFN ITS,[
4596         .CALL   FILL1
4597         JRST    FILLOS          ; GIVE HIM A NICE FALSE
4598 ]
4599 IFE ITS,[
4600         MOVE    A,CHANNO(C)
4601         PUSH    P,[0]
4602         MOVEI   C,(P)
4603         MOVE    B,[1,,11]       ; READ WORD CONTAINING BYTE SIZE
4604         GTFDB
4605         LDB     D,[300600,,(P)] ; GET BYTE SIZE
4606         JUMPN   D,.+2
4607          MOVEI  D,36.           ; HANDLE "0" BYTE SIZE
4608         SUB     P,[1,,1]
4609         SIZEF
4610         JRST    FILLOS
4611 ]
4612         POP     P,C
4613 IFN ITS,        IMUL    B,C
4614 IFE ITS,[
4615         CAIN    C,5
4616         CAIE    D,7
4617         JRST    NOTASC
4618 ]
4619 YESASC: MOVE    A,$TFIX
4620         POPJ    P,
4621
4622 IFE ITS,[
4623 NOTASC: MOVEI   0,36.
4624         IDIV    0,D             ; BYTES PER WORD
4625         IDIVM   B,0
4626         IMUL    C,0
4627         MOVE    B,C
4628         JRST    YESASC
4629 ]
4630
4631 IFN ITS,[
4632 FILL1:  SETZ                    ; BLOCK FOR .CALL TO FILLEN
4633         SIXBIT /FILLEN/
4634         CHANNO  (C)
4635         SETZM   B
4636
4637 FILLOS: MOVE    A,CHANNO(C)
4638         MOVE    B,[.STATUS A]           ;MAKE A CALL TO STATUS TO FIND REASON
4639         LSH     A,23.                   ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE
4640         IOR     B,A                     ;FIX UP .STATUS
4641         XCT     B
4642         MOVE    B,C
4643         PUSHJ   P,GFALS
4644         POP     P,
4645         POPJ    P,
4646 ]
4647 IFE ITS,[
4648 FILLOS: MOVE    B,C
4649         PUSHJ   P,TGFALS
4650         POP     P,
4651         POPJ    P,
4652 ]
4653
4654
4655 \f; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS
4656
4657 ;CALLING ROUTINE:       AC-A contains pointer to block of SIXBIT data
4658 ;                       DIR ? DEV ? FNM1 ? FNM2 ? SNM
4659 ;RETURNED VALUE :       AC-A = <channel #, or -1 if no channel available>
4660 IFN ITS,[
4661 MOPEN:  PUSH    P,B
4662         PUSH    P,C
4663         MOVE    C,FRSTCH        ; skip gc and tty channels
4664 CNLP:   DOTCAL  STATUS,[C,[2000,,B]]
4665          .LOSE  %LSFIL
4666         ANDI    B,77
4667         JUMPE   B,CHNFND        ; found unused channel ?
4668         ADDI    C,1             ; try another channel
4669         CAIG    C,17            ; are all the channels used ?
4670          JRST   CNLP
4671         SETO    C,              ; all channels used so C = -1
4672         JRST    CHNFUL
4673 CHNFND: MOVEI   B,(C)
4674         HLL     B,(A)           ; M.DIR slot
4675         DOTCAL  OPEN,[B,1(A),2(A),3(A),4(A)]
4676          SKIPA
4677         AOS     -2(P)           ; successful  skip when returning
4678 CHNFUL: MOVE    A,C
4679         POP     P,C
4680         POP     P,B
4681         POPJ    P,
4682
4683 MIOT:   DOTCAL  IOT,[A,B]
4684          JFCL
4685         POPJ    P,
4686
4687 MCLOSE: DOTCAL  CLOSE,[A]
4688          JFCL
4689         POPJ    P,
4690
4691 IMPURE
4692
4693 FRSTCH: 1
4694
4695 PURE
4696 ]
4697 \f;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O
4698
4699 NOTNET:
4700 BADCHN: ERRUUO  EQUOTE BAD-CHANNEL
4701 BDCHAN: ERRUUO  EQUOTE BAD-INPUT-BUFFER
4702
4703 WRONGD: ERRUUO  EQUOTE WRONG-DIRECTION-CHANNEL
4704
4705 CHNCLS: ERRUUO  EQUOTE CHANNEL-CLOSED
4706
4707 BAD6:   ERRUUO  EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME
4708
4709 DISLOS: MOVE    C,$TCHSTR
4710         MOVE    D,CHQUOTE [DISPLAY NOT AVAILABLE]
4711         PUSHJ   P,INCONS
4712         MOVSI   A,TFALSE
4713         JRST    OPNRET
4714
4715 NOCHAN: ERRUUO  EQUOTE ITS-CHANNELS-EXHAUSTED
4716
4717 MODE1:  232020,,202020
4718 MODE2:  232023,,330320
4719
4720 END
4721
4722 \f