MUDDLE/fopen.63

   1 TITLE OPEN - CHANNEL OPENER FOR MUDDLE
   2
   3 RELOCATABLE
   4
   5 ;C. REEVE  JAN 1971
   6
   7 .INSRT MUDDLE >
   8
   9 ;THIS PROGRAM HAS TWO ENTRIES.  FOPEN,FCLOSE AND FDELETE.
  10 ;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM.
  11
  12 ;       FOPEN   - OPENS A FILE FOR EITHER READING OR WRITING.  IT TAKES
  13 ;               FIVE OPTINAL ARGUMENTS AS FOLLOWS:
  14
  15 ;               FOPEN (<DIR>,<FILE NAME1>,<FILE NAME2>,<DEVICE>,<SYSTEM NAME>)
  16 ;
  17 ;               <DIR> - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ
  18
  19 ;               <FILE NAME1> - FIRST FILE NAME.  DEFAULT INPUT OR OUTPUT.
  20
  21 ;               <FILE NAME2> - SECOND FILE NAME.  DEFAULT MUDDLE.
  22
  23 ;               <DEVICE> - DEVICE FROM WHICH TO OPEN.  DEFAULT IS DSK.
  24
  25 ;               <SNAME> - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME.
  26
  27 ;       FOPEN   RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL
  28
  29
  30 ;       FCLOSE  - CLOSES A FILE.  TAKES A CHANNEL OBJECT AS ITS ARGUMENT.  IT ALSO TAKES
  31
  32
  33 ;A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION
  34
  35 ;       CHANNO==1                       ;ITS I/O CHANNEL NUMBER.  0 MEANS NOT A REAL CHANNEL.
  36 ;       DIRECT==3       ;DIRECTION (EITHER READ OR PRINT)
  37 ;       DEVICE==5       ;DEVICE UPON WHICH THE CHANNEL IS OPEN
  38 ;       NAME1==7        ;FIRST NAME OF FILE AS OPENED.
  39 ;       NAME2==11       ;SECOND NAME OF FILE
  40 ;       SNAME==13       ;DIRECTORY NAME
  41 ;       RDEVIC==15      ;REAL DEVICE
  42 ;       RNAME1=17       ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS)
  43 ;       RNAME2==21      ;REAL SECOND NAME
  44 ;       RSNAME==23      ;SYSTEM OR DIRECTORY NAME
  45 ;       STATUS==25      ;VARIOUS STATUS BITS
  46 ;       IOINS==27       ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER
  47 ;       ACCESS==31      ;ACCESS POINTER FOR RAND ACCESS
  48 ;       RADX==33        ;RADIX FOR CHANNELS NUMBER CONVERSION
  49 ;       *** THE FOLLOWING FIELDS FOR OUTPUT ONLY ***
  50
  51 ;       LINLN==35                       ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE
  52 ;       CHRPOS==37      ;CURRENT POSITION ON CURRENT LINE
  53 ;       PAGLN==41       ;LENGTH OF A PAGE
  54 ;       LINPOS==43      ;CURRENT LINE BEING WRITTEN ON
  55 ;       *** THE FOLLOWING FILEDS FOR INPUT ONLY ***
  56
  57 ;       EOFCND==35                      ;GETS EVALUATED  ON EOF
  58 ;       LSTCHR==37      ;BACKUP CHARACTER
  59 ;       BUFRIN==41      ;POINTER TO BUFFER FOR TTY FLAVOR DEVICES
  60
  61
  62 ;CHANLNT==42    ;LENGTH OF A CHANNEL OBJECT
  63
  64 ;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME
  65
  66         CHANLNT==1                      ;INITIAL CHANNEL LENGTH
  67
  68 ; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS
  69
  70 PROCHN:
  71
  72 IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR],[DEVICE,CHSTR],[NAME1,CHSTR],[NAME2,CHSTR]
  73 [SNAME,CHSTR],[RDEVIC,CHSTR],[RNAME1,CHSTR],[RNAME2,CHSTR],[RSNAME,CHSTR]
  74 [STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX]
  75 [ACCESS,FIX],[RADX,FIX]]
  76
  77         IRP     B,C,[A]
  78                 B==CHANLNT
  79                 T!C,,0
  80                 0
  81                 .ISTOP
  82                 TERMIN
  83         CHANLNT==CHANLNT+2
  84 TERMIN
  85
  86
  87 ; EQUIVALANCES FOR INPUT CHANNELS
  88
  89 EOFCND==LINLN
  90 LSTCH==CHRPOS
  91 BUFRIN==PAGLN
  92
  93 ;PRESET LINE LENGTH AND PAGE LENGTH
  94
  95 ZZZ==.  ;SAVE CURRENT LOCATION
  96
  97 LOC PROCHN+RADX
  98 10.
  99
 100 LOC PROCHN+LINLN
 101 TTYLNL                          ;USE TTY LINE LENGTH
 102
 103 LOC PROCHN+PAGLN
 104 TTYPGL  ;USE TTY PAGE LENGTH
 105
 106 LOC ZZZ ;RESET LOCATIN
 107 CHANLNT==CHANLNT-1
 108
 109
 110 INBIT==0        ;LH BITS FOR INPUT
 111 OUTBIT==1       ;AND FOR OUTPUT
 112
 113 ;PAGE AND LINE LENGTH FOR TTY
 114
 115 TTYLNL==80.
 116 TTYPGL==60.
 117
 118 ;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS
 119
 120 IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,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,OPEN,CLOSE,IOT,ILOOKU,6TOCHS,ICLOS,OCLOS
 130 .GLOBAL OPNCHN,CHMAK,READC,TYO,RADX,SYSCHR,BRFCHR,LSTCH
 131 .GLOBAL CHRWRD
 132
 133 .GLOBAL DISOPN,DISCLS,DCHAR,DISLNL,DISPGL,CHANL0,BUFRIN,IOIN2
 134 .GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP
 135
 136 \f;SUBROUTINE TO DO OPENING BEGINS HERE
 137
 138 MFUNCTION FOPEN,SUBR,[OPEN]
 139
 140         ENTRY
 141         PUSHJ   P,MAKCHN        ;MAKE THE CHANNEL
 142         PUSHJ   P,OPNCHN        ;NOW OPEN IT
 143         JRST    FINIS
 144
 145 ; SUBROUTINE TO JUST CREATE A CHANNEL
 146
 147 MFUNCTION CHANNEL,SUBR
 148
 149         ENTRY
 150         PUSHJ   P,MAKCHN
 151         JRST    FINIS
 152 ;INTERNAL CHANNEL CREATOR
 153
 154
 155 MAKCHN:
 156
 157 ; CYCLE THROUGH THE GIVEN ARGUMENTS
 158
 159         MOVSI   A,-5            ;NUMBER OF ARGUMENTS INTO A
 160 ARGLP:  JUMPGE  AB,ARGDON       ;IF AB>=0, NO MORE ARGS
 161         HLRZ    C,(AB)          ;CHECK THE TYPE
 162         CAIN    C,TCHRS         ;MUST BE AN CHRS
 163         JRST    ARGWIN
 164         CAIE    C,TCHSTR
 165         JRST    WRONGT
 166 ARGWIN: PUSH    TP,(AB)         ;NOW TO TEMPS
 167         PUSH    TP,1(AB)
 168         ADD     AB,[2,,2]       ;BUMP ARGG POINTER
 169         AOBJN   A,ARGLP         ;CYCLE
 170
 171 ;NOW PUSH ANY MORE GOODIES FOR DEFAULTS
 172
 173 ARGDON:
 174         MOVEI   A,(A)           ;GET NUMBER DONE
 175         CAIN    A,5             ;FINISHED?
 176         JRST    GETCHN          ;YES
 177         LSH     A,1
 178         CAIE    A,2             ;WASONLY DIRECTION GIVEN?
 179         JRST    DFLTAB(A)       ;NO
 180         MOVEI   B,-1(TP)        ;PICK UP DIRECTION
 181         PUSHJ   P,CHRWRD        ;GET WORD
 182         JRST    WRONGT
 183         CAMN    B,CHQUOTE READ
 184         JRST    DFLTB1          ;YES,GO PUSH 'INPUT'
 185         PUSH    TP,$TCHSTR
 186         PUSH    TP,CHQUOTE OUTPUT
 187         JRST    DFLTB2
 188
 189 DFLTAB: PUSH    TP,$TCHSTR      ;DEFAULT DIRECTION
 190         PUSH    TP,CHQUOTE READ
 191 DFLTB1: PUSH    TP,$TCHSTR      ;DEFAULT NAME1
 192         PUSH    TP,CHQUOTE INPUT
 193 DFLTB2: PUSH    TP,$TCHSTR      ;DEFAULT NAME2
 194         PUSH    TP,CHQUOTE MUDDLE
 195         PUSH    TP,$TCHSTR      ;DEFAULT DEVICE
 196         PUSH    TP,CHQUOTE DSK
 197         .SUSET  [.RSNAM,,A]
 198         PUSHJ   P,6TOCHS
 199         PUSH    TP,A
 200         PUSH    TP,B            ;AND DEFAULT SYS NAME
 201
 202 GETCHN: PUSH    TP,$TFIX        ;SETUP CALL TO VECTOR
 203         PUSH    TP,[CHANLN_-1]
 204         MCALL   1,VECTOR        ;GO GET STORAGE
 205         HRLI    C,PROCHN        ;SETUP FOR BLT
 206         HRRI    C,(B)
 207         BLT     C,CHANLNT-1(B)  ;BLT IN THE TYPES
 208         MOVE    A,(TB)          ;GET TYPE
 209         MOVEM   A,DIRECT-1(B)   ;AND CLOBBER
 210         MOVE    A,1(TB)         ;GET THE DIRECTION
 211         MOVEM   A,DIRECT(B)     ;STORE IT
 212         MOVE    A,2(TB)         ;TYPE FIRST
 213         MOVEM   A,NAME1-1(B)
 214         MOVEM   A,RNAME1-1(B)
 215         MOVE    A,3(TB)         ;GET NAME1
 216         MOVEM   A,NAME1(B)
 217         MOVEM   A,RNAME1(B)     ;ALSO REAL NAME 1
 218         MOVE    A,4(TB)         ;TYPE
 219         MOVEM   A,NAME2-1(B)
 220         MOVEM   A,RNAME2-1(B)
 221         MOVE    A,5(TB)         ;MAME 2
 222         MOVEM   A,NAME2(B)
 223         MOVEM   A,RNAME2(B)     ;ALSO REAL NAME 2
 224         MOVE    A,6(TB)
 225         MOVEM   A,DEVICE-1(B)
 226         MOVEM   A,RDEVICE-1(B)
 227         MOVE    A,7(TB)         ;GET DEVICE NAME
 228         MOVEM   A,DEVICE(B)
 229         MOVEM   A,RDEVIC(B)
 230         MOVE    A,10(TB)
 231         MOVEM   A,SNAME-1(B)
 232         MOVEM   A,RSNAME-1(B)
 233         MOVE    A,11(TB)        ;FINALLY UNAME
 234         MOVEM   A,SNAME(B)
 235         MOVEM   A,RSNAME(B)
 236         SUB     TP,[10.,,10.]   ;GARBAGE COLLECT TP
 237         MOVSI   A,TCHAN         ;MAKE TYPE INTO CHANNEL
 238         POPJ    P,              ;RETURN
 239
 240 \f;OPEN THE CHANNEL POINTED TO BY B
 241
 242 OPNCHN: PUSH    TP,$TCHAN       ;SAVE THE CHANNEL
 243         PUSH    TP,B
 244         MOVEI   B,DIRECT-1(B)   ;POINT TO DIRECTION
 245         PUSHJ   P,CHRWRD        ;PUT INTO A WORD
 246         JFCL
 247         MOVE    E,B             ;TO E
 248         MOVE    B,(TP)
 249         MOVE    A,DEVICE-1(B)   ;GET DEVICE
 250         MOVE    B,DEVICE(B)
 251         PUSHJ   P,STRTO6        ;CONVERT TO 6-BIT
 252         HLRZS   A,(P)           ;DEVICE TO RH
 253         CAIN    A,(SIXBIT /E&S/)        ;DISPLAY HACK?
 254         JRST    DISCHK          ;YES, GO HACK
 255         MOVE    B,(TP)          ;RESTORE B
 256         MOVE    A,NAME1-1(B)    ;TYPE OF NAME1
 257         MOVE    B,NAME1(B)      ;GET THE FIRST NAME
 258         PUSHJ   P,STRTO6        ;TO 6-BIT
 259         MOVE    B,(TP)          ;RESTORE B
 260         MOVE    A,NAME2-1(B)
 261         MOVE    B,NAME2(B)      ;SECOND NAME
 262         PUSHJ   P,STRTO6        ;ALSO TO 6 BIT
 263         MOVE    B,(TP)
 264         MOVSI   A,INBIT         ;GET BIT FOR INPUT OPEN
 265         CAME    E,[ASCII /READ/]        ;REALLY INPUT?
 266         MOVSI   A,OUTBIT        ;NO GET OUTPUT BIT
 267         IORM    A,-2(P)         ;INTO OPEN STUFF
 268         MOVE    A,SNAME-1(B)
 269         MOVE    B,SNAME(B)      ;GOBBLE SNAME
 270         PUSHJ   P,STRTO6        ;6 BIT
 271         POP     P,A             ;RESTORE RESULT
 272         .SUSET  [.SSNAM,,A]     ;SET THE SYSTEM NAME
 273         MOVEI   A,-2(P)         ;POINT TO OPEN BLOCK
 274         PUSHJ   P,OPEN          ;DO THE OPEN
 275         JRST    OPNFAI          ;OPEN FAILED, LOSE
 276         MOVE    B,(TP)          ;RESTORE B
 277         PUSHJ   P,DOSTAT        ;GOBBLE THE STATUS
 278         LDB     C,[600,,STATUS(B)]      ;GOBBLE STATUS
 279         CAMN    E,[ASCII /PRINT/]
 280         CAIE    C,2             ;SKIP IF DATAPOINT CROCK
 281         JRST    OPNCH2          ;NOT SAME FOR OUTPUT
 282
 283         PUSHJ   P,CLOSE         ;CLOSE THE FILE
 284         MOVSI   A,OUTBIT+20     ;AND RE-OPEN IN DISPLAY MODE
 285         HLLM    A,-2(P)
 286         MOVEI   A,-2(P)         ;POINT TO OPEN BLOCK
 287         PUSHJ   P,OPEN          ;NOW OPEN THE DEVICE
 288         JRST    OPNFAI          ;CANT OPEN
 289
 290 OPNCH2: SUB     P,[3,,3]        ;REMOVE OPEN BLOCK
 291         MOVEM   A,CHANNO(B)     ;RESTORE CHANNEL NUMBER
 292         MOVEI   D,(A)           ;COPY CHANNEL NO.
 293         LSH     D,1
 294         ADDI    D,CHANL0+1(TVP) ;POINT TO THIS CHANNELS TV ENTRY
 295         MOVEM   B,(D)
 296         HRLZS   A               ;CHANNEL NO. TO LH
 297         MOVE    C,A             ;COPY TO C
 298         ROT     C,5             ;INTO C'S AC FILED
 299         IOR     C,[.IOT 0,A]    ;AND AN I/O INSTRUCTION
 300         MOVEM   C,IOINS(B)      ;SAVE IN CHANNEL
 301 ; THIS CODES SETS THE 'REAL' NAMES, DEVICES AND SNAMES
 302
 303         HRRI    A,1(P)          ;POINT INTO P
 304         MOVEI   C,(A)           ;C ALSO POINTS
 305         ADD     P,[5,,5]        ;ALLOCATE SOME P
 306         JUMPGE  P,[.VALUE [ASCIZ 'P/']] ;DIE ON PDL LOSSAGE
 307         .RCHST  A,              ;READ THE STATUS
 308         HRLZS   (C)             ;FOR NOW KILL LH OF DEVICE
 309         HRLI    C,-5            ;5 GOODIES
 310         PUSH    P,C
 311         PUSH    P,[0]           ;USED AS A COUNTER
 312 NXTREL: MOVEM   C,-1(P)         ;SAVE C
 313         SKIPN   A,(C)           ;WAS THIS ONE GIVEN?
 314         JRST    NXTLOK          ;NO, SKIP CHANGE
 315         PUSHJ   P,6TOCHS        ;YES, MAKE INTO ATOM
 316         MOVEI   C,RDTBL         ;FIND OUT WHERE
 317         ADD     C,(P)           ;FOR THIS ONE
 318         MOVE    C,(C)           ;NOW HAVE TH OFFSET TO USE
 319         ADD     C,(TP)          ;ADD TO POINTER
 320         MOVEM   A,-1(C)
 321         MOVEM   B,(C)           ;CLOBBER THE NEW ATOM IN
 322         MOVE    C,-1(P)         ;RESTORE C
 323 NXTLOK: AOS     (P)             ;COUNT THE GOODIES
 324         AOBJN   C,NXTREL
 325
 326         SUB     P,[7,,7]        ;GC ON P
 327
 328 ; DETERMIN EIF THIS IS A TTY FLAVOR DEVICE
 329
 330         MOVE    B,(TP)          ;RESTORE CHANEL POINTER
 331         MOVE    A,STATUS(B)     ;GET STATUS
 332         ANDI    A,77            ;ISOLATE DEVICE SPEC
 333         CAMN    E,[ASCIZ /READ/]
 334         CAILE   A,2             ;NOT A TTY, NO FURTHER ACTION
 335         JRST    OPNRET
 336
 337         PUSH    TP,$TFIX        ;CALL UVECTOR FOR BUFFER
 338         PUSH    TP,[EXTBFR]
 339         MCALL   1,UVECTOR       ;GET VECTOR
 340         MOVE    C,[PUSHJ P,READC]       ;GET NEW IOINS
 341         MOVE    D,(TP)          ;RESTORE CHANNEL POINTER
 342         EXCH    C,IOINS(D)      ;STORE NEW ONE AND GE OLD
 343         MOVEM   C,IOIN2(B)      ;STORE
 344         MOVEM   B,BUFRIN(D)     ;STORE IN CHANNEL
 345         MOVSI   A,TUVEC         ;MAKE SURE TYPE IS UNIFORM VECTOR
 346         MOVEM   A,BUFRIN-1(D)
 347         MOVEI   A,177           ;SET ERASER TO RUBOUT
 348         MOVEM   A,ERASCH(B)
 349         SETOM   KILLCH(B)       ;NO KILL CHARACTER NEEDED
 350         MOVEI   A,33            ;BREAKCHR TO C.R.
 351         MOVEM   A,BRKCH(B)
 352         MOVEI   A,"\            ;ESCAPER TO \
 353         MOVEM   A,ESCAP(B)
 354         MOVE    A,[010700,,BYTPTR(B)]   ;RELATIVE BYTE POINTER
 355         MOVEM   A,BYTPTR(B)
 356         MOVEI   A,14            ;BARF BACK CHARACTER FF
 357         MOVEM   A,BRFCHR(B)
 358
 359 OPNRET: POP     TP,B            ;GET CHANNEL POINTER BACK
 360
 361         POP     TP,A            ;RESTORE TYPE OF CHANNEL
 362         POPJ    P,
 363
 364
 365 ;TABLE USED TO DO THE 'REAL GOODIES'
 366
 367 RDTBL:  RDEVIC
 368         RNAME1
 369         RNAME2
 370         RSNAME
 371         ACCESS
 372
 373
 374 ;HERE TO DO STATUS FOR OPEN LOSSAGE ETC.
 375
 376 DOSTAT: PUSH    P,A             ;SAVE CHANNEL
 377         ROT     A,23.           ;INTO AC FILED
 378         IOR     A,[.STATUS STATUS(B)]   ;GOBBLE THE STATUS
 379         XCT     A               ;DO IT
 380         POP     P,A
 381         POPJ    P,
 382
 383
 384 ;MAKE THE DISPLAY DEVICE  A PSEUDO DEVICE HANDLED BY "DCHAR" ROUTINE
 385 DISCHK: SUB     P,[1,,1]        ;POP OFF JUNK
 386         MOVE    B,(TP)          ;GET POINTER TO CHANNEL
 387         SETZM   CHANNO(B)       ;A PSEUDO CHANNEL NUMBER
 388         MOVE    C,[PUSHJ  P,DCHAR]
 389         MOVEM   C,IOINS(B)      ;GO TO THIS ROUTINE TO HANDLE I/O
 390         MOVEI   C,DISLNL
 391         MOVEM   C,LINLN(B)
 392         MOVEI   C,DISPGL
 393         MOVEM   C,PAGLN(B)
 394         PUSHJ   P,DISOPN        ;GO INITIALIZE THE DISPLAY
 395         JRST    OPNFAI
 396         JRST    OPNRET
 397 \f
 398 ;ARRIVE HERE IF FOPEN CALLED WITH WRONG TYPES OF ARGUMENTS
 399
 400 WRONGT: PUSH    TP,$TATOM       ;SET UP CALL TO ERROR
 401         PUSH    TP,MQUOTE WRONG-TYPE
 402         JRST    CALER1
 403
 404
 405 ;THIS ROTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES
 406 STRTO6: PUSH    TP,A
 407         PUSH    TP,B
 408         PUSH    P,E             ;SAVE USEFUL FROB
 409         MOVEI   E,-1(A)         ;GET END+1 OF TCHSTR
 410         HLRZS   A               ;CHECK THE TYPE(ONE WORD OR VECTOR)
 411         CAIE    A,TCHRS         ; IS IT ONE WORD?
 412         JRST    CHREAD          ;NO
 413         MOVEI   B,(TP)          ;YES, CREATE DUMMY VECTOR POINTER
 414         HRLI    B,350700
 415         MOVEI   E,1(TP)         ;AND DUMMY VECTOR END+1
 416 CHREAD: MOVEI   A,0             ;INITIALIZE OUTPUT WORD
 417         MOVE    D,[440600,,A]   ;AND BYTE POINTER TO IT
 418         LDB     0,B             ;PICK UP FIRST CHARACTER
 419 NEXCHR:
 420         JUMPE   0,SIXDON        ;IF NULL, WE ARE FINISHED
 421         CAIL    0,141           ;IF IT IS GREATER OR EQUAL TO LOWER A
 422         CAILE   0,172           ;BUT LESS THAN OR EQUAL TO LOWER Z
 423         JRST    .+2             ;THEN
 424         SUBI    0,40            ;CONVERT TO UPPER CASE
 425         SUBI    0,40            ;NOW TO SIX BIT
 426         JUMPLE  0,BAD6          ;CHECK FOR A WINNER
 427         CAILE   0,77
 428         JRST    BAD6
 429         IDPB    0,D             ;DEPOSIT INTO SIX BIT
 430         TRNE    A,77            ;IS OUTPUT FULL
 431         JRST    SIXDON          ;YES, LEAVE
 432         ILDB    0,B             ;GET NEXT CHAR AND INC POINTER
 433         HRRZ    C,B             ;GET ADDRESS PART OF BYTE POINTER
 434         CAME    C,E             ;HAS POINTER REACHED LIMIT?
 435         JRST    NEXCHR          ;NO, GOBBLE NEXT CHARACTER
 436 SIXDON: SUB     TP,[2,,2]       ;FIX UP TP
 437         POP     P,E
 438         EXCH    A,(P)           ;LEAVE RESULT ON P-STACK
 439         JRST    (A)             ;NOW RETURN
 440
 441
 442 ;SUBROUTINE TO CONVERT SIXBIT TO ATOM
 443
 444 6TOCHS: PUSH    P,E
 445         MOVEI   B,6             ;MAX NUMBER OF CHARACTERS
 446         PUSH    P,[0]           ;STRING WILL GO ON P SATCK
 447         MOVEI   E,-1(P)         ;WILL BE BYTE POINTER
 448         HRLI    E,10700         ;SET IT UP
 449         PUSH    P,[0]           ;SECOND POSSIBLE WORD
 450         MOVE    D,[440600,,A]   ;INPUT BYTE POINTER
 451 6LOOP:  ILDB    0,D             ;START CHAR GOBBLING
 452         JUMPE   0,GETATM        ;IF ZERO, FINISHED
 453         ADDI    0,40            ;CHANGET TOASCII
 454         IDPB    0,E             ;AND STORE IT
 455         SOJG    B,6LOOP         ;KEEP LOOKING
 456         PUSH    P,[2]           ;IF ARRIVE HERE, STRING IS 2 WORDS
 457         JRST    .+2
 458 GETATM: AOS     (P)             ;SET STRING LENGTH=1
 459         PUSHJ   P,CHMAK         ;MAKE A MUDDLE STRING
 460         POP     P,E
 461         POPJ    P,
 462
 463 \f
 464 ;HERE IF OPEN FAILS
 465
 466 OPNFAI: MOVE    B,(TP)          ;RESTORE CHANNEL POINTER
 467         SETOM   STATUS(B)       ;SET TO -1
 468         JUMPL   A,.+2           ;A<0 MEANS NO CHANNELS
 469         PUSHJ   P,DOSTAT        ;GOBBLE STATUS
 470         SUB     TP,[2,,2]       ;PATCH UP TP
 471         SUB     P,[3,,3]        ;REMOVE CRAP
 472 RETNIL: MOVSI   A,TFALSE        ;RETURN A FALSE
 473         MOVEI   B,0
 474         POPJ    P,
 475
 476 ;ERROR FOR BAD CHARACTER IN SIX BIT STRING
 477
 478 BAD6:   PUSH    TP,$TATOM       ;SETUP ERROR CALL
 479         PUSH    TP,MQUOTE FILE-NAME-NOT-6-BIT
 480         JRST    CALER1
 481
 482
 483 ; FUNCTION TO LIST ALL CHANNELS
 484
 485 MFUNCTION CHANLIST,SUBR
 486
 487         ENTRY   0
 488
 489         MOVEI   A,16.           ;MAX # OF CHANNELS
 490         MOVEI   C,0
 491         MOVEI   B,CHANL0(TVP)   ;POINT TO FIRST
 492
 493 CHNLP:  SKIPN   1(B)            ;OPEN?
 494         JRST    NXTCHN          ;NO, SKIP
 495         PUSH    TP,(B)
 496         PUSH    TP,1(B)
 497         ADDI    C,1             ;COUNT WINNERS
 498 NXTCHN: ADDI    B,2
 499         SOJN    A,CHNLP
 500
 501         ACALL   C,LIST
 502         JRST    FINIS
 503
 504 \f
 505 ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL
 506
 507 MFUNCTION FCLOSE,SUBR,[CLOSE]
 508
 509         ENTRY   1               ;ONLY ONE ARG
 510         HLRZ    A,(AB)          ;CHECK ARGS
 511         CAIE    A,TCHAN         ;IS IT A CHANNEL
 512         JRST    WRONGT
 513         MOVE    B,1(AB)         ;PICK UP THE CHANNEL
 514         CLEARM  IOINS(B)        ;CLOBBER THE IO INS
 515         MOVEI   B,DEVICE-1(B)   ;GE THE NAME OF THE DEVICE
 516         PUSHJ   P,CHRWRD
 517         JFCL
 518         MOVE    A,B
 519         MOVE    B,1(AB)
 520         CAMN    A,[ASCIZ /TTY/] ;IS IT THE TTY?
 521         JRST    TTYCLS          ;YES, DO SPECIAL  HACK
 522         CAMN    A,[ASCIZ /DIS/]
 523         PUSHJ   P,DISCLS        ;GO RELEASE THE DISPLAY SPACE
 524         SKIPE   A,CHANNO(B)     ;IS THERE A CHANNEL NO.?
 525         PUSHJ   P,CLOSE         ;YES, CLOSE IT
 526 CFIN:   SKIPN   A,CHANNO(B)     ;ANY CHANNEL?
 527         JRST    CFIN2
 528         LSH     A,1
 529         ADDI    A,CHANL0+1(TVP) ;POINT TO THIS CHANNELS LSOT
 530         SETZM   CHANNO(B)
 531         SETZM   (A)             ;AND CLOBBER IT
 532 CFIN2:  MOVSI   A,TCHAN         ;RETURN THE CHANNEL
 533         JRST    FINIS
 534
 535 TTYCLS: MOVE    A,DIRECT(B)     ;GET THE DIRECTION OF THE CHANNEL
 536         CAMN    A,CHQUOTE READ, ;IS IT READ
 537         PUSHJ   P,ICLOS         ;YES, CLOSE THAT
 538         CAMN    A,CHQUOTE PRINT,        ;IS IT PEINT
 539         PUSHJ   P,OCLOS         ;YES CLOSE TTY OUT CHANNEL
 540         JRST    CFIN
 541
 542
 543 END
 544
 545 \f\ 3\f