--- /dev/null
+TITLE IPC -- IPC COMMUNICATIONS HANDLER FOR MUDDLE
+
+RELOCATABLE
+
+; N. RYAN October 1973
+
+.INSRT MUDDLE >
+
+;THIS PROGRAM HAS ENTRIES SEND, SEND-WAIT, IPC-OFF,
+; AND IPC-HANDLER.
+
+;THESE HANDLE THE IPC DEVICE.
+
+;SEND AND SEND-WAIT SEND OUT A MESSAGE ON THE IPC DEVICE.
+;THEY TAKE 6 ARGUMENTS, THE FIRST THREE OF WHICH ARE NECESSARY
+
+; SEND (<HISNAME1> <HISNAME2> <MESSAGE> <MESSAGE-TYPE> <MYNAME1> <MYNAME2>)
+
+; <HISNAME1> -- STRING USED AS SIXBIT FOR NAME 1
+; <HISNAME2> -- STRING USED AS SIXBIT FOR NAME 2
+; <MESSAGE> -- THE MESSAGE TO SEND, EITHER A STRING OR A UVECTOR OF TYPE WORD
+; <TYPE> -- THE TYPECODE TO SEND, A FIXED NUMBER, DEFAULT 0
+; <MYNAME1> -- STRING USED AS SIXBIT FOR MY NAME 1
+; <MYNAME2> -- STRING USED AS SIXBIT FOR MY NAME 2
+
+; SEND -- TRIES TO SEND IMMEDIATELY, ELSE RETURNS FALSE WITH MESSAGE
+; SEND-WAIT -- HANGS UNTIL MESSAGE CAN BE SENT
+
+; IPC-OFF -- NO ARGUMENTS, CLOSES ALL IPC-RECEIVE CHANNELS
+
+; IPC-ON -- OPENS AN IPC RECEIVE CHANNEL
+; IT TAKES 2 OPTIONAL ARGS WHICH ARE THE NAMES TO LISTEN ON,
+; THE DEFAULT IS UNAME, JNAME
+
+
+
+\f; DEFINITIONS FOR STRUCTURE OF IPC BUFFER
+
+BUFL==200. ;LENGTH OF IPC BUFFER
+BUFHED==3 ;LENGTH OF BUFFER HEADER
+CONT==400000 ;LEFT HALF BIT INDICATING THIS IS CONTINUATION
+INCOMP==200000 ;LEFT HALF BIT INDICATING MESSAGE COMPLETE
+ASCIMS==100000 ;LEFT HALF BIT INDICATING THIS IS PACKED ASCII MESSAGE
+MESHED==2 ;LENGTH OF CRUFT AT FRONT OF FIRST MESSAGE
+MAXMES==20000. ;MAXIMUM LENGTH IN WORDS OF MESSAGES MUDDLE WILL LIKE
+
+
+.GLOBAL STRTO6,SAT,IBLOCK,MOPEN,MCLOSE,GFALS,TTOCHN,INCONS,MASK2,INTHLD
+.GLOBAL IPCS1,IBLOCK,IPCGOT,DIRQ,GIBLOK,6TOCHS,CAFRE,CAFRET,IPCBLS,PVSTOR,SPSTOR
+
+; DEFINITIONS OF BITS IN THE OPEN BLOCK FOR IPC DEVICE
+
+RFROMA==1 ;READ FROM ANY
+RFROMS==2 ;READ FROM SPECIFIC
+SANDH==4 ;SEND AND HANG
+SIMM==10 ;SEND IMMEDIATE
+USEUJ==20 ;USE MY UNAME, JNAME
+
+
+;BUFFERFORMAT: HISNAME1
+; HISNAME2
+; COUNT
+; BITS,,LENGTH
+; TYPE
+
+;WHERE ASCII MESSAGES CONSIST OF A COUNT FOLLOWED BY CHARS
+;THE LENGTH IS THE LENGTH OF THE TYPE WORD PLUS ALL THE BODIES
+
+\f
+
+; THE FOLLOWING IS THE HANDLER WHICH WILL NORMALLY BE PUT ON THE
+; IPC INTERRUPT AND SO SERVE AS THE DEFAULT HANDLER FOR IPC RECEIVES
+; WHICH ARE NOT CAUGHT BY THE USER AND SERVICED IN SOME OTHER MANNER
+
+; NOTE THAT AS AN EXPERIMENT, MESSAGE WHICH ARE ASCII STRINGS WITH TYPE-CODE 1
+; ARE CONSIDERED AS EXECUTE COMMANDS. THEY ARE FIRST PRINTED OUT,
+; THEN THEY ARE PARSED AND THAT RESULT IS EVALED.
+; ALL MESSAGES OF OTHER TYPES ARE CONSIDERED MERELY AS MESSAGES TO BE
+; PRINTED OUT WITH AN INDICATING OF WHO THEY ARE FROM
+
+; THE ARGS WHICH THIS SUBROUTINE IS CALLED WITH BY INTERRUPT ARE
+; <MESSAGE> <TYPE> <HIS NAME 1> <HIS NAME 2> <MY NAME 1> <MY NAME 2>
+; WHERE THE LAST TWO ARE OPTIONAL AND ONLY GIVEN IF THE SOCKET WAS NOT
+; LISTENING ON THE DEFAULT UNAME,JNAME COMBINATION.
+
+
+MFUNCTION IPCH,SUBR,[IPC-HANDLER]
+
+ ENTRY
+
+ PUSH P,[0] ;SAVE A SLOT FOR LATTER USE
+ HLRE 0,AB ;CHECK THE NUMBER OF ARGS WE GOT
+ CAMLE 0,[-8.] ;NEED AT LEAST 4 ARGS
+ JRST WNA
+ GETYP E,(AB) ;CHECK TYPE OF FIRST ARG
+ CAIN E,TCHSTR ;IS IT A CHARACTER STRING
+ JRST .+3
+ CAIE E,TUVEC ;IF NOT IT MUST BE A UVECTOR
+ JRST WTYP1 ;IF NEITHER THEN WE HAVE A LOOSER
+ GETYP A,2(AB) ;GET TYPE OF MESSAGE TYPE, SHOULD BE A FIX
+ CAIE A,TFIX
+ JRST WTYP2 ;IF NOT FIX COMPLAIN
+ GETYP A,4(AB)
+ CAIE A,TCHSTR ;HIS NAME 1 SHOULD BE CHAR STRING
+ JRST WTYP
+ GETYP A,6(AB)
+ CAIE A,TCHSTR
+ JRST WTYP ;HIS NAME 2 SHOULD BE CHAR STRING
+ CAML 0,[-8.] ;SEE IF WE HAVE 4 OR 6 ARGS
+ JRST IPCH1 ;WE ONLY HAD 4 ARGS
+ CAME 0,[-12.] ;THEN WE MUST HAVE EXACTLY 6 ARGS
+ JRST WNA
+ GETYP A,(AB)8.
+ CAIE A,TCHSTR
+ JRST WTYP ;CHECK TO SEE THE MY NAME 1 IS STRING
+ GETYP A,10.(AB)
+ CAIE A,TCHSTR
+ JRST WTYP ;CHECK TO SEE THAT MY NAME 2 IS STRING
+
+IPCH1: PUSH TP,$TCHAN
+ PUSH TP,TTOCHN+1 ;PUSH ON TTY OUTPUT CHANNEL TO CALL TERPRI
+ MCALL 1,TERPRI
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE [IPC MESSAGE FROM ]
+ PUSH TP,$TCHAN
+ PUSH TP,TTOCHN+1
+ MCALL 2,PRINC ;PRINT OUT BLURB TO TELL LOOSER WHATS HAPPENING
+ PUSH TP,4(AB)
+ PUSH TP,5(AB) ;OUTPUT HIS NAME 1
+ PUSHJ P,TO ;JUMP OUT OUTPUTTER OVER TTY OUTPUT CHANNEL
+ PUSHJ P,STO ;JUMP TO SPACE OUTPUTTER OVER TTY OUTPUT CHANNEL
+ PUSH TP,6(AB)
+ PUSH TP,7(AB) ;OUTPUT NAME 2
+ PUSHJ P,TO
+ MOVE E,3(AB) ;MESSAGE TYPE
+ JUMPE E,IPCH3 ;IF MESSAGE TYPE 0 DO NOTHING ABOUT IT
+ CAIE E,1 ;IF 1 SEE IF THIS IS EXECUTE MESSAGE
+ JRST IPCH2 ;IF NOT TELL LOOSER ABOUT THIS MESSAGE TYPE
+ GETYP 0,(AB)
+ CAIE 0,TCHSTR ;SEE IF WE HAVE STRING
+ JRST IPCH2 ;IF NOT THIS CANT BE EXECUTE MESSAGE
+ AOS (P) ;SET FLAG TO INDICATE EXECUTE MESSAGE
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE [ EXECUTE]
+ PUSHJ P,TO ;TELL THE LOOSER HE IS GETTING WHAT HE DESERVES
+ JRST IPCH3
+IPCH2: PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE [ TYPE ]
+ PUSHJ P,TO
+ PUSH TP,2(AB)
+ PUSH TP,3(AB) ;PUSH ON THE MESSAGE TYPE
+ PUSHJ P,TO
+IPCH3: HLRE 0,AB
+ CAME 0,[-12.] ;SEE IF WE HAVE 6 ARGS AND SO MUST TELL HIM WHO MESS IS FOR
+ JRST IPCH4 ;IF NOT DONT WORRY
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE [ TO ]
+ PUSHJ P,TO
+ PUSH TP,8.(AB)
+ PUSH TP,9.(AB) ;PUSH ON MY NAME 1
+ PUSHJ P,TO
+ PUSHJ P,STO ;LEAVE SPACE BETWEEN NAMES
+ PUSH TP,10.(AB) ;PUSH ON MY NAME 2
+ PUSH TP,11.(AB)
+ PUSHJ P,TO
+IPCH4: PUSH TP,(AB) ;PUSH ON THE ACTUAL GOODIE
+ PUSH TP,1(AB)
+ PUSH TP,$TCHAN
+ PUSH TP,TTOCHN+1
+ MCALL 2,PRINT ;AND PRINT IT OUT
+ SKIPN (P) ;TEST TO SEE IF WE MUST EXECUTE THIS BAG BITTER
+ JRST IPCHND
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ MCALL 1,PARSE ;PARSE HIS CRUFT
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 1,EVAL ;THEN EVAL THE RESULT
+IPCHND: PUSH TP,$TCHAN
+ PUSH TP,TTOCHN+1
+ MCALL 1,TERPRI
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST FINIS ;TO RETURN WITH SOMETHING NICE
+
+STO: PUSH TP,$TCHSTR ;CROCK TO OUTPUT A SPACE ON THE TTY OUTPUT CHANNEL
+ PUSH TP,CHQUOTE [ ]
+TO: PUSH TP,$TCHAN
+ PUSH TP,TTOCHN+1
+
+ MCALL 2,PRINC
+ POPJ P, ;GO BACK TO WHAT WE WERE DOING
+\f
+
+;THESE ARE THE FUNCTIONS TO ACTUALLY STUFF GOODIES OUT
+;OVER THE IPC DEVICE
+;DESCRIPTION OF CALLING ARGS TO THEM IS AT THE
+;FIRST OF THE FILE
+
+MFUNCTION SEND,SUBR
+
+ ENTRY
+
+ PUSH P,[0] ;FLAG TO INDICATE DONT WAIT
+ JRST CASND
+
+MFUNCTION SENDW,SUBR,[SEND-WAIT]
+
+ ENTRY
+
+ PUSH P,[1] ;FLAG TO INDICATE WAITING
+
+CASND: HLRE 0,AB
+ CAMG 0,[-6] ;NEED AT LEAST 3 ARGS
+ CAMGE 0,[-12.] ;AND NOT MORE THAN 6 ARGS
+ JRST WNA
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,STRTO6 ;POOF FIRST ARG TO SIXBIT
+ MOVE A,2(AB)
+ MOVE B,3(AB)
+ PUSHJ P,STRTO6 ;POOF SECOND ARG TO SIXBIT
+ GETYP 0,4(AB)
+ CAIN 0,TCHSTR
+ JRST CASND1 ;IF FIRST ARG IS STRING, NO PROBLEMS
+ CAIE 0,TSTORAGE
+ CAIN 0,TUVEC
+ JRST .+2
+ JRST WTYP3 ;ELSE MUST BE OF TYPE STORAGE OR UVEC
+ MOVE B,5(AB)
+ HLRE C,B ;GET COUNT FIELD
+ SUBI B,(C) ;AND ADD THAT AMOUNT TO FIND DOPE WORD
+ GETYP A,(B) ;GET TYPE WORD OUT OF DOPE
+ PUSHJ P,SAT ;GET ITS STORAGE TYPE
+ CAIE A,S1WORD
+ JRST WTYP3 ;CRUFT MUST BE OF TYPE WORD
+CASND1: PUSH TP,4(AB)
+ PUSH TP,5(AB) ;SAVE THE STRUCTURE AROUND TO REST OFF AS WE SEND
+ PUSH P,[0] ;SLOT FOR THIS MESSAGE TYPE, DEFAULT 0
+ HLRE 0,AB
+ CAMLE 0,[-8.] ;IF 4 OR MORE ARGS GET THE MESS TYPE
+ JRST CASND2
+ GETYP 0,6(AB) ;CHECK TO SEE THAT TYPE IS A FIX
+ CAIE 0,TFIX
+ JRST WTYP
+ MOVE 0,7(AB)
+ MOVEM 0,(P) ;SMASH IN THE SLOT RESERVED FOR TYPE
+CASND2: HLRE 0,AB
+ CAMN 0,[-10.] ;IF WE HAVE FIVE ARGS WE ARE A GLOBAL LOOSER NEED 4 OR 6
+ JRST WNA
+ CAMGE 0,[-8.] ;IF WE HAVE 4 OR LESS DONT WORRY
+ JRST .+4 ;GO GET LAST TO ARGS
+ PUSH P,[0] ;NO SIXBIT OF FROM
+ PUSH P,[0] ;SO SAVE SLOTS ANYWAY
+ JRST CASND3 ;GO WORRY ABOUT SENDING NOW
+ MOVE A,8.(AB)
+ MOVE B,9.(AB)
+ PUSHJ P,STRTO6 ;CONVERT MY NAME1 TO SIXBIT
+ MOVE A,10.(AB)
+ MOVE B,11.(AB) ;CONVERT MY NAME 2 TO SIXBIT
+ PUSHJ P,STRTO6
+
+CASND3: GETYP 0,-1(TP)
+ CAIE 0,TCHSTR ;IS THIS A CHAR STRING
+ JRST .+5
+ HRRZ A,-1(TP) ;IF SO GET COUNT
+ ADDI A,9.
+ IDIVI A,5 ;IF SO ROUND UP AND ADD ONE
+ JRST .+3
+ HLRE A,(TP)
+ MOVN A,A ;IF A VECTOR GET THE WORD COUNT
+ PUSH P,A ;SAVE COUNT OF WORDS
+ CAILE A,MAXMES
+ JRST TOBIGR ;MESS OVER SIZE LIKED BY MUDDLE
+ CAILE A,BUFL-MESHED ;HOW BIG A BUFFER DO WE NEED?
+ MOVEI A,BUFL-MESHED ;IF TOO BIG WE USE DEFAULT MAX SIZE, ELSE LESS
+ ADDI A,MESHED+BUFHED ;PLUS ROOM FOR MESSAGE AND SYSTEM HEADERS
+ PUSHJ P,IBLOCK
+ PUSH TP,A
+ PUSH TP,B ;GET BUFFER OF RIGHT SIZE AND SAVE ON STACK
+ PUSH TP,A
+ PUSH TP,B ;SAVE ANOTHER COPY WHICH WILL BE RESTED AT TIMES
+ MOVE C,-5(P) ;GET HIS NAME 1
+ MOVEM C,(B) ;AND STUFF IN RIGHT PLACE
+ MOVE C,-4(P)
+ MOVEM C,1(B) ;STUFF HIS NAME 2
+ MOVE C,-3(P)
+ MOVEM C,4(B) ;STUFF MESSAGE TYPE CODE WORD
+ GETYP 0,-5(TP) ;IS THIS STRING OR UVECTOR?
+ CAIE 0,TCHSTR
+ JRST CASND4
+ MOVE C,(P) ;GET LENGTH OF CHAR STRING TO SEND
+ ADDI C,1
+ MOVEM C,3(B) ;STORE IN LENGTH FIELD IN MESS HEADER
+ SOS (P) ;DECREMENT FOR COUNT WORD
+ HRRZ C,-5(TP) ;GET THE CHARACTER COUNT
+ MOVEM C,5(B) ;STORE IN CORRECT SLOT IN MESSAGE
+ MOVE D,[6,,6] ;OFFSET FOR INITIAL HEADER ON ASCII MESSAGES
+ ADDM D,(TP) ;OFFSET BUF PTR 2 BY THIS AMOUNT
+ JRST CASND5
+CASND4: MOVE C,(P) ;GET COUNT OF MESSAGE
+ ADDI C,1 ;EXTRA FOR TYPE WORD
+ MOVEM C,3(B) ;STORE IN SLOT FOR COUNT OF WHOLE MESSAGE
+ MOVE D,[5,,5] ;OFFSET FOR INITIAL HEADER ON UVECTOR MESSAGES
+ ADDM D,(TP) ;OFFSET BUF PTR 2 BY THIS AMOUNT
+CASND5: PUSHJ P,STUFBF ;GO FILL UP THE BUFFER WITH GARBAGE
+ MOVN 0,A ;GET NEGATIVE THE COUNT OF WORDS STUFFED
+ ADDM 0,(P) ;THAT MANY LESS WORDS REMAINING TO BE DONE
+ HRRZ C,-2(TP) ;GET A POINTER TO THE "UNRESTED" BUFFER
+ HRRZ D,(TP) ;GET A POINTER TO THE "RESTED" BUFFER
+ SUB D,C ;FIND OUT HOW MUCH WAS RESTED OFF
+ ADD D,A ;ADD TO THAT THE COUNT OF WORDS STUFFED THIS TIME
+ SUBI D,BUFHED ;LESS THE SYSTEM CONSTANT HEADER THAT DOENT COUNT
+ MOVEM D,2(C) ;STORE IN THE BUFFER IN CORRECT SLOT
+ PUSHJ P,CASIOT ;GO DO THE "IOT"--ACTUALLY AN OPEN
+ MOVE C,-2(TP)
+ HRLZI E,CONT ;THE "THIS IS A CONTINUATION" BIT
+ IORM E,3(C) ;TURN BIT ON IN FUTURE MESSAGES
+ ADD C,[4,,4] ;REST OFF THE SHORTER HEADER FOR THE REST OF MESSAGES
+ MOVEM C,(TP) ;STORE THIS IN THE "RESTED" BUFFER SLOT
+ SKIPLE (P) ;IS THERE MORE TO DO?
+ JRST CASND5
+ MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST FINIS ;RETURN HIM SOMETHING NICE
+
+TOBIGR: ERRUUO EQUOTE MESSAGE-TOO-BIG
+
+\f
+STUFBF: MOVE C,-2(TP) ;ROUTINE TO FILL UP BUFFER WITH GOODIES
+ HRLZI E,INCOMP+ASCIMS
+ ANDCAM E,3(C) ;CLEAR THE INCOMPLETE AND ASCII FLAGS IF SET
+ HLRE B,(TP) ;GET THE BUFFER LENGTH
+ MOVN B,B ;MAKE IT A POSITIVE NUMBER
+ CAML B,-1(P) ;SEE IF THE WHOLE MESSAGE WILL FIT
+ JRST .+4 ;IT WILL ALL FIT
+ HRLZI 0,INCOMP ;THE INCOMPLETE FLAG
+ IORM 0,3(C) ;SET IT
+ JRST .+2
+ MOVE B,-1(P) ;ELSE THE WHOLE MESSAGE FITS
+ GETYP 0,-5(TP)
+ CAIN 0,TCHSTR
+ JRST STUFAS
+ HRLZ D,-4(TP) ;SET UP TO BLT UVECTOR
+ HRR D,(TP)
+ HRRZ E,(TP)
+ ADDI E,(B)-1 ;SET UP BLT POINTERS
+ SKIPLE B ;IN CASE ZERO LENGTH UVECTOR
+ BLT D,(E) ;BBBBLLLLLLLLLLLLLLLLLLTTTT?
+ MOVE A,B ;MOVE COUNT OF WORDS DONE INTO A
+ HRL B,B
+ ADDM B,-4(TP) ;REST OFF THIS MUCH OF GOODIE FOR NEXT TIME
+ POPJ P,
+STUFAS: HRLZI 0,ASCIMS
+ IORM 0,3(C) ;TURN ON THE ASCII BIT IN THE MESSAGE
+ MOVE A,B ;MOVE COUNT OF NUMBER OF WORDS INTO A
+ IMULI B,5 ;GET CHAR COUNT IN B
+ HRRZ C,-5(TP) ;COMPARE THIS WITH COUNT FIELD IN STRING
+ MOVE D,B
+ SUB D,C ;SEE HOW MANY EXTRA BLANKS AT END OF MESS
+ JUMPGE D,.+3
+ MOVEI D,0 ;NO EXTRA SPACES TO PAD
+ MOVE C,B ;NOT EXTRA SPACES, DO 5*WORD CHARS
+ MOVN E,C
+ ADDM E,-5(TP) ;FIX UP COUNT IN ASCII
+ HRLZI E,440700 ;GET A IDPB PTR INTO THE BUFFER
+ HRR E,(TP) ;POINT TO RIGHT PLACE IN BUFFER
+ JUMPLE C,.+4 ;ARE WE DONE MOVING CHARS?
+ ILDB 0,-4(TP) ;LOAD A BYTE FROM STRING
+ IDPB 0,E ;STUFF IN BUFFER
+ SOJG C,.-2 ;REPEAT THE LOOP
+ JUMPLE D,.+4 ;SEE IF WE NEED TO FILL OUT WITH NULLS
+ MOVEI 0,0
+ IDPB 0,E ;STUFF A NULL IN RIGHT SPOT IN BUFFER
+ SOJG D,.-1
+ POPJ P,
+
+CASIOT: HRRZI A,(SIXBIT /IPC/) ;FIX UP OPEN BLOCK IN THE AC'S
+ MOVE B,-2(TP) ;HOWS THAT FOR SNAZZY?
+ MOVE C,-3(P) ;MY NAME 1
+ MOVE D,-2(P) ;MY NAME 2
+ JUMPN C,.+3
+ JUMPN D,.+2
+ TLO A,USEUJ ;IF BOTH ARE ZERO THEN USE DEFAULT UNAME,JNAME
+ SKIPN -7(P) ;SEE IF SEND AND HANG FLAG IS SET
+ JRST .+3
+ TLO A,SANDH ;SET SEND AND HANG FLAG
+ JRST .+3
+ TLO A,SIMM ;ELSE WE MUST BE SENDING IMMEDIATE
+ AOS -7(P) ;IF THERE IS MORE TO DO, IT MUST BE IN HANG MODE
+ MOVSI 0,TUVEC
+ MOVE PVP,PVSTOR+1
+ MOVEM 0,BSTO(PVP) ;IN CASE WE ARE INTERRUPTED OUT WE WANT TO WIN
+ SETZM E ;FLAG USED TO INDICATE NO SKIPPAGE
+ ENABLE
+ .OPEN 0,A ;WELL, THATS ALL THERE IS TO IT.
+ AOS E ;IF WE DONT SKIP WE HAVE PROBLEMS
+ DISABLE
+ MOVE PVP,PVSTOR+1
+ SETZM BSTO(PVP) ;FIX UP THE SLOT IN PVP
+ SKIPN E ;SEE IF WE LOST
+ POPJ P, ;IF NOT WE ARE THROUGH WITH THIS PART
+ .STATUS 0,A ;FIND OUT REASON FOR LOSSAGE
+ MOVEI B,0
+ PUSHJ P,GFALS ;MAKE A FALSE WITH THAT REASON
+ JRST FINIS ;GIVE THE MAGIC FALSE BACK TO THE LOOSER
+
+\f
+MFUNCTION DEMSIG,SUBR
+
+ ENTRY 1
+
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,STRTO6 ;GET THE SIXBIT REPRESENTATION
+ MOVE A,[SETZ] ;FIX UP THE BLOCK IN THE AC'S
+ MOVE B,[SIXBIT /DEMSIG/]
+ MOVE C,[SETZ (P)] ;THE SIXBIT IS ON TOP OF P STACK
+ .CALL A
+ JRST RFALS ;DIDNT WIN WITH DEMON SIGNAL
+RTRUE: MOVSI A,TATOM
+ MOVE B,IMQUOTE T
+ JRST FINIS
+
+RFALS: MOVSI A,TFALSE
+ MOVEI B,0
+ JRST FINIS ;FALSE INDICATING LACK OF WINNAGE
+
+\f
+MFUNCTION IPCON,SUBR,[IPC-ON]
+
+ ENTRY
+
+ PUSH P,[USEUJ,,0] ;FLAG FOR WHETHER OR NOT TO USE DEFAULT
+ HLRZ 0,AB
+ JUMPE 0,IPCON1 ;NO ARGS ARE FINE
+ CAIE 0,-4 ;ELSE MUST HAVE 2 ARGS
+ JRST WNA
+ SETZM (P) ;CLEAR OUR FLAG
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,STRTO6 ;GET SIXBIT OF OUR FIRST ARG
+ MOVE A,2(AB)
+ MOVE B,3(AB)
+ PUSHJ P,STRTO6 ;GET SIXBIT OF OUR SECOND ARG
+ JRST IPCON2
+IPCON1: PUSH P,[0] ;SAVE SLOT ON STACK FOR EVENNESS
+ PUSH P,[0]
+IPCON2: MOVEI A,BUFL+BUFHED
+ PUSHJ P,CAFRE ;GET A BUFFER OF RIGHT LENGTH TO READ INTO
+ PUSH P,A ;AND SAVE IT AROUND SO WE DONT LOOSE
+ MOVEI 0,BUFL
+ MOVEM 0,2(A) ;FILL COUNT IN THE BUFFER SLOT
+ MOVEI A,5
+ PUSHJ P,IBLOCK ;GET A BLOCK OF STORE FOR THE OPEN BLOCK
+ PUSH TP,$TUVEC
+ PUSH TP,B ;SAVE CRUFT ON TP
+ TLO 0,RFROMA ;SET THE READ FROM ANY FLAG
+ IOR 0,-3(P) ;FIX FOR DEFAULT UNAME,JNAME IF FLAG INDICATES
+ MOVEM 0,(B) ;MAKE OPEN BLOCK
+ MOVE 0,[SIXBIT /IPC/]
+ MOVEM 0,1(B)
+ MOVE 0,-2(P)
+ MOVEM 0,3(B) ;MY NAME 1
+ MOVE 0,-1(P)
+ MOVEM 0,4(B) ;MY NAME 2 IF NOT USING DEFAULT
+ MOVE 0,(P)
+ MOVEM 0,2(B) ;PTR TO THE WIRED BUFFER FOR STUFFING CRUFT
+ MOVE A,B
+ PUSHJ P,MOPEN ;GO DO THE OPEN
+ JRST IPCON3 ;OPEN FAILED, FIND OUT WHY
+ PUSH P,A ;SAVE THE CHANNEL NUMBER
+ MOVEI E,1
+ LSH E,(A) ;SET INTERRUPT BITS RIGHT
+ IORM E,MASK2
+ .SUSET [.SMSK2,,MASK2]
+ MOVE C,-1(TP)
+ MOVE D,(TP) ;GET THE OPEN BLOCK UVECTOR
+ PUSHJ P,INCONS ;THROW INTO PAIR SPACE
+ POP P,C ;GET THE CHANNEL #
+ SUBI C,1
+ IMULI C,2
+ MOVEM B,IPCS1+1(C) ;STUFF PTR TO OPEN BLOCK INTO SLOT IN TVP
+ JRST RTRUE ;WE WON, GO LET LUSER KNOW IT.
+IPCON3: PUSH P,A ;WE LOST, LETS FIND OUT WHY
+ MOVE A,BUFL+BUFHED
+ MOVE B,-1(P) ;LETS FREE UP OUR WIRED DOWN BUFFER TO BE CLEAN
+ PUSHJ P,CAFRET
+ POP P,A ;GET THE CHANNEL # BACK
+ JUMPL A,NFCHN ;NO FREE CHANNELS?
+ MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON
+ LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE
+ IOR B,A ;FIX UP .STATUS
+ XCT B
+ MOVEI B,0
+ PUSHJ P,GFALS
+ JRST FINIS ;RETURN A LOOSE WITH REASON FOR LOOSAGE
+
+NFCHN: ERRUUO EQUOTE NO-ITS-CHANNELS-FREE
+
+\f
+MFUNCTION IPCOFF,SUBR,[IPC-OFF]
+
+ ENTRY 0
+
+ PUSH TP,$TVEC
+ MOVE 0,[IPCS1,,IPCS1]
+ PUSH TP,0 ;SAVE OUR PLACE IN RUNNING THROUGH SLOTS
+ PUSH P,[1] ;COUNTER OF CHANNEL NUMBER
+
+IPCOF1: MOVE A,(TP) ;GET FIRST GOODIE
+ SKIPN B,1(A) ;GET THE POINTER TO LIST
+ JRST IPCOF2
+ SETZM 1(A) ;ZERO OUT SLOT TO BE CLEAN
+ MOVE B,1(B) ;GET CAR OF LIST, PTR TO OPEN BLOCK
+ MOVE C,(P) ;GET THE ACTUAL CHANNEL NUMBER
+ MOVEI E,1 ;TURN OFF INTERRUPT
+ LSH E,(C)
+ ANDCAM E,MASK2
+ .SUSET [.SMSK2,,MASK2]
+ MOVE A,C
+ PUSHJ P,MCLOSE ;CLOSE THIS CHANNEL
+ JFCL
+ MOVEI A,BUFL+BUFHED ;LENGTH OF WIRED STORE TO FREE UP
+ MOVE B,1(B) ;GET THE POINTER TO WIRED STORE
+ PUSHJ P,CAFRET ;FREE ALREADY
+IPCOF2: MOVE 0,[2,,2]
+ ADDM 0,(TP) ;REST TO NEXT SLOT
+ AOS D,(P) ;NEXT CHANNEL
+ CAIG D,15. ;ARE WE THROUGH
+ JRST IPCOF1
+ JRST RTRUE ;RETURN HIM A TRUE FOR NICENESS
+
+\f
+IPCGOT: MOVEI D,IPCS1+1
+ ADDI D,(B)
+ ADDI D,(B)
+ SKIPN D,-74.(D) ;GET THE GOODIE LIST FOR CHANNEL WE INTERRUPTED ON
+ JRST DIRQ ;MIX UP MAYBE, LET HIM WORRY ABOUT IT
+ PUSH P,B ;SAVE THE CHAN #
+ PUSH TP,$TLIST
+ PUSH TP,D ;SAVE GOODIE LIST
+ MOVE E,1(D) ;GET PTR TO OPEN BLOCK
+ PUSH P,2(E) ;SAVE PTR TO WIRED BUFFER
+ MOVE E,2(E)
+ MOVE 0,3(E) ;GET THE MAGIC BITS FOR THIS MESSAGE
+ TLNE 0,CONT ;IS THIS MESSAGE A CONTINUATION?
+ JRST IGCON ;YES
+ MOVEI A,10. ;NO
+ PUSHJ P,GIBLOK ;GET A BLOCK FOR FUNNY MESSAGE VECTOR
+ PUSH TP,$TVEC
+ PUSH TP,B ;SAVE THE BLOCK FOR FUNNY MESSAGE VECTOR
+ MOVE E,(P) ;GET PTR TO WIRED BUFFER
+ MOVE 0,3(E) ;GET THE MAGIC BITS AGAIN
+ HRRZ A,0 ;GET THE LENGTH IN WORDS OF THIS THE WHOLE MESSAGE HE HAS
+ SUBI A,1 ;MINUS ONE FOR THE TYPE WORD WHICH IS COUNTED
+ TLNE 0,ASCIMS ;IS THIS ASCII?
+ SUBI A,1 ;IF YES THEN MUST SUB 1 MORE FOR ASCII CHAR COUNT
+ CAILE A,MAXMES ;IS THIS BIGGER THAN MUDDLE BLESSES?
+ JRST TBGMS ;IF SO THEN CLEAN UP AND FORGET ABOUT THE LOOSER
+ PUSHJ P,IBLOCK
+ MOVE E,(P)
+ MOVE D,(TP)
+ MOVE 0,(E) ;GET HIS NAME 1 OUT OF MESSAGE
+ MOVEM 0,5(D) ;STORE INTO SLOT IN FUNNY MESSAGE VECTOR
+ MOVE 0,1(E) ;GET HIS NAME 2 OUT OF MESSAGE
+ MOVEM 0,7(D)
+ MOVE 0,4(E) ;GET THE MESSAGE TYPE WORD
+ MOVEM 0,9(D) ;STORE INTO SLOT IN MESSAGE VECTOR
+ MOVSI 0,TFIX
+ MOVE 0,4(D)
+ MOVE 0,6(D)
+ MOVE 0,8(D)
+ MOVE 0,3(E) ;GET THE MESSAGE BITS
+ TLNE 0,ASCIMS ;IS IT ASCII?
+ JRST IG1 ;YES
+ MOVSI 0,TUVEC
+ MOVEM 0,(D)
+ MOVEM 0,2(D)
+ MOVEM B,1(D)
+ MOVEM B,3(D) ;STORE MESSAGE BLANK TWICE, THE SECOND TO REST THROUGH
+ HLRE E,B
+ SUBM B,E
+ MOVSI 0,TFIX
+ MOVEM 0,(E) ;SET NICE TYPE TO PRINT GOODER
+ JRST IGBLT
+IG1: MOVSI 0,TUVEC
+ MOVEM 0,2(D)
+ MOVEM B,3(D) ;STORE MESSAGE BLANK AS UVECTOR TO REST THROUGH
+ HLRE A,B
+ HRLI B,010700 ;MAKE THE ILDB PTR
+ SUBI B,1
+ MOVEM B,1(D) ;AND STORE IN THE SLOT
+ IMUL A,[-5] ;MAX CHAR COUNT FOR STRING
+ MOVE B,5(E) ;GET THE ACTUAL CHARACTER COUNT HE CLAIMED
+ MOVE C,A
+ SUB C,B ;FIND DIFFERENCE BETWEEN MAX AND CLAIMED
+ JUMPL C,.+2 ;IF COUNT TOO BIG, MUST DO BEST POSSIBLE AND USE MAX COUNT
+ CAILE C,4 ;NO MORE THAN FOUR EXTRA CHARS IMPLIES GOODNESS
+ MOVE B,A ;IF LOSSAGE, THEN USE MAX COUNT INSTEAD OF HIS CLAIM
+ HRLI B,TCHSTR ;MAKE THIS A CHAR STRING TYPE WORD
+ MOVEM B,(D) ;AND FIX MESSAGE BLANK # 1 TO BE THE BLESSED STRING
+ JRST IGBLT ;BLT THE MESSAGE INTO THE BLANK
+
+IGCON: MOVE D,(TP) ;GET THE IPC SLOT LIST
+ MOVE E,(P) ;GET A PTR TO THE MESSAGE BUFFER
+ HRRZ C,(D) ;CDR THE IPC SLOT LIST TO POINT TO FIRST MESSAGE VECTOR
+IGCON1: JUMPE C,IGCONL ;IF NIL, THEN ABANDON ALL HOPE
+ MOVE B,1(C) ;LOOK AT THE VECTOR
+ MOVE 0,5(B) ;HIS NAME 1 FOR THIS BLOCK
+ CAME 0,(E) ;COMPARE WITH HIS NAME 1 IN THIS MESSAGE
+ JRST IGCON2 ;IMMEDIATE FAILURE, TRY THE NEXT IN THE LIST
+ MOVE 0,7(B) ;SEE IF HIS NAME 2 ALSO MATCHES
+ CAME 0,1(E) ;WELL, DOES IT MATCH?
+ JRST IGCON2 ;NO, TRY THE NEXT ONE
+ PUSH TP,$TVEC ;WE GOT IT
+ PUSH TP,1(C) ;SAVE THIS MESSAGE BLOCK ON TP FOR LATER BLTING
+ HRRZ C,(C) ;CDR TO REST OF LIST
+ HRRM C,(D) ;AND SPLICE IT RIGHT OUT OF THE LIST, NEAT HUH?
+ JRST IGBLT ;GO BLT TO OUR HEART'S CONTENT
+IGCON2: HRRZ D,(D) ;REST OUR FOLLOW UP POINTER
+ HRRZ C,(C) ;REST OUR ACTUAL TEST POINTER
+ JRST IGCON1 ;TRY AGAIN
+
+IGCONL: MOVE A,(TP)
+ MOVE A,1(A) ;GET PTR TO OPEN BLOCK
+ MOVE B,-1(P)
+ SUBI B,36. ;GET CHANNEL NUMBER
+ HLL B,(A)
+ MOVE C,(P) ;GET THE WIRED BUFFER
+ SUB P,[2,,2] ;WE LOST SO CLEAN UP STACKS
+ SUB TP,[2,,2]
+ROPNL: SETZM (C) ;REOPEN CHANNEL SO NOT PERMANENTLY CROGGLED
+ SETZM 1(C) ;ZERO OUT THE HIS NAME SLOTS
+ MOVEI 0,BUFL
+ MOVEM 0,2(C) ;RESET THE LENGTH FIELD IN WIRED BUF
+ DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)]
+ FATAL CANT REOPEN IPC CHN
+ JRST DIRQ ;LEFT IN NICE STATE AFTER LOOSAGE
+
+TBGMS: MOVE A,-2(TP)
+ MOVE A,1(A) ;GET OPEN BLOCK
+ MOVE B,-1(P)
+ SUBI B,36. ;CHANNEL #
+ HLL B,(A)
+ MOVE C,(P) ;WIRED BUFFER
+ SUB P,[2,,2] ;CLEAN UP STACKS
+ SUB TP,[4,,4]
+ JRST ROPNL ;REOPEN SO NEXT GUY CAN WIN
+
+\f
+
+IGBLT: MOVE E,(TP) ;POINTER TO MESSAGE VECTOR
+ MOVE E,3(E) ;GET VECTOR (MAYBE STRING IN DISGUISE) TO BLT IN
+ MOVE D,(P) ;GET THE WIRED BUFFER
+ MOVEI C,4(D) ;GET A POINTER TO THE REST OF THE WIRED BUF
+ MOVEI 0,BUFL-1 ;KLUDGE TO IGNORE ONE EXTRA WORD OF BITS
+ SUB 0,2(D) ;GET LENGTH OF GOODIE GOT
+ MOVE A,3(D) ;GET THE RANDOM MESSAGE BITS
+ TLNE A,CONT ;TEST FOR CONTINUED MESSAGE
+ JRST .+7 ;IF SO THEN NO NEED TO WORRY
+ SOS 0
+ AOS C ;FIX UP FOR ONE LESS WORD TO WORRY WITH
+ TLNN A,ASCIMS ;TEST FOR ASCII MESSAGE
+ JRST .+3 ;IF NOT THEN NO WORRY
+ SOS 0
+ AOS C ;FIX UP FOR YET 1 FEWER WORD
+ HLRE A,E
+ MOVM A,A ;GET LENGTH OF VECTOR TO BLT INTO
+ CAILE 0,(A) ;CHECK TO SEE WE DONT HAVE TOO MUCH
+ MOVE 0,A ;IF WE HAVE TOO MUCH, CHOP OFF--HA, HA, HA
+ MOVEI B,-1(E)
+ ADD B,0 ;B POINTS TO LAST WORD TO BLT INTO
+ HRL C,E ;BLT POINTER
+ MOVSS C ;NDR CANT REMEMBER HOW TO BLT POINTER
+ BLT C,(B) ;VIOLA
+ HRL 0,0
+ MOVE E,(TP) ;GET BACK POINTER TO MESSAGE VECTOR
+ ADDM 0,3(E) ;REST OFF TO KEEP TRACK OF INCOMPLETE MESSAGE
+ MOVE A,3(D) ;GET THE RANDOM MESSAGE BITS BACK
+ TLNE A,INCOMP ;MESSAGE COMPLETE?
+ JRST IGHALF ;INCOMPLETE
+ JRST IGMES ;COMPLETE
+
+IGHALF: MOVE C,-1(TP) ;GOT TO SPLICE MESSAGE VECTOR BACK IN
+ MOVE D,(TP)
+ PUSHJ P,INCONS ;STICK INTO PAIR SPACE
+ HRRZ E,-2(TP) ;PTR TO LIST
+ HRRZ D,(E) ;CDR OF LIST
+ HRRM D,(B) ;MAKE SPLICE
+ HRRM B,(E) ;THAT IT
+ MOVE B,1(E) ;POINT TO OPEN BLOCK
+ MOVE 0,-1(P) ;GET CHAN #
+ SUBI 0,36.
+ HLL 0,(B)
+ MOVE E,(P) ;GET THE WIRED BUF
+ MOVEI D,BUFL
+ MOVEM D,2(E) ;REFIX THE WIRED BUF
+ SETZM (E)
+ SETZM 1(E)
+ DOTCAL OPEN,[0,1(B),2(B),3(B),4(B)]
+ FATAL CANT REOPEN IPC CHN
+ SUB P,[2,,2]
+ SUB TP,[4,,4] ;CLEAN OURSELVES
+ JRST DIRQ ;THATS ALL THERE IS TO IT
+
+IGMES: HRRZ E,-2(TP) ;PTR TO OUR KLUDGE LIST
+ MOVE B,1(E) ;PTR TO OPEN BLOCK
+ MOVE 0,-1(P) ;CHANNEL #
+ SUBI 0,36.
+ HLL 0.(B)
+ MOVE D,(P) ;GET THE WIRED BUF
+ MOVEI C,BUFL
+ MOVEM C,2(D)
+ SETZM (D)
+ SETZM 1(D) ;BLESS WIRED BUF FOR REOPENING
+ DOTCAL OPEN,[0,1(B),2(B),3(B),4(B)]
+ FATAL CANT REOPEN IPC CHN
+ MOVE E,(TP) ;GET THE MESSAGE VECTOR (ALIAS GOODIE BLOCK)
+ SUB P,[2,,2] ;BLESS OUR P STACK
+ PUSH P,5(E) ;SAVE SIXBIT HIS NAME 1
+ PUSH P,7(E) ;SAVE SIXBIT HIS NAME 2
+ SUB TP,[4,,4] ;BLESS THE TP STACK
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE IPC
+ PUSH TP,(E) ;STUFF STUFF ON TO CALL INTERRUPT
+ PUSH TP,1(E) ;THAT IS THE ACTUAL MESSAGE
+ MOVE 0,9(E)
+ CAMN 0,[400000,,0]
+ JRST IGUG
+IGUGN: PUSH P,3(B) ;GET MY NAME 1 OUT OF OPEN BLOCK
+ PUSH P,4(B) ;GET MY NAME 2 OUT OF OPEN BLOCK
+ MOVE 0,(B) ;GET SOME OF THE RANDOM OPEN FLAGS
+ TLNE 0,USEUJ
+ SETZ -1(P) ;MAKE SURE WE HAVE INDICATOR IF THIS IS TO UNAME,JNAME
+ PUSH TP,$TFIX
+ PUSH TP,9(E) ;SAVE THE MESSAGE TYPE
+ MOVE A,-3(P) ;HIS NAME 1
+ PUSHJ P,6TOCHS
+ PUSH TP,A
+ PUSH TP,B ;GIVE HIM NICE CHAR STRING OF ALL THE NAMES
+ MOVE A,-2(P)
+ PUSHJ P,6TOCHS
+ PUSH TP,A
+ PUSH TP,B ;NICE CHAR STRING OF HIS NAME 2
+ SKIPN A,-1(P) ;ISE THIS DEFAULT UNAME, JNAME
+ JRST IGFOUR ;ONLY FOUR ARGS TO THE IPC INTERRUPT
+ PUSHJ P,6TOCHS
+ PUSH TP,A
+ PUSH TP,B
+ MOVE A,(P)
+ PUSHJ P,6TOCHS
+ PUSH TP,A
+ PUSH TP,B ;GIVE HIM CHAR STRINGS OF MY NAME 1 AND 2 IF NOT DEFAULT
+ MOVEI E,7 ;FOR ACALL INDICATING 6 ARGS TO THE IPC INTERRUPT HANDLER
+ JRST .+2 ;SKIP OVER FIX FOR ONLY 4 ARGS TO IPC INTERRUPT
+IGFOUR: MOVEI E,5
+ SUB P,[4,,4] ;CLEAN UP OUR WHOLE WORLD
+ ACALL E,INTERR ;THATS IT FOLKS, THE REAL THING
+ JRST DIRQ
+
+IGUG: .SUSET [.RMARPC,,0]
+ CAMN 0,[-1]
+ JRST IGUGN ; DISABLED, SO GO AWAY
+ SETZM INTHLD ; RE-ENABLEE INTERRUPTS
+ SUB P,[2,,2]
+ MCALL 1,PARSE
+ SUB TP,[2,,2] ;FLUSH OFF STRING "IPC"
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 1,EVAL
+ JRST DIRQ
+
+\f
+IPCBLS: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,E ;PARANOIA STRIKES AGAIN
+ PUSH P,0
+ MOVEI E,0 ;CRETIN ASSEMBLER
+ .SUSET [.SMARPC,,E]
+ MOVEI E,IPCS1 ;BLESSES ALL CURRENTLY OPEN IPC CHANNELS
+ MOVEI 0,1
+IPCBL1: SKIPN B,1(E)
+ JRST IPCBL2
+ HLLZS (B) ;CLEAR OUT ANY PARTIAL BUFFER WE MAY HAVE
+ HRRZ B,1(B) ;GET A POINTER TO THE OPEN BLOCK
+ MOVE A,0 ;GET THE CHANNEL NUMBER
+ HLL A,(B)
+ MOVE C,2(B) ;GET A POINTER TO THE BUFFER
+ MOVEI D,BUFL ;TO FIX UP THE BUFFER
+ MOVEM D,2(C) ;FIX LENGTH UP RIGHT
+ SETZM (C)
+ SETZM 1(C) ;FIX UP THE READ FROM FIELDS
+ DOTCAL OPEN,[A,1(B),2(B),3(B),4(B)]
+ FATAL IPC DEVICE LOST
+IPCBL2: ADDI E,2
+ ADDI 0,1
+ CAIG 0,15.
+ JRST IPCBL1 ;IF ANY MORE GO BLESS THEM
+
+ POP P,0
+ POP P,E
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+
+
+
+END
+\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff