1
0
mirror of https://github.com/PDP-10/its.git synced 2026-05-01 14:06:28 +00:00

Rename to ITS conventions.

MIDAS and Muddle source get version numbers (as in the 1973 Muddle
source); the build files don't.
This commit is contained in:
Adam Sampson
2018-04-23 15:35:34 +01:00
committed by Adam Sampson
parent 8eb73e1b95
commit a81db26a7a
51 changed files with 0 additions and 0 deletions

815
src/mudsys/ipc.19 Normal file
View File

@@ -0,0 +1,815 @@
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
; 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
; 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
;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
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
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
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
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
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
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
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