perm filename MESPRO[S,AIL]1 blob
sn#000798 filedate 1972-08-01 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00022 PAGES VERSION 15-2(12)
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 HISTORY
00005 00003
00008 00004 FIRST THE INDICES INTO THE MESSAGE BLOCKS PASSED AROUND.
00011 00005 NOW THE SEMANTIC BITS COPIED FROM THE COMPILER.
00014 00006 MAGIC MACROS FOR TALKING ABOUT THE LOCKS.
00016 00007 HERE (.MES2) PROCESS ONE PARAMETER.
00019 00008 HRLZI B,CORGOT SAY WE GOT CORE
00022 00009 ARRYS: TRNE TAC1,SET!STRING
00025 00010 SENDIT: TRNN A,DNOTRACE IF NOT TRACING THIS MESSAGE, OR
00028 00011 GGSEND: QENT
00030 00012 WAITC: QENT
00033 00013 TESR:
00035 00014 QFIN: TRNN A,DWAITM
00037 00015 MOVE A,2(LPSA) GOOD BITS WORD.
00040 00016 T5: TLNN A,SETRECLM
00042 00017 KILLIT: QENT
00044 00018 ***** *****
00046 00019 HERE (GET.DATA)
00048 00020 XX1: AOS D REMOVE TABLE ENTRY
00050 00021 CAMN TAC2,DESTAB(D) TEST FOR ALREADY DEFINED
00052 00022 MORST: SKIPN RACS+1(USER)
00054 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 201700000014 ⊗;
COMMENT ⊗
VERSION 15-2(12) 6-8-72 BY DCS BUG #GI# FIX THE #GI# BUG FIX CODE IN GET.DATA
VERSION 15-2(11) 6-7-72 BY DCS BUG #HO# RIGHT ADDRESS TO MESPRO PARAM BLOCK
VERSION 15-2(10) 4-28-72 BY JRL CHANGE TO NEW LEAP CALLING CONVENTIONS
VERSION 15-2(9) 3-21-72 BY JRL CHANGE LEAP INTERLOCKS
VERSION 15-2(8) 3-6-72 BY JRL REMOVE ARRPDP REFERENCES
VERSION 15-2(6) 3-6-72 BY JRL DELETE TYPE BITS FROM COMPILER
VERSION 15-2(4) 3-3-72 BY KKP BUG IN SET RELEASE CODE FOR ACTIVATE
VERSION 15-2(3) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR, FIX STRNGC BUGS
VERSION 15-2(2) 2-1-72 BY DCS ?
VERSION 15-2(1) 12-24-71 BY DCS BUG #FS# INSTALL VERSION NUMBER, REMOVE SAILRUN
⊗;
LSTON (MESPRO)
NOEXPO <
GLOB <
COMMENT ⊗
These are the routines for passing messages back and forth in
the second segment. The history of a message is some subset of
the following sequence:
1. message is composed.
2. message is put in queue
3. message is "sent"
4. we wait for completion of the message.
5. we activate the message (call the procedure)
6. we acknowledge the processing of the message
7. we kill the message
There are in addition, several things that we may want to do
to find out about the status of the queue, etc.
ISSUE (directive,source name,dest. name, MESSAGE foo(param list));
This returns an integer value which is the unique number associated
with the queue entry made for this message.
The legal things to mention in the directive are: DSEND,DWAIT.
QUEUE (directive,unique number)
This is for processing things in the queue already. The legal bits
in the directive are DSEND,DWAIT,DKILL,DACT,DACK.
string ← GET_DATA (directive,unique number)
PUT_DATA (directive,unique number)
These get and put the string entries (source,dest,proc name) in the
blocks. Directive is 1 for source, 2 for dest, 3 for proc name.
integer ← GET_ENTRY (directive,source,destination,proc name)
This searches the queue for an entry of the appropriate type.
The directive bits say which strings we are interested in.
Legal directive bits are DSOURCE,DDEST,DNAME,DWAITM.
DWAITM says -- if there is not one, wait for it. If integer is
zero, no entry was found.
⊗
;FIRST THE INDICES INTO THE MESSAGE BLOCKS PASSED AROUND.
MAXPAR ←← 6 ;MAXIMUM NUMBER OF PARAMETERS.
PNTR ←←0 ;RH HAS POINTER TO NEXT QUEUE ENTRY.
BITS←←1 ;LH HAS GOOD BITS ABOUT THIS MESSAGE.
;RH HAS JOB NUMBER THAT SENT IT.
UNIQUE←←2 ;THIS IS WHERE THE UNIQUE NUMBER IS STORED..
ISOURCE←←3 ;TWO WORDS FOR SOURCE NAME (10 CHARS)
IDEST←←5 ; AND DESTINATION
INAME←←7 ; AND PROCEDURE NAME.
PARCNT←←11 ;PLACE FOR COUNT OF AMOUNT OF PARAMETER BLOCK
; USED TO DATE.
PARBEG←←11 ;1 AHEAD OF BEGINNING OF PARAMETER AREA.
PAREND←←PARBEG+3*MAXPAR ;3 WORDS PER PARAMETER ENTRY.
MESBLK ←←PAREND+1 ;LENGTH OF MESSAGE BLOCK.
;NOW THE DIRECTIVE BITS. ALL ARE ASSUMED RIGHT HALF IN DIRECTIVE.
DSEND←←1 ;SEND THE MESSAGE.
DWAIT←←2 ;WAIT FOR COMPLETION.
DKILL←←4 ;KILL THE MESSAGE.
DSOURCE←←10 ; MASK FOR GET_ENTRY
DDEST←←20 ; "
DNAME←←40 ; "
DWAITM←←100 ; WAIT FOR AN ENTRY TO APPEAR.
DACT←←200 ;ACTIVATE THE MESSAGE
DACK←←400 ;ACKNOWLEDGE THE MESSAGE.
DFIND←←1000 ;THIS IS THE "FIND AND ENTRY" CALL.
DEVERY←←2000 ;FOR "FIND" -- LOOK AT EVERY ENTRY, NOT JUST THOS
;"SENT"
DNOACT←←4000 ;SEND BUT DO NOT ACTIVATE USER.
DNOTRACE←←10000 ;DO NOT TRACE THIS MESSAGE.
DRETURN←←40000 ;RETURN REGARDLESS OF DWAITM
;NOW FOR THE BITS IN THE LH OF BITS WORD.
SENT ←← 1 ;THIS MESSAGE HAS BEEN SENT!
WAIT ←← 2 ;SOMEONE IS WAITING FOR THIS MESSAGE
;TO COMPLETE. HE IS IN MAIL WAIT.
KILL ←← 4 ;KILL THIS MESSAGE AFTER ACKNOWLEDGEMENT IS RECD.
ACT ←← 200 ;THIS MESSAGE IS ACTIVE.
ACK ←← 400 ;THIS MESSAGE HAS BEEN ACKNOWLEDGED.
GOTCOR ←← 1000 ;CORE HAS BEEN GOTTEN WHICH MUST BE RELEASED
INTERNAL SETFIL, SETDEV
SETFIL: 0 ; FILE THIS SEGMENT WAS LOADED FROM
SETDEV: 0 ; DEVICE THIS SEGMENT WAS LOADER FROM
;NOW THE SEMANTIC BITS COPIED FROM THE COMPILER.
COMMENT ⊗ BITS NOW IN HEAD NO LONGER NEEDED HERE.
VALUE←←4000 ;LEFT HALF WORD
REFRNC←←2000
SBSCRP←1
GLOBL←←200000 ;RIGHT HALF WORD
ITMVAR←4000
ITEM←←400
STRING←200
LPARRAY←←100
SET←40
LABEL←←20
FLOTNG←←2
INTEGR←←1
⊗
;BITS TO BE ADDED TO LEFT HALF OF TBITS FOR OUR USE.
CORGOT←←400000
SETRECLM←←200000
STRREF ←←100000 ;STRING BY REFERENCE.
DEFINE GETJOB (X)
<CALLI X,30>
OPDEF MAIL [(710000)]
; NOW FOR SOME ACTUAL STORAGE AREAS....
MESQ: 0 ;HOME FOR THE QUEUE.
QUETCH: -1 ;THE LOCK FOR DIDDLING THE QUEUE.
UNIQ: 0 ;THE SOURCE OF UNIQUE NUMBERS.
VERS: -1 ;THE VERSION NUMBER
INTERNAL TRACING
TRACING: 0 ;SET BY USER IF TRACING MESSAGES.
NJOB←←20; NUMBER OF JOBS ALLOWED
INTERNAL .JCNT.,.JTAB.,.JD1.,.JD2.
.JCNT.:
JOBCNT: 0 ;THIS IS THE NUMBER OF ENTRIES IN THE FOLLOWING
.JTAB.:
JOBTAB: BLOCK NJOB ;TABLE. THIS TABLE HAS (RH) JOB NUMBER, AND
;HIGH ORDER BIT SET IF THE JOB IS IN MAIL WAIT
;WAITING FOR MESSAGES TO APPEAR IN ITS QUEUE.
.JD1.:
DESTAB: BLOCK NJOB ;ALSO INDEXED BY JOBCNT -- FIRST WORD OF LOGICAL
;DESTINATION NAME.
.JD2.:
DESTB1: BLOCK NJOB ;AND SECOND WORD OF LOGICAL DEST. NAME.
0 ;SAVE FOR ERROR OUTPUT - MUST BE AFTER DESTB1
;MAGIC MACROS FOR TALKING ABOUT THE LOCKS.
DEFINE QENT <AOSE QUETCH
PUSHJ P,WAITX ;WAIT FOR IT
>
DEFINE QLEV <SOS QUETCH>
WAITX:
SOS QUETCH ;AND BACK UP.
PUSH P,C ;SAVE AN AC
MOVEI C,10 ;SLEEP FOR 10
CALLI C,31 ;SLEEP SOUNDLY
MOVNI C,2
ADDM C,-1(P) ;BACK UP PC
POP P,C ;RESTORE AC
POPJ P,
; FIRST THE ROUTINES FOR COMPOSING A MESSAGE.
INTERNAL .MES1,.MES2,ISSUE,QUEUE,GET.DATA,PUT.DATA,GET.ENTRY
INTERNAL GET.BIT,GET.SET
HERE (.MES1 ) ;START A BRAND NEW MESSAGE BLOCK.
PUSHJ P,SAVE ;AS ALWAYS.
PUSHJ P,.MES3 ;CALL LIKE THIS SO WE CAN USE INTERNALLY
GOA: MOVE LPSA,X11 ;AND RETURN.
JRST RESTR
.MES3: MOVEI C,MESBLK ;THIS IS HOW MUCH CORE WE NEED.
MOVEI TABL,GLUSER ;FORCE CORGZR TO GET SEC SEG CORE.
PUSHJ P,CORGZR ;AND GET IT ZEROED.
MOVEM B,CURMES(USER) ;SAVE FOR .MES2
GETJOB (C) ;GET JOB NUMBER
HRRZM C,BITS(B)
MOVEI C,PARBEG(B) ;START UP THE PARAM COUNT.
MOVEM C,PARCNT(B)
POPJ P,
HERE (.MES2) ;PROCESS ONE PARAMETER.
EXCH TAC1,(P) ;SAVE TBITS WORD FROM COMPILER.
PUSH P,TAC1 ;THE HORROR IS COMPLETE
PUSHJ P,SAVE ;AS ALWAYS.
SKIPN PNT,CURMES(USER) ;SHOULD BE ONE THERE.
ERR <MESSAGE: CONFUSION>,1
MOVE TAC1,-1(P) ;TBITS WORD.
MOVE A,-2(P) ;PARAMETER.
TLNN TAC1,VALUE ;WAS IT BY VALUE ??
JRST REFRNG ;NO -- REFERENCE.
TRNE TAC1,ITEM!ITMVAR ;THESE ??
JRST [CAIGE A,GBRK ;IS IT A GLOBAL ITEM ?
ITMER: ERR <MESSAGE: ITEM MUST BE GLOBAL>,1,RETIT
JRST COPY] ;OK -- GO AHEAD.
TRNE TAC1,STRING
JRST [PUSHJ P,STRCOP ;COPY STRING INTO SEC SEG.
PUSH P,(P) ;SINCE THERE WAS NO P PARAM.
JRST COPY]
TRNN TAC1,SET ;A SET ?
JRST COPY ; NO -- MUST BE ARITHMETIC -- OK.
MOVE D,-2(P) ;THE SET AGAIN
PUSH P,[COPY]
CHKSET: JUMPE D,CPOPJ ;IF NULL SET, WE ARE OK
HRRZ D,(D) ;GO DOWN SET TO MAKE SURE ALL ARE
TTZ: HLRZ B,(D) ;GLOBAL ITEMS.
CAIGE B,GBRK ;?
ERR <MESSAGE: ITEM MUST BE GLOBAL>,1
HRRZ D,(D) ;AND CONTINUE
JUMPN D,TTZ
TRNE A,400000 ;IS IT A GLOBAL SET ?
POPJ P, ;YES -- GO AHEAD.
PUSH P,C ;SAVE THIS.
PUSH P,PNT
MOVSI FLAG,GLBSRC ;...
WRITSEC ;FOOL WITH LEAP RUNTIME ROUTINES.
MOVEI TABL,GLUSER
PUSH P,A ;THE SET.
PUSH P,[0] ;
PUSHJ P,UNION ;COPY IT....
POP P,A ;THE RESULT.
HLRE B,A
MOVMS B
HRLM B,A
MOVE D,A ;AND IN REGISTER D.
MOVE TAC1,-4(P) ;THE TBITS AGAIN
TLO TAC1,SETRECLM ;A SET TO BE RECLAIMED.
HRLZI B,CORGOT; SAY WE GOT CORE
ORM B,BITS(PNT)
POP P,PNT
POP P,C
NOSEC
POPJ P, ;GO AWAY.
STRCOP: HRRZ C,-1(SP) ;COUNT
ADDI C,2*5+4 ;ENOUGH FOR BYTE PS.
IDIVI C,5
PUSHJ P,CORE2 ;GET CORE
ERR <NO CORE FOR MESSAGE>,1
MOVE TAC1,-2(P) ;SINCE CORE2 CLOBBERED.
HRRZ C,-1(SP) ;COUNT
MOVEM C,(B) ;FIRST WORD OF BYTE P.
HRLI D,(<POINT 7,0>)
HRRI D,2(B)
MOVEM D,1(B) ;SECOND WORD.
SOJL C,STDQ ;COUNT DOWN COUNT.
ILDB (SP)
IDPB D
JRST .-3
STDQ: TLO TAC1,CORGOT ;GOT CORE.
HRLZI D,GOTCOR ;SAY WE GOT CORE
ORM D,BITS(PNT)
MOVE D,B
MOVE A,B ;FOR COPY
SUB SP,X22 ;ADJUST STACK.
POPJ P,
REFRNG: ;REFERENCE VARIABLES.
TRNE A,400000 ;GLOBAL ALREADY?
JRST COPY ;YES -- PASS ON.
TLNE TAC1,SBSCRP ;AN ARRAY?
JRST ARRYS ;YES -- COPY IT.
TRNE TAC1,STRING ;OH GOD.
JRST [PUSH SP,-1(A) ;FIRST WORD OF BYTE P.
PUSH SP,(A)
PUSHJ P,STRCOP
TLO TAC1,STRREF;STRING BY REFERENCE.
JRST COPY]
MOVE C,PARCNT(PNT) ;OK. FUDGE UP A PLACE FOR THE REFERENCE.
MOVE D,(A) ;D NOW HAS THE ARGUMENT.
HRRI A,3(C) ;A NOW POINTS TO THE DATUM BLOCK FOR THIS PARAM
TRNN TAC1,SET ;IF NOT GLOBAL SET,
JRST COPY
PUSHJ P,CHKSET ;CHECK THE SET, AND RECOPY IF NECESSARY.
MOVEI A,3(C) ;RE ESTABLISH THE REFERENCE.
JRST COPY
ARRYS: TRNE TAC1,SET!STRING
ERR <MESSAGE: THESE ARRAYS TOO COMPLICATED>,1,RETIT
SETOM USCOR2(USER) ;WE WILL NEED CORE.
PUSH P,A ;ARRAY
;;#HO#↓ 6-7-72 DCS (1-2) ..ARCOP PROVIDES CORGET ADDR IN B
PUSHJ P,..ARCOP ;COPY THE ARRAY IN -1(P)
SETZM USCOR2(USER)
MOVE TAC1,-1(P) ;GET IT BACK.
TLO TAC1,CORGOT ;MARK FOR RELEASING
HRLZI C,GOTCOR ;SAY WE GOT CORE
ORM C,BITS(PNT)
;;#HO#↓ 6-7-72 DCS (2-2) PROVIDE CORGET ADDR TO PARAM BLOCK
MOVE D,B ;CORGET BLOCK ADDR RETURNED BY ..ARCOP
; JRST COPY
COPY: AOS C,PARCNT(PNT) ;INDEX COUNT
MOVEM A,(C) ;ARGUMENT (WILL BE PUSHED).
AOS C,PARCNT(PNT)
MOVEM TAC1,(C) ;TBITS,
AOS C,PARCNT(PNT)
HRRZM D,(C) ;OTHER POINTER
CAILE C,PAREND(PNT) ;GONE OFF END ??
ERR <MESSAGE: TOO MANY PARAMS>,1
RETIT: MOVE LPSA,X33
JRST RESTR
;NOW FOR THE MAIN "DOIT" CODE. THE ENTRY IS WITH:
; A ::: DIRECTIVE
; B ::: POINTS TO MESSAGE (OPTIONAL)
; C ::: UNIQUE NUMBER OF MESSAGE
QDOIT: MOVE USER,GOGTAB
TRNE A,DSEND ;SEND THE MESSAGE??
PUSHJ P,SENDIT
TRNE A,DWAIT ;WAIT FOR COMPLETION?
PUSHJ P,WAITC
TRNE A,DFIND ;IS THIS GET_ENTRY?
PUSHJ P,FIND1
TRNE A,DACT ;ACTIVATE
PUSHJ P,ACTIV
TRNE A,DACK ;ACKNOWLEDGE
PUSHJ P,ACKIT
TRNE A,DKILL
PUSHJ P,KILLIT
MOVE A,RACS+1(USER)
POPJ P,
SENDIT: TRNN A,DNOTRACE ;IF NOT TRACING THIS MESSAGE, OR
SKIPN TRACING ;NOT TRACING
JRST GGSEND ;DO IT.
PUSH P,A
PUSH P,C
QENT
PUSHJ P,FNDMES ;FIND MESSAGE *** KKP HAS MODIFIED THIS CODE ****
JRST [ POP P,C
POP P,A
JRST ALD1] ;NO SUCH MESSAGE
PUSH P,B ;SAVE POINTER TO MESSAGE
PUSHJ P,.MES3 ;START MESSAGE, PNTR IN B
MOVEI C,6 ;TWO PARAMETERS
ADDB C,PARCNT(B)
MOVE A,-1(P) ;NUMBER OF MESSAGE BEING TRACED.
MOVEM A,-5(C) ;STORE AWAY IN MESSAGE BLOCK.
CALLI A,23 ;MILLISECOND
MOVEM A,(C) ;TIME OF DAY.
SETZM PARBEG+3(B) ;CLEAR ARGUMENT COUNT
MOVEI A,-2(C) ;STORE POINTER TO ITSELF
MOVEM A,-2(C) ;THIS ALLOWS HE TO FIND REST OF INFO
POP P,PNT ;GET POINTER TO MESSAGE
MOVEI D,PARBEG+1(PNT) ;SET TO START OF ARGUMENTS IN MESSAGE
ARGLOP: CAML D,PARCNT(PNT) ;CHECK FOR END OF ARGUMENTS
JRST ARGEND
AOS PARBEG+3(B) ;INDEX ARGUMENT COUNT
MOVE A,1(D) ;GET SOME GOOD BITS
MOVEM A,2(C) ;AND STORE IN TRACE
TDNE A,[XWD SBSCRP,ITMVAR!ITEM!LPARRAY!SET!LABEL]
JRST ARGIND ;DO NOT STORE THESE ARGUMENTS
MOVE TAC1,(D); GET ARGUMENT
TLNE A,STRREF ;IF REFERENCE STRING - OK
JRST .+3
TLNE A,REFRNC; ;BY REFERENCE?
MOVE TAC1,(TAC1) ;YES, GET REAL ARGUMENT
MOVEM TAC1,1(C) ;STORE IN TRACE
ARGIND: ADDI D,3 ;INDEX POINTER FOR NEXT ARGUMENT
ADDI C,2
JRST ARGLOP
ARGEND: QLEV
PUSH P,[DSEND+DWAIT+DKILL+DNOTRACE]; *********************
PUSH SP,[0] ;THE ABOVE KLUDGE CAN BE UNDERSTOOD BY HE (AND ONLY HE)
PUSH SP,[0] ;SOURCE.....
PUSH SP,[5]
PUSH SP,[POINT 7,GODNAM]
PUSH SP,[5]
PUSH SP,[POINT 7,TRACNAM]
PUSHJ P,ISSUE ;DO IT.
POP P,C
POP P,A ;AND FINALLY SEND THE REAL MESSAGE.
GGSEND: QENT
PUSHJ P,FNDMES ;FIND THE MESSAGE
JRST ALD1 ;DISAPPEARED - FORGET ABOUT IT
MOVSI D,SENT ;TURN ON THE BIT.
TRZE A,DKILL ;IF HE ASKS TO KILL,
TLO D,KILL ;MARK FOR KILLING LATER.
TLO B,-1 ;FLAG TO SEE IF DESTINATION LOCATED.
IORM D,BITS(B)
MOVE D,JOBCNT ;NOW GO THROUGH THE TABLE, SENDING
TRNE A,DNOACT ;IF NOT ACTIVATE, ALL DONE.
JRST QLD2
AG1: SOJL D,ALD1 ;MAIL TO EVERYONE WHO IS IN MAIL WAIT.
MOVE PNT,IDEST(B) ;FIRST WORD OF LOGICAL DESTINATION.
CAME PNT,DESTAB(D) ;SAME AS STATED ?
JRST AG1 ;NO
MOVE PNT,IDEST+1(B) ;
CAME PNT,DESTB1(D) ;AND SECOND WORD.
JRST AG1
TLZ B,-1 ;DESTINATION FOUND.
SKIPL LPSA,JOBTAB(D) ;IN WAIT??
JRST ALD1 ;NO
HRRZS LPSA
MAIL 4,LPSA ;SEE IF HE ALREADY HAS MAIL WAITING.
SKIPA ;NO -- SEND SOME.
JRST ALD1 ;..
EXCH LPSA,A ;GET JOB # IN A.
;B HAS ADDRESS OF A FINE 32 WORD BLOCK.
;*** TEMPORARY ONLY
PUSH P,B
MOVEI B,0
;***
MAIL A ;SEND MAIL TO JOB NUMBER.....
MSER: JRST [ QLEV
ERR <MAIL SCREW>,1]
;****
POP P,B
;****
EXCH A,LPSA
JRST AG1 ;BACK FOR MORE.
ALD1: QLEV
TLNE B,-1
ERR <MESSAGE: NO SUCH DESTINATION>,1
POPJ P,
GODNAM:
TRACNAM: ASCII /TRACE/
WAITC: QENT
PUSHJ P,FNDMES
JRST ALD1 ;MESSAGE HAS DISAPPEARED, ASSUME ACK.
MOVE D,BITS(B) ;GET HIS BITS.
TLNE D,ACK ;ACKNOWLEDGED.
JRST DON ;YES -- OK.
MOVSI D,WAIT ;WE WILL GO INTO MAIL WAIT.
IORB D,BITS(B) ;
;*** BUG TRAP ***
GETJOB (B) ;GET JOB NUMBER IN B.
MOVE D,JOBCNT
SOJL D,ALDX
SKIPL LPSA,JOBTAB(D)
JRST .-2 ;
CAIE B,(LPSA) ;ARE WE IN THIS KIND OF WAIT
JRST .-4 ;NO -- NOT US
MOVE TAC1,JOBTAB(D); ARE WE REALLY WAITING? ******KKP INSERT
TLNE TAC1,1
JRST [ QLEV
OUTSTR [ASCIZ .MAIL WAIT CONFLICT
. ] ; YES - CAN'T HAPPEN
JRST .+1] ;BUT GO ON ANYWAY-MAYBE WE RESTARTED
HRRZS JOBTAB(D); NO - WE WERE IN INTERRUPT MODE ************
ALDX: QLEV ;GOING
;WAIT FOR MAIL AND SEE IF THIS IS THE ONE.
MAIL 1,1(P) ;A PLACE TO THROW MAIL
JRST WAITC ;AND DO IT AGAIN.
DON: TLNE D,KILL ;IS THIS GUY TO BE KILLED??
TRO A,DKILL ;YES- DO THAT NEXT.
QLD2: QLEV
POPJ P,
; ***** *****
; ***** *****
FIND1: PUSHJ P,GETSTR ;GET THE STRINGS.
GETJOB (0) ;GET JOB NUMBER IN 0.
DF1: QENT
SKIPA D,MESQ ;LOOK INTO CURRENT QUEUE
NEXQ: HRRZ D,PNTR(D) ;GO DOWN QUEUE
JUMPE D,QFIN ;DONE
MOVE LPSA,BITS(D) ;GET GOOD BITS.
TRNE A,DEVERY ;LOOK AT EVERY MESSAGE?
JRST TESR ;YES
TLNE LPSA,SENT ;ONLY IF SEND
TLNE LPSA,ACT!ACK ;AND NOT ALREADY PROCESSED.
JRST NEXQ ;NOT THIS ONE.
TESR:
MOVE LPSA,INAME(D) ;GET PROCEDURE NAME.
MOVE PNT,INAME+1(D) ; BOTH WORDS.
CAMN LPSA,[ASCII /RESTA/]
CAME PNT,[ASCIZ /RT/]
JRST TESR1
QLEV ;LEAVE QUEUE CORRECT.
MOVE C,UNIQUE(D) ;GET MESSAGE NUMBER.
PUSHJ P,KILLIT ;TAKE AWAY THE MESSAGE.
MOVE A,JOBSA
JRST (A) ;AND RESTART THE PROGRAM.
TESR1:
DEFINE COMP(DIR,X,Y) <
TRNN A,DIR
JRST .+7
MOVE LPSA,-Y-1(SP) ;FIRST WORD OF NAME.
CAME LPSA,X(D)
JRST NEXQ ;FAIL
MOVE LPSA,-Y(SP)
CAME LPSA,X+1(D)
JRST NEXQ
>
COMP (DSOURCE,ISOURCE,4)
COMP (DDEST,IDEST,2)
COMP (DNAME,INAME,0)
MOVE C,UNIQUE(D) ;THE NUMBER
NOJXX: MOVEM C,RACS+1(USER) ;..ANSWER
MOVE D,JOBCNT
TT2: SOJL D,NOJB1 ;ALL DONE.
SKIPL LPSA,JOBTAB(D) ;GET JOB NUMBER
JRST TT2
CAIE (LPSA) ;SAME AS US ?
JRST TT2
HRRZS JOBTAB(D) ;SAY WE ARE NO LONGER WAITING.
MAIL 2,1(P) ;READ MAIL IF ANY IS THERE.
JFCL
NOJB1: QLEV
POPJ P,
QFIN: TRNN A,DWAITM
JRST [MOVEI C,0
JRST NOJXX]
MOVE D,JOBCNT
TT3: SOJL D,[ QLEV
ERR <WHO ARE YOU??>,1,TTY5+1]
HRRZ LPSA,JOBTAB(D)
CAIE (LPSA) ;US ?
JRST TT3
TT4: HRROM JOBTAB(D) ;SAY WE ARE WAITING FOR MAIL.
TTY5: QLEV
TRNE A,DRETURN ;**** KKP ADDITION
JRST [ HRLZI TAC1,1 ;SET INTERRUPT MODE FLAG
ANDCAM TAC1,JOBTAB(D)
SETZM RACS+1(USER) ;NO MESSAGE READY
POPJ P,] ;RETURN ANYWAY - FOR USE WITH INTERRUPT ROUTINE ********
MAIL 1,1(P) ;WAIT FOR MAIL.
JRST DF1
ACTIV: QENT
PUSHJ P,FNDMES ;LOCATE THE MESSAGE.
JRST ALD1 ;SORRY - NO CAN DO
MOVE LPSA,INAME(B) ;GET THE NAME
MOVE PNT,INAME+1(B) ;AND THE SECOND PART OF THE NAME.
MOVE D,SPLNK(USER) ;SPACE ALLOCATION.
QT1: SKIPL FP,$MSLNK(D) ;MESSAGE PROCEDURE HOME.
JRST QT2 ;NO MESSAGE PROCEDURES IN THIS PROGRAM.
TEST: CAMN LPSA,2(FP)
CAME PNT,3(FP) ;SAME PROCEDURE??
JRST [HRRZ FP,(FP) ;GO TO NEXT PROCEDURE
JUMPN FP,TEST
QT2: HRRZ D,(D)
JUMPN D,QT1
JRST [SETZM RACS+1(USER)
QLEV
POPJ P,]
]
HRRZ FP,1(FP) ;ADDRESS OF PROCEDURE.
PUSH P,C ;UNIQUE NUMBER
PUSH P,A ;DIRECTIVE.
MOVEI LPSA,PARBEG(B) ;START OF PARAMETERS.
T3: CAML LPSA,PARCNT(B)
JRST CALLIT ;ALREADY TO GO.
MOVE A,2(LPSA) ;GOOD BITS WORD.
TRNE A,STRING ;WAS IT A STRING??
JRST [MOVE D,1(LPSA) ; → FIRST WORD OF STRING DESC.
;;#GI# DCS 2-5-72 REMOVE TOPSTR, FIX STRNGC BUG
PUSH P,A ;SAVE
MOVE A,(D) ;COUNT -- MUST BE IN A FOR GC
;; #GI# WAS USING C!
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
PUSH SP,A ;FIRST WORD OF RESULT
HRROS (SP) ;NON-CONSTANT
PUSH SP,TOPBYTE(USER); AND SECOND.
STRRZ: SOJL A,STRR
ILDB 1(D) ;GET A CHAR
IDPB TOPBYTE(USER) ;AND ANOTHER.
JRST STRRZ
STRR: POP P,A ;GET BITS BACK
;;#GI#
TLNN A,REFRNC ;REFERENCE ?
JRST .+2 ;NO -- GO AWAY.
POP SP,1(D) ;SAVE IN SEC. SEG.
POP SP,(D) ;...
AOS D ;POINT TO SEC WORD OF BP.
PUSH P,D ;AND A POINTER.
JRST .+2]
PUSH P,1(LPSA) ;ARGUMENT.
ADDI LPSA,3
JRST T3 ;AND LOOP
CALLIT: QLEV
PUSHJ P,(FP) ;CALL THE PROCEDURE.
MOVE USER,GOGTAB
QENT
MOVE C,-1(P) ;GET UNIQUE NUMBER
PUSHJ P,FNDMES ;GET MESSAGE AGAIN (DON'T LOCK OUT JOBS DURING MESSAGE ACTIVATION)
JRST [ QLEV
OUTSTR [ASCIZ .YOUR MESSAGE HAS DISAPPEARED
.]
JRST OLDT]
MOVE D,BITS(B) ;TURN OFF CORE BIT
TLZ D,GOTCOR
MOVEM D,BITS(B)
MOVEI D,PARBEG(B)
T4: CAML D,PARCNT(B)
JRST OLDTT ;DONE
MOVE A,2(D) ;TBITS WORD
TLNN A,CORGOT
JRST T5
PUSH P,B
MOVE B,3(D)
PUSHJ P,CORREL ;RELEASE IT.
POP P,B
T5: TLNN A,SETRECLM
JRST T6
MOVSI FLAG,GLBSRC
WRITSEC ;FIDDLE WYTH LEAP FREE STORAGE
MOVE FP,FP1+GLUSER
MOVE TAC1,3(D) ;.. SET.
HLRZ LPSA,(TAC1)
HRRM FP,(LPSA)
MOVEM TAC1,FP1+GLUSER
NOSEC ;DONE WITH FREE STORAGE.
T6: ADDI D,3 ;LOOP
JRST T4
OLDTT: QLEV
OLDT: POP P,A
POP P,C
POPJ P,
ACKIT: QENT
PUSHJ P,FNDMES
JRST ALD1; IF SOMEONE WAS IS WAIT, HE IS HUNG FOR GOOD
MOVE D,BITS(B) ;GET THE GOOD BITS.
TLZ D,SENT ;TURN OFF SO ANOTHER GET ENTRY DOESN'T
TLO D,ACK ;SEE IT -- ALSO ACKNOWLEDGE.
MOVEM D,BITS(B)
TLNN D,WAIT ;WAS THERE SOMEONE INWAIT??
JRST [TLNE D,KILL ;IF IT WAS MARKED FOR KILLING, THEN
TRO A,DKILL ;KILL IT NOW.
JRST T7]
PUSH P,A ;SAVE A.
HRRZ A,D ;GET JOB NUMBER ONLY.
MAIL 4,A ;SEE IF HE HAS MAIL WAITING.
SKIPA ;NO -- OK.
JRST MSER
;*** TEMPORARY
PUSH P,B
MOVEI B,2
;***
MAIL A ;SEND MAIL TO HIM......
JRST MSER
;***
POP P,B
;***
POP P,A
T7: QLEV ;ALL DONE.
POPJ P,
KILLIT: QENT
PUSHJ P,FNDMES
JRST ALD1
MOVE C,BITS(B)
TLNE C,GOTCOR ;WAS CORE RELEASED FOR THIS MESSAGE
JRST [ QLEV
ERR <MESSAGE SNATCHER!!>,1,KILLAB]
HRRZ C,(B) ;LINK DOWN LIST
HRRZM C,(LPSA) ;PATCH US OUT.....
QLEV
JRST CORREL ;RELEASE CORE.
; ***** *****
; ***** *****
;SERVICE ROUTINES.....
GETSTR: MOVEI D,-5(SP) ;DCS -- FIX OFLOW PROBLEM AFTER 6 CHARS
PUSHJ P,GET10
MOVEI D,-3(SP)
PUSHJ P,GET10
MOVEI D,-1(SP)
; JRST GET10
GET10: MOVE FP,1(D) ;BYTE POINTER.
MOVE LPSA,[POINT 7,(D)]
HRRZ TABL,(D) ;COUNT.
CAILE TABL,=10
MOVEI TABL,=10
SETZM (D)
SETZM 1(D) ;ZERO THE TARGETS
SOJL TABL,CPOPJ
ILDB FP
IDPB LPSA
JRST .-3
FNDMES: MOVEI LPSA,MESQ ;ALWAYS CALLED WITH LOCK SET
AOS (P)
ANOMES: MOVE B,(LPSA) ;GO DOWN LIST
JUMPE B,NOMES
CAMN C,UNIQUE(B)
JRST [MOVEM C,RACS+1(USER)
POPJ P,]
HRRZ LPSA,B
JUMPN LPSA,ANOMES
NOMES: SOS (P)
SETZM RACS+1(USER)
KILLAB: POPJ P,
; ***** *****
; ***** *****
HERE (ISSUE) ;A REAL RUNTIME ROUTINE.
PUSHJ P,GETSTR ;GET STRINGS.
MOVE B,CURMES(USER)
HRLI C,-5(SP)
HRRI C,ISOURCE(B)
BLT C,INAME+1(B) ;BLT IN STRINGS.
SUB SP,[XWD 6,6]
AOS C,UNIQ ;NEW NUMBER
MOVEM C,UNIQUE(B)
QENT ;PREPARE TO PUT IN QUEUE.
MOVEI D,MESQ ;
MOVEI E,(D)
HRRZ D,PNTR(D) ;GO DOWN LIST.
JUMPN D,.-2 ;UNTIL END.
HRRM B,PNTR(E)
QLEV
SETZM CURMES(USER) ;RESET THIS.
MOVE A,-1(P) ;DIRECTIVE......
ANDI A,DSEND!DWAIT!DKILL!DNOTRACE
TRNN A,DSEND ;IF HE DID NOT ASK TO SEND,
SKIPA A,C ;THEN JUST RETURN THE UNIQUE NUMBER.
PUSHJ P,QDOIT ;GO TO IT.
SUB P,X22
JRST @2(P) ;GO AWAY.
HERE (QUEUE) ;AND ANOTHER ROUTINE.
MOVE C,-1(P) ;UNIQUE NUMBER
MOVE A,-2(P) ;DIRECTIVE
ANDI A,DSEND!DWAIT!DACK!DACT!DKILL
JUMPE A,[ERR <NO DIRECTIVE>,1,QU2]
PUSHJ P,QDOIT
QU2: MOVE A,RACS+1(USER) ;.....GULP.....
SUB P,X33
JRST @3(P) ;GO AWAY.
HERE (GET.DATA)
MOVE USER,GOGTAB ;OH YES.
MOVE C,-1(P) ;UNIQUE NUMBER
QENT
PUSHJ P,FNDMES
JRST [ADD SP,X22 ;NULL STRING RESULT
SETZM -1(SP)
JRST ALDON]
;;#GI# DCS 2-5-72 REMOVE TOPSTR, FIX SOME STRNGC BUGS
;; #GI# CHAR COUNT MUSTMUSTMUST BE IN A WHEN STRNGC CALLED
MOVE A,B ;QUEUE BLOCK POINTER
MOVE B,-2(P)
ANDI B,3
LSH B,1 ;NOW READY FOR INDEX.
ADDI B,ISOURCE-2(A)
HRLI B,(<POINT 7,0>) ;TO GET BYTES.
MOVEI A,=10
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
PUSH SP,[0] ;START HERE
PUSH SP,TOPBYTE(USER)
LOPJ: ILDB B ;Queue names are a maximum of two
JUMPE ALDON ; words long. Transfer all of them
IDPB TOPBYTE(USER) ; to the string (null indicates end).
SOJGE A,LOPJ ;A=max# chars left
ALDON: MOVN A,A ;Replace number of chars left in REMCHR.
ADDM A,REMCHR(USER)
ADDI A,=10 ;10-#left=#used
HRROM A,-1(SP) ;Non-constant string, this long
QLEV
SUB P,X33
JRST @3(P) ;GO AWAY
HERE (PUT.DATA) ;PUT A STRING IN.
MOVE USER,GOGTAB
MOVEI D,-1(SP)
PUSHJ P,GET10
SKIPGE -2(P)
JRST [ MOVE C,-1(P); KILL JOB
MOVE D,JOBCNT
POP SP,TAC1; FLUSH GARBAGE
POP SP,TAC2
NXXQ: SOJL D,PUTQQ
MOVE B,JOBTAB(D)
CAIE C,(B); FIND TABLE ENTRY
JRST NXXQ
XX1: AOS D; REMOVE TABLE ENTRY
CAML D,JOBCNT
JRST [ SOS JOBCNT
JRST PUTQQ]
MOVE C,JOBTAB(D)
MOVEM C,JOBTAB-1(D)
MOVE C,DESTAB(D)
MOVEM C,DESTAB-1(D)
MOVE C,DESTB1(D)
MOVEM C,DESTB1-1(D)
JRST XX1]
SKIPG C,-1(P)
JRST [GETJOB (0) ;JOB NUMBER IN ZERO.
SETZM B
POP SP,TAC1
POP SP,TAC2
SKIPG C,VERS; TEST FOR VERSION #
JRST [ HLRZ C,JOBVER; INITIALIZE
CAILE C,1000; NONE GIVEN
SETZM C
MOVEM C,VERS
JRST NXTLAB]
NXTLAB: HLRZ D,JOBVER; GET CURRENT JOBS VERSION
CAILE D,1000
SETZM D; ZERO IF NONE
CAIE C,(D); THEY MUST AGREE
JRST [
NOSEG: MOVEM TAC2,DESTB1+NJOB-2;
MOVEM TAC1,DESTB1+NJOB-1
OUTSTR DESTB1+NJOB-2
CAIG C,(D)
ERR < - VERSION # TOO HIGH>,0
ERR < - VERSION # TOO LOW>,0]
MOVE D,JOBCNT
NOXQ: SOJL D,[JUMPN B,PUTQQ; FOUND NAME
QENT; LETS PLAY SAFE HERE
AOS D,JOBCNT
SUBI D,1
CAILE D,NJOB
JRST [ SOS JOBCNT
QLEV
ERR <TOO MANY JOBS>,1,PUTQQ]
HRRZM JOBTAB(D) ;JOB NUMBER RECORDED.
QLEV
JRST PUTXX]
MOVE C,JOBTAB(D)
CAIN (C) ;SAME AS US??
JRST PUTXX ;YES -- STORE
CAMN TAC2,DESTAB(D); TEST FOR ALREADY DEFINED
CAME TAC1,DESTB1(D)
CAIA
JRST [ ERR <LOGICAL NAME ALREADY DEFINED>,1,PUTZZ
PUTZZ: MOVEM JOBTAB(D)
SETOM B; BUT REDEFINE IF FORCED TO
JRST NOXQ]
JRST NOXQ
PUTXX: MOVEM TAC1,DESTB1(D)
MOVEM TAC2,DESTAB(D) ;FILL LOGICAL NAME TABLES.
SETOM B
JRST NOXQ]
QENT
PUSHJ P,FNDMES ;FIND IT
JRST [MOVEI A,0
JRST GOXX]
MOVE A,-2(P)
ANDI A,3
LSH A,1
ADDI A,ISOURCE-2(B)
GOXX: POP SP,1(A) ;PUT THE CHARACTERS DOWN.
POP SP,(A)
QLEV
PUTQQ: SUB P,X33
JRST @3(P)
HERE (GET.ENTRY) ;ANOTHER ROUTINE
MOVE A,-1(P)
ANDI A,DWAITM!DSOURCE!DDEST!DNAME!DRETURN
JUMPE A,[ERR <NO GET_ENTRY DIRECTIVE>,1,GETT4]
TRO A,DFIND
PUSHJ P,QDOIT
GETT4: SUB P,X22
SUB SP,[XWD 6,6]
JRST @2(P)
HERE (GET.SET)
MOVE USER,GOGTAB
PUSH P,[0] ;NULL SET.
MOVE A,-2(P) ;DIRECTIVE......
PUSHJ P,FIND1 ;GET STRINGS, LOOK FOR A MATCH.
;IF NONE, THEN WAIT IF DWAITM SET.
PUSH P,RACS+1(USER) ;SAVE FOR CHAINING.
MORST: SKIPN RACS+1(USER)
JRST NOMORQ
PUSH P,RACS+1(USER) ;RESULT.
MOVEI TAC1,-2(P) ;...
MOVEI FLAG,47 ;TO PUT IN SET
PUSHJ P,LEAP ;PUT IT IN SET.
MOVEI A,DWAITM
ANDCAB A,-3(P) ;TO DIRECTIVE.
POP P,C ;UNIQUE NUMBER LAST FOUND.
QENT
PUSHJ P,FNDMES ;GET ADDRESS IN B.
ERR <MESSAGE: CONFUSION>,1
MOVEI D,(B) ;COPY
GETJOB (0)
PUSHJ P,NEXQ ;AND LOOK FOR NEXT ONE. LOCK RELEASED IN SUBR
PUSH P,RACS+1(USER) ;SAVE UNIQUE NUMBER.
JRST MORST
NOMORQ: POP P,(P) ;LAST RESULT.
SKIPN MAXITM(USER)
ERR <GET_SET: NEED LEAP INITIALIZATION>,1
POP P,A ;THE SET
SUB P,X22
SUB SP,[XWD 6,6]
JRST @2(P)
HERE (GET.BIT)
MOVE USER,GOGTAB
MOVE C,-1(P) ;GET GOOD BITS FROM MESSAGE
QENT
PUSHJ P,FNDMES ;FIND THE MESSAGE
SKIPA A,[0]
HLRZ A,BITS(B) ;GET THE LEFT HALF TO THE RIGHT HALF.
QLEV
SUB P,X22
JRST @2(P)
>;GLOB
>;NOEXPO