--- /dev/null
+TITLE OPEN - CHANNEL OPENER FOR MUDDLE
+
+RELOCATABLE
+
+;C. REEVE JAN 1971
+
+.INSRT MUDDLE >
+
+;THIS PROGRAM HAS TWO ENTRIES. FOPEN,FCLOSE AND FDELETE.
+;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM.
+
+; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES
+; FIVE OPTINAL ARGUMENTS AS FOLLOWS:
+
+; FOPEN (<DIR>,<FILE NAME1>,<FILE NAME2>,<DEVICE>,<SYSTEM NAME>)
+;
+; <DIR> - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ
+
+; <FILE NAME1> - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT.
+
+; <FILE NAME2> - SECOND FILE NAME. DEFAULT MUDDLE.
+
+; <DEVICE> - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK.
+
+; <SNAME> - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME.
+
+; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL
+
+
+; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES
+
+
+;A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION
+
+; CHANNO==1 ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL.
+; DIRECT==3 ;DIRECTION (EITHER READ OR PRINT)
+; DEVICE==5 ;DEVICE UPON WHICH THE CHANNEL IS OPEN
+; NAME1==7 ;FIRST NAME OF FILE AS OPENED.
+; NAME2==11 ;SECOND NAME OF FILE
+; SNAME==13 ;DIRECTORY NAME
+; RDEVIC==15 ;REAL DEVICE
+; RNAME1=17 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS)
+; RNAME2==21 ;REAL SECOND NAME
+; RSNAME==23 ;SYSTEM OR DIRECTORY NAME
+; STATUS==25 ;VARIOUS STATUS BITS
+; IOINS==27 ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER
+; ACCESS==31 ;ACCESS POINTER FOR RAND ACCESS
+; RADX==33 ;RADIX FOR CHANNELS NUMBER CONVERSION
+; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY ***
+
+; LINLN==35 ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE
+; CHRPOS==37 ;CURRENT POSITION ON CURRENT LINE
+; PAGLN==41 ;LENGTH OF A PAGE
+; LINPOS==43 ;CURRENT LINE BEING WRITTEN ON
+; *** THE FOLLOWING FILEDS FOR INPUT ONLY ***
+
+; EOFCND==35 ;GETS EVALUATED ON EOF
+; LSTCHR==37 ;BACKUP CHARACTER
+; BUFRIN==41 ;POINTER TO BUFFER FOR TTY FLAVOR DEVICES
+
+
+;CHANLNT==42 ;LENGTH OF A CHANNEL OBJECT
+
+;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME
+
+ CHANLNT==1 ;INITIAL CHANNEL LENGTH
+
+; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS
+
+PROCHN:
+
+IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR],[DEVICE,CHSTR],[NAME1,CHSTR],[NAME2,CHSTR]
+[SNAME,CHSTR],[RDEVIC,CHSTR],[RNAME1,CHSTR],[RNAME2,CHSTR],[RSNAME,CHSTR]
+[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX]
+[ACCESS,FIX],[RADX,FIX]]
+
+ IRP B,C,[A]
+ B==CHANLNT
+ T!C,,0
+ 0
+ .ISTOP
+ TERMIN
+ CHANLNT==CHANLNT+2
+TERMIN
+
+
+; EQUIVALANCES FOR INPUT CHANNELS
+
+EOFCND==LINLN
+LSTCH==CHRPOS
+BUFRIN==PAGLN
+
+;PRESET LINE LENGTH AND PAGE LENGTH
+
+ZZZ==. ;SAVE CURRENT LOCATION
+
+LOC PROCHN+RADX
+10.
+
+LOC PROCHN+LINLN
+TTYLNL ;USE TTY LINE LENGTH
+
+LOC PROCHN+PAGLN
+TTYPGL ;USE TTY PAGE LENGTH
+
+LOC ZZZ ;RESET LOCATIN
+CHANLNT==CHANLNT-1
+
+
+INBIT==0 ;LH BITS FOR INPUT
+OUTBIT==1 ;AND FOR OUTPUT
+
+;PAGE AND LINE LENGTH FOR TTY
+
+TTYLNL==80.
+TTYPGL==60.
+
+;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS
+
+IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BYTPTR]
+A==.IRPCNT
+TERMIN
+
+EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER
+
+
+
+
+.GLOBAL IPNAME,OPEN,CLOSE,IOT,ILOOKU,6TOCHS,ICLOS,OCLOS
+.GLOBAL OPNCHN,CHMAK,READC,TYO,RADX,SYSCHR,BRFCHR,LSTCH
+.GLOBAL CHRWRD
+
+.GLOBAL DISOPN,DISCLS,DCHAR,DISLNL,DISPGL,CHANL0,BUFRIN,IOIN2
+.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP
+
+\f;SUBROUTINE TO DO OPENING BEGINS HERE
+
+MFUNCTION FOPEN,SUBR,[OPEN]
+
+ ENTRY
+ PUSHJ P,MAKCHN ;MAKE THE CHANNEL
+ PUSHJ P,OPNCHN ;NOW OPEN IT
+ JRST FINIS
+
+; SUBROUTINE TO JUST CREATE A CHANNEL
+
+MFUNCTION CHANNEL,SUBR
+
+ ENTRY
+ PUSHJ P,MAKCHN
+ JRST FINIS
+;INTERNAL CHANNEL CREATOR
+
+
+MAKCHN:
+
+; CYCLE THROUGH THE GIVEN ARGUMENTS
+
+ MOVSI A,-5 ;NUMBER OF ARGUMENTS INTO A
+ARGLP: JUMPGE AB,ARGDON ;IF AB>=0, NO MORE ARGS
+ HLRZ C,(AB) ;CHECK THE TYPE
+ CAIN C,TCHRS ;MUST BE AN CHRS
+ JRST ARGWIN
+ CAIE C,TCHSTR
+ JRST WRONGT
+ARGWIN: PUSH TP,(AB) ;NOW TO TEMPS
+ PUSH TP,1(AB)
+ ADD AB,[2,,2] ;BUMP ARGG POINTER
+ AOBJN A,ARGLP ;CYCLE
+
+;NOW PUSH ANY MORE GOODIES FOR DEFAULTS
+
+ARGDON:
+ MOVEI A,(A) ;GET NUMBER DONE
+ CAIN A,5 ;FINISHED?
+ JRST GETCHN ;YES
+ LSH A,1
+ CAIE A,2 ;WASONLY DIRECTION GIVEN?
+ JRST DFLTAB(A) ;NO
+ MOVEI B,-1(TP) ;PICK UP DIRECTION
+ PUSHJ P,CHRWRD ;GET WORD
+ JRST WRONGT
+ CAMN B,CHQUOTE READ
+ JRST DFLTB1 ;YES,GO PUSH 'INPUT'
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE OUTPUT
+ JRST DFLTB2
+
+DFLTAB: PUSH TP,$TCHSTR ;DEFAULT DIRECTION
+ PUSH TP,CHQUOTE READ
+DFLTB1: PUSH TP,$TCHSTR ;DEFAULT NAME1
+ PUSH TP,CHQUOTE INPUT
+DFLTB2: PUSH TP,$TCHSTR ;DEFAULT NAME2
+ PUSH TP,CHQUOTE MUDDLE
+ PUSH TP,$TCHSTR ;DEFAULT DEVICE
+ PUSH TP,CHQUOTE DSK
+ .SUSET [.RSNAM,,A]
+ PUSHJ P,6TOCHS
+ PUSH TP,A
+ PUSH TP,B ;AND DEFAULT SYS NAME
+
+GETCHN: PUSH TP,$TFIX ;SETUP CALL TO VECTOR
+ PUSH TP,[CHANLN_-1]
+ MCALL 1,VECTOR ;GO GET STORAGE
+ HRLI C,PROCHN ;SETUP FOR BLT
+ HRRI C,(B)
+ BLT C,CHANLNT-1(B) ;BLT IN THE TYPES
+ MOVE A,(TB) ;GET TYPE
+ MOVEM A,DIRECT-1(B) ;AND CLOBBER
+ MOVE A,1(TB) ;GET THE DIRECTION
+ MOVEM A,DIRECT(B) ;STORE IT
+ MOVE A,2(TB) ;TYPE FIRST
+ MOVEM A,NAME1-1(B)
+ MOVEM A,RNAME1-1(B)
+ MOVE A,3(TB) ;GET NAME1
+ MOVEM A,NAME1(B)
+ MOVEM A,RNAME1(B) ;ALSO REAL NAME 1
+ MOVE A,4(TB) ;TYPE
+ MOVEM A,NAME2-1(B)
+ MOVEM A,RNAME2-1(B)
+ MOVE A,5(TB) ;MAME 2
+ MOVEM A,NAME2(B)
+ MOVEM A,RNAME2(B) ;ALSO REAL NAME 2
+ MOVE A,6(TB)
+ MOVEM A,DEVICE-1(B)
+ MOVEM A,RDEVICE-1(B)
+ MOVE A,7(TB) ;GET DEVICE NAME
+ MOVEM A,DEVICE(B)
+ MOVEM A,RDEVIC(B)
+ MOVE A,10(TB)
+ MOVEM A,SNAME-1(B)
+ MOVEM A,RSNAME-1(B)
+ MOVE A,11(TB) ;FINALLY UNAME
+ MOVEM A,SNAME(B)
+ MOVEM A,RSNAME(B)
+ SUB TP,[10.,,10.] ;GARBAGE COLLECT TP
+ MOVSI A,TCHAN ;MAKE TYPE INTO CHANNEL
+ POPJ P, ;RETURN
+
+\f;OPEN THE CHANNEL POINTED TO BY B
+
+OPNCHN: PUSH TP,$TCHAN ;SAVE THE CHANNEL
+ PUSH TP,B
+ MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION
+ PUSHJ P,CHRWRD ;PUT INTO A WORD
+ JFCL
+ MOVE E,B ;TO E
+ MOVE B,(TP)
+ MOVE A,DEVICE-1(B) ;GET DEVICE
+ MOVE B,DEVICE(B)
+ PUSHJ P,STRTO6 ;CONVERT TO 6-BIT
+ HLRZS A,(P) ;DEVICE TO RH
+ CAIN A,(SIXBIT /E&S/) ;DISPLAY HACK?
+ JRST DISCHK ;YES, GO HACK
+ MOVE B,(TP) ;RESTORE B
+ MOVE A,NAME1-1(B) ;TYPE OF NAME1
+ MOVE B,NAME1(B) ;GET THE FIRST NAME
+ PUSHJ P,STRTO6 ;TO 6-BIT
+ MOVE B,(TP) ;RESTORE B
+ MOVE A,NAME2-1(B)
+ MOVE B,NAME2(B) ;SECOND NAME
+ PUSHJ P,STRTO6 ;ALSO TO 6 BIT
+ MOVE B,(TP)
+ MOVSI A,INBIT ;GET BIT FOR INPUT OPEN
+ CAME E,[ASCII /READ/] ;REALLY INPUT?
+ MOVSI A,OUTBIT ;NO GET OUTPUT BIT
+ IORM A,-2(P) ;INTO OPEN STUFF
+ MOVE A,SNAME-1(B)
+ MOVE B,SNAME(B) ;GOBBLE SNAME
+ PUSHJ P,STRTO6 ;6 BIT
+ POP P,A ;RESTORE RESULT
+ .SUSET [.SSNAM,,A] ;SET THE SYSTEM NAME
+ MOVEI A,-2(P) ;POINT TO OPEN BLOCK
+ PUSHJ P,OPEN ;DO THE OPEN
+ JRST OPNFAI ;OPEN FAILED, LOSE
+ MOVE B,(TP) ;RESTORE B
+ PUSHJ P,DOSTAT ;GOBBLE THE STATUS
+ LDB C,[600,,STATUS(B)] ;GOBBLE STATUS
+ CAMN E,[ASCII /PRINT/]
+ CAIE C,2 ;SKIP IF DATAPOINT CROCK
+ JRST OPNCH2 ;NOT SAME FOR OUTPUT
+
+ PUSHJ P,CLOSE ;CLOSE THE FILE
+ MOVSI A,OUTBIT+20 ;AND RE-OPEN IN DISPLAY MODE
+ HLLM A,-2(P)
+ MOVEI A,-2(P) ;POINT TO OPEN BLOCK
+ PUSHJ P,OPEN ;NOW OPEN THE DEVICE
+ JRST OPNFAI ;CANT OPEN
+
+OPNCH2: SUB P,[3,,3] ;REMOVE OPEN BLOCK
+ MOVEM A,CHANNO(B) ;RESTORE CHANNEL NUMBER
+ MOVEI D,(A) ;COPY CHANNEL NO.
+ LSH D,1
+ ADDI D,CHANL0+1(TVP) ;POINT TO THIS CHANNELS TV ENTRY
+ MOVEM B,(D)
+ HRLZS A ;CHANNEL NO. TO LH
+ MOVE C,A ;COPY TO C
+ ROT C,5 ;INTO C'S AC FILED
+ IOR C,[.IOT 0,A] ;AND AN I/O INSTRUCTION
+ MOVEM C,IOINS(B) ;SAVE IN CHANNEL
+; THIS CODES SETS THE 'REAL' NAMES, DEVICES AND SNAMES
+
+ HRRI A,1(P) ;POINT INTO P
+ MOVEI C,(A) ;C ALSO POINTS
+ ADD P,[5,,5] ;ALLOCATE SOME P
+ JUMPGE P,[.VALUE [ASCIZ 'P/']] ;DIE ON PDL LOSSAGE
+ .RCHST A, ;READ THE STATUS
+ HRLZS (C) ;FOR NOW KILL LH OF DEVICE
+ HRLI C,-5 ;5 GOODIES
+ PUSH P,C
+ PUSH P,[0] ;USED AS A COUNTER
+NXTREL: MOVEM C,-1(P) ;SAVE C
+ SKIPN A,(C) ;WAS THIS ONE GIVEN?
+ JRST NXTLOK ;NO, SKIP CHANGE
+ PUSHJ P,6TOCHS ;YES, MAKE INTO ATOM
+ MOVEI C,RDTBL ;FIND OUT WHERE
+ ADD C,(P) ;FOR THIS ONE
+ MOVE C,(C) ;NOW HAVE TH OFFSET TO USE
+ ADD C,(TP) ;ADD TO POINTER
+ MOVEM A,-1(C)
+ MOVEM B,(C) ;CLOBBER THE NEW ATOM IN
+ MOVE C,-1(P) ;RESTORE C
+NXTLOK: AOS (P) ;COUNT THE GOODIES
+ AOBJN C,NXTREL
+
+ SUB P,[7,,7] ;GC ON P
+
+; DETERMIN EIF THIS IS A TTY FLAVOR DEVICE
+
+ MOVE B,(TP) ;RESTORE CHANEL POINTER
+ MOVE A,STATUS(B) ;GET STATUS
+ ANDI A,77 ;ISOLATE DEVICE SPEC
+ CAMN E,[ASCIZ /READ/]
+ CAILE A,2 ;NOT A TTY, NO FURTHER ACTION
+ JRST OPNRET
+
+ PUSH TP,$TFIX ;CALL UVECTOR FOR BUFFER
+ PUSH TP,[EXTBFR]
+ MCALL 1,UVECTOR ;GET VECTOR
+ MOVE C,[PUSHJ P,READC] ;GET NEW IOINS
+ MOVE D,(TP) ;RESTORE CHANNEL POINTER
+ EXCH C,IOINS(D) ;STORE NEW ONE AND GE OLD
+ MOVEM C,IOIN2(B) ;STORE
+ MOVEM B,BUFRIN(D) ;STORE IN CHANNEL
+ MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR
+ MOVEM A,BUFRIN-1(D)
+ MOVEI A,177 ;SET ERASER TO RUBOUT
+ MOVEM A,ERASCH(B)
+ SETOM KILLCH(B) ;NO KILL CHARACTER NEEDED
+ MOVEI A,33 ;BREAKCHR TO C.R.
+ MOVEM A,BRKCH(B)
+ MOVEI A,"\ ;ESCAPER TO \
+ MOVEM A,ESCAP(B)
+ MOVE A,[010700,,BYTPTR(B)] ;RELATIVE BYTE POINTER
+ MOVEM A,BYTPTR(B)
+ MOVEI A,14 ;BARF BACK CHARACTER FF
+ MOVEM A,BRFCHR(B)
+
+OPNRET: POP TP,B ;GET CHANNEL POINTER BACK
+
+ POP TP,A ;RESTORE TYPE OF CHANNEL
+ POPJ P,
+
+
+;TABLE USED TO DO THE 'REAL GOODIES'
+
+RDTBL: RDEVIC
+ RNAME1
+ RNAME2
+ RSNAME
+ ACCESS
+
+
+;HERE TO DO STATUS FOR OPEN LOSSAGE ETC.
+
+DOSTAT: PUSH P,A ;SAVE CHANNEL
+ ROT A,23. ;INTO AC FILED
+ IOR A,[.STATUS STATUS(B)] ;GOBBLE THE STATUS
+ XCT A ;DO IT
+ POP P,A
+ POPJ P,
+
+
+;MAKE THE DISPLAY DEVICE A PSEUDO DEVICE HANDLED BY "DCHAR" ROUTINE
+DISCHK: SUB P,[1,,1] ;POP OFF JUNK
+ MOVE B,(TP) ;GET POINTER TO CHANNEL
+ SETZM CHANNO(B) ;A PSEUDO CHANNEL NUMBER
+ MOVE C,[PUSHJ P,DCHAR]
+ MOVEM C,IOINS(B) ;GO TO THIS ROUTINE TO HANDLE I/O
+ MOVEI C,DISLNL
+ MOVEM C,LINLN(B)
+ MOVEI C,DISPGL
+ MOVEM C,PAGLN(B)
+ PUSHJ P,DISOPN ;GO INITIALIZE THE DISPLAY
+ JRST OPNFAI
+ JRST OPNRET
+\f
+;ARRIVE HERE IF FOPEN CALLED WITH WRONG TYPES OF ARGUMENTS
+
+WRONGT: PUSH TP,$TATOM ;SET UP CALL TO ERROR
+ PUSH TP,MQUOTE WRONG-TYPE
+ JRST CALER1
+
+
+;THIS ROTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES
+STRTO6: PUSH TP,A
+ PUSH TP,B
+ PUSH P,E ;SAVE USEFUL FROB
+ MOVEI E,-1(A) ;GET END+1 OF TCHSTR
+ HLRZS A ;CHECK THE TYPE(ONE WORD OR VECTOR)
+ CAIE A,TCHRS ; IS IT ONE WORD?
+ JRST CHREAD ;NO
+ MOVEI B,(TP) ;YES, CREATE DUMMY VECTOR POINTER
+ HRLI B,350700
+ MOVEI E,1(TP) ;AND DUMMY VECTOR END+1
+CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD
+ MOVE D,[440600,,A] ;AND BYTE POINTER TO IT
+ LDB 0,B ;PICK UP FIRST CHARACTER
+NEXCHR:
+ JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED
+ CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A
+ CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z
+ JRST .+2 ;THEN
+ SUBI 0,40 ;CONVERT TO UPPER CASE
+ SUBI 0,40 ;NOW TO SIX BIT
+ JUMPLE 0,BAD6 ;CHECK FOR A WINNER
+ CAILE 0,77
+ JRST BAD6
+ IDPB 0,D ;DEPOSIT INTO SIX BIT
+ TRNE A,77 ;IS OUTPUT FULL
+ JRST SIXDON ;YES, LEAVE
+ ILDB 0,B ;GET NEXT CHAR AND INC POINTER
+ HRRZ C,B ;GET ADDRESS PART OF BYTE POINTER
+ CAME C,E ;HAS POINTER REACHED LIMIT?
+ JRST NEXCHR ;NO, GOBBLE NEXT CHARACTER
+SIXDON: SUB TP,[2,,2] ;FIX UP TP
+ POP P,E
+ EXCH A,(P) ;LEAVE RESULT ON P-STACK
+ JRST (A) ;NOW RETURN
+
+
+;SUBROUTINE TO CONVERT SIXBIT TO ATOM
+
+6TOCHS: PUSH P,E
+ MOVEI B,6 ;MAX NUMBER OF CHARACTERS
+ PUSH P,[0] ;STRING WILL GO ON P SATCK
+ MOVEI E,-1(P) ;WILL BE BYTE POINTER
+ HRLI E,10700 ;SET IT UP
+ PUSH P,[0] ;SECOND POSSIBLE WORD
+ MOVE D,[440600,,A] ;INPUT BYTE POINTER
+6LOOP: ILDB 0,D ;START CHAR GOBBLING
+ JUMPE 0,GETATM ;IF ZERO, FINISHED
+ ADDI 0,40 ;CHANGET TOASCII
+ IDPB 0,E ;AND STORE IT
+ SOJG B,6LOOP ;KEEP LOOKING
+ PUSH P,[2] ;IF ARRIVE HERE, STRING IS 2 WORDS
+ JRST .+2
+GETATM: AOS (P) ;SET STRING LENGTH=1
+ PUSHJ P,CHMAK ;MAKE A MUDDLE STRING
+ POP P,E
+ POPJ P,
+
+\f
+;HERE IF OPEN FAILS
+
+OPNFAI: MOVE B,(TP) ;RESTORE CHANNEL POINTER
+ SETOM STATUS(B) ;SET TO -1
+ JUMPL A,.+2 ;A<0 MEANS NO CHANNELS
+ PUSHJ P,DOSTAT ;GOBBLE STATUS
+ SUB TP,[2,,2] ;PATCH UP TP
+ SUB P,[3,,3] ;REMOVE CRAP
+RETNIL: MOVSI A,TFALSE ;RETURN A FALSE
+ MOVEI B,0
+ POPJ P,
+
+;ERROR FOR BAD CHARACTER IN SIX BIT STRING
+
+BAD6: PUSH TP,$TATOM ;SETUP ERROR CALL
+ PUSH TP,MQUOTE FILE-NAME-NOT-6-BIT
+ JRST CALER1
+
+
+; FUNCTION TO LIST ALL CHANNELS
+
+MFUNCTION CHANLIST,SUBR
+
+ ENTRY 0
+
+ MOVEI A,16. ;MAX # OF CHANNELS
+ MOVEI C,0
+ MOVEI B,CHANL0(TVP) ;POINT TO FIRST
+
+CHNLP: SKIPN 1(B) ;OPEN?
+ JRST NXTCHN ;NO, SKIP
+ PUSH TP,(B)
+ PUSH TP,1(B)
+ ADDI C,1 ;COUNT WINNERS
+NXTCHN: ADDI B,2
+ SOJN A,CHNLP
+
+ ACALL C,LIST
+ JRST FINIS
+
+\f
+;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL
+
+MFUNCTION FCLOSE,SUBR,[CLOSE]
+
+ ENTRY 1 ;ONLY ONE ARG
+ HLRZ A,(AB) ;CHECK ARGS
+ CAIE A,TCHAN ;IS IT A CHANNEL
+ JRST WRONGT
+ MOVE B,1(AB) ;PICK UP THE CHANNEL
+ CLEARM IOINS(B) ;CLOBBER THE IO INS
+ MOVEI B,DEVICE-1(B) ;GE THE NAME OF THE DEVICE
+ PUSHJ P,CHRWRD
+ JFCL
+ MOVE A,B
+ MOVE B,1(AB)
+ CAMN A,[ASCIZ /TTY/] ;IS IT THE TTY?
+ JRST TTYCLS ;YES, DO SPECIAL HACK
+ CAMN A,[ASCIZ /DIS/]
+ PUSHJ P,DISCLS ;GO RELEASE THE DISPLAY SPACE
+ SKIPE A,CHANNO(B) ;IS THERE A CHANNEL NO.?
+ PUSHJ P,CLOSE ;YES, CLOSE IT
+CFIN: SKIPN A,CHANNO(B) ;ANY CHANNEL?
+ JRST CFIN2
+ LSH A,1
+ ADDI A,CHANL0+1(TVP) ;POINT TO THIS CHANNELS LSOT
+ SETZM CHANNO(B)
+ SETZM (A) ;AND CLOBBER IT
+CFIN2: MOVSI A,TCHAN ;RETURN THE CHANNEL
+ JRST FINIS
+
+TTYCLS: MOVE A,DIRECT(B) ;GET THE DIRECTION OF THE CHANNEL
+ CAMN A,CHQUOTE READ, ;IS IT READ
+ PUSHJ P,ICLOS ;YES, CLOSE THAT
+ CAMN A,CHQUOTE PRINT, ;IS IT PEINT
+ PUSHJ P,OCLOS ;YES CLOSE TTY OUT CHANNEL
+ JRST CFIN
+
+
+END
+
+\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff