<mdl.int>/fopen.mid.35

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