<mdl.int>/nfopen.mid.4

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