COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	  FILES, SETNAM
C00004 00003	  Data structures:  Notes, note cells, message buffers
C00008 00004	  GETNOTE, SNDNOTE, SERVER
C00012 00005	  DOGTBUF, DOUSBUF, DORLBUF
C00014 00006	  LINKQUEUE, UNLQUE, SAMEID
C00017 00007	  TREATMESSAGE, GETOFS, DOERR, SNDANS
C00024 00008	  MAKREQ, SNDREQ
C00028 00009	  KTABLE, RTABLE, LOOKUP, RLOOKP, GETOCT, ascie messages
C00037 00010	   TACK, SKIPSP, SKIPOPT
C00039 00011	DODDT:	Service routine
C00041 00012	DOEVAL:
C00046 00013	  Driver for test of communications, ALINIT, ALKILL
C00051 ENDMK
C⊗;
;  FILES, SETNAM


.IFNDF ALAID
    DEBUG == 1
.IFF
    DEBUG == 0
.ENDC

KERNEL == 1
FLOAT == 1

.IFNZ DEBUG

;Set up the necessary mapping for the Zonker
	.INSRT ZONKER.PAL[AL,HE]

.OFFSET -160000		;Put ALAID in the Zonker

    .IF1
        .TITLE  Test of ALAID
        .INSRT ALHEAD.PAL[AL,HE]
        .INSRT K1DEF.PAL[11,SYS]
    .ENDC

. = PATCH
	.BLKW 200	;Patch area

	;If DDT sends us to user I space this will start the Kernel up anyway
. = START
	RESTRT		;EMT gets us into Kernel I space
	RESTRT
	RESTRT		;Kernel INIT entry point

. = INTRP

CODE$ == .		;Interpreter code & data spaces start here
DATA$ == .

    .INSRT ALIO.PAL[AL,HE]
    .INSRT FLOAT.PAL[AL,HE]
	STSW  LBDEBUG,1	;1 => first word of any large block is address of maker.
    .INSRT LARGEB.PAL[AL,HE]
    INSTSZ == 20    ;Size of an interpreter stack
.ENDC


.IFZ DEBUG
CODE
;  Special pseudo-ops

SETNAM:	;Interpreter code
	MOV @IPC(R4),INTNAM(R4)
	BMPIPC		;
	CCC		;Clear Condition Code
	RTS PC		;Done
.ENDC
;  Data structures:  Notes, note cells, message buffers

;  Notes from 10 to 11:
GETBUF == 1	;
USEBUF == 2	;
RELBUF == 3	;

;  Notes from 11 to 10:
BUFALC == 101	;
TAKBUF == 102	;

;  Offsets in notes:
ARG1 == 2
ARG2 == 4

;  Offsets in message buffers:
MESID == 0	;
MESTYP == 2	;
    FROMTEN == 1	;
    FROMELF == 2	;
    REQUEST == 4	;
    ANSWER == 10	;
MESLTH == 4	;
MESBEG == 6	;

;NOTB10  The notebox from 11 to the 10 (byte address) defined in COMTAB
;NOTB11  The notebox from 10 to the 11 (byte address) defined in COMTAB

NOTSIZ == 3		;  In WORDS!
BUFSIZ == 200		;  In WORDS!

DATA
NXTID:	.WORD 0	;Always even
CURNAM:	.WORD 0	;The current ISB for active interpreter.
ALLIVE:	.WORD 0	;AL interpreter alive if non-zero

;  Answer block:
	II == 0
	XX ANSBUF	;Points to a buffer for the return answer
	XX ANPTR	;Initialized to point to the start of the message in ANSBUF
	XX AGBUF	;Start of the request buffer
	XX AGARG	;Start of the arguments in request buffer
	XX AGPTR	;Points to the current place in the request
	XX VALPTR	;The value to be used in the answer
	XX GPHPTR	;The graph node to be used in the answer
	ABKSIZ == II/2	;Size of an answer block, in words.

;  Request block:
	II == 0
	XX REQBUF	;Place where the request will be assembled
	XX REQPTR	;Current end of the assembled request
	XX REQRES	;Where the response is placed
	XX REQEVT	;The event that will signal the return of the response
	XX REQQUE	;The queue node holding our waiting process
	RQBSIZ == II/2	;Size in WORDS.

;  Interlock event
ALDEVT:	.WORD 0

;HN  Halt Switch
HALTSW:	.WORD 0		;HN	  0 = Run  ,   1 = Halt

;  Waitqueue structure:
	II == 0
	XX QNEXT	;Next entry on queue
	XX QPREV	;Previous entry on queue
	   QID == II	;Identifier of this node.  Same field as QEVT.
	XX QEVT		;The event this waiter is expecting
	XX QBUF		;The answer he was waiting for
	QUELTH == II/2	;Length of queue node in WORDS.

WAITQ:	.BLKW QUELTH	;List of processes waiting to hear answers.

CODE
;  GETNOTE, SNDNOTE, SERVER

COMMENT ⊗ Since there is only one server, it is not necessary to put
any interlocks around code in GETNOTE and SNDNOTE.  ⊗

GETNOTE:
COMMENT ⊗ Returns the first note seen in a block pointed to by R0. ⊗
	MOV R2,-(SP)	;Save R2
1$:	TST NOTB11	;Anything there?
	BNE 2$		;Yes
	SLEEP #100	;and sleep a while
	TST ALLIVE	;See if the main interpreter has gone away
	BNE 1$		;if not try again
	DISMIS		;if so we should die
2$:	MOV #NOTSIZ,R0	;
	MOV R0,R2	;R2 ← Count of how many words to transfer
	JSR PC,GTFREE	;R0 ← place to store the note
	MOV #NOTB11,R1	;Transfer the note
3$:	MOV (R1)+,(R0)+
	SOB R2,3$	;Repeat
	SUB #2*NOTSIZ,R0	;Reset R0 to point to front of note.
	CLR NOTB11	;Clear the note, to say we got it.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

SNDNOTE:
COMMENT ⊗ R0 points to a note to send.  Send it and then release the
block. ⊗
	MOV R2,-(SP)	;Sve R2
1$:	TST NOTB10	;Anything there?
	BEQ 2$		;No.
	SLEEP #100	;Yes, so sleep a while
	BR  1$		;And try again
2$:	MOV #NOTSIZ-1,R1	;R1 ← count of words to send
	MOV #NOTB10+2,R2;R2 ← Where to put it.
	TST (R0)+	;Skip the first word; we will put it in last
3$:	MOV (R0)+,(R2)+
	SOB R1,3$	;Repeat
	SUB #2*NOTSIZ,R0	;Reset R0 ← LOC[note]
	MOV (R0),NOTB10	;Activate the note by sending the first word
	JSR PC,RLFREE	;Release the block.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

SERVER:
COMMENT ⊗ Listens for notes from the 10 and acts on them.  Never
returns. Uses R2. ⊗
	JSR  PC,GETNOTE	;R0 ← LOC[note]
	MOV (R0),R1	;R1 ← type of note
	MOV R0,R2 	;R2 ← LOC[note]

	CMP R1,#GETBUF	;GETBUF
	BNE 1$ 
	JSR PC,DOGTBUF	;
	BR 4$		;
1$:
	CMP R1,#USEBUF	;USEBUF
	BNE 2$
	JSR PC,DOUSBUF	;
	BR 4$		;
2$:
	CMP R1,#RELBUF	;RELBUF
	BNE 3$
	JSR PC,DORLBUF	;
	BR 4$		;
3$:
	ALERR SRVMES 	;Illegal code

4$:	MOV R2,R0	;Release the note.
	JSR PC,RLFREE	;
	BR SERVER	;One more river, there's one more river to cross.

DATA
SRVMES:	ASCIE </CAN'T UNDERSTAND NOTE FROM THE 10/>
CODE

;  DOGTBUF, DOUSBUF, DORLBUF

DOGTBUF:
COMMENT ⊗ Called by SERVER.  The 10 wants us to allocate a buffer.
R0 = LOC[note].  The size in bytes is in ARG1(R0).  We should respond
with BUFALC <size> <adr>.  ⊗
	MOV ARG1(R0),R0	;R0 ← size argument
	MOV R0,-(SP)	;Save size argument
	JSR  PC,GTFREE	;Get the buffer out of free storage
	MOV R0,-(SP)	;Save buffer address
	MOV #NOTSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new note to send]
	MOV #BUFALC,(R0)	;BUFALC
	MOV (SP)+,ARG2(R0) 	;  <adr>
	MOV (SP)+,ARG1(R0) 	;  <size>
	JSR PC,SNDNOTE	;Send the note off. (He will destroy it)
	RTS PC		;Done

DOUSBUF:
COMMENT ⊗ Called by SERVER.  R0 = LOC[note].  The buffer that starts
at address ARG1(R0) is a message.  Look at it, act on it, and then
recycle the message buffer.  ⊗
	MOV ARG1(R0),R0	;R0 ← LOC[message]
	JSR PC,TREATMESSAGE	;Treat it and release it
	RTS PC		;Done

DORLBUF:
COMMENT ⊗ Called by SERVER.  R0 = LOC[note].  The buffer that starts
at ARG1(R0) has been used by the 10, and we may deallocate it now. ⊗
	MOV ARG1(R0),R0	;R0 ← LOC[expended message]
	JSR PC,RLFREE	;
	RTS PC		;Done

;  LINKQUEUE, UNLQUE, SAMEID

LINKQUEUE:
COMMENT ⊗ There is a dummy queue at the start of the chain.  R1
points to the queue header, and R0 is the one we wish to add in.  
Exclusion should be on before this routine is called; it remains
on afterwards.  ⊗
	MOV QNEXT(R1),QNEXT(R0)
	MOV R1,QPREV(R0)
	MOV R0,QNEXT(R1)
	RTS PC

UNLQUE:
COMMENT ⊗ R0 points to a queue node.  It is unlinked from its queue.
R0 is left pointing at the same node.  Exclusion should be on before
this routine is called; it will remain on afterwards.  ⊗
	MOV QPREV(R0),R1	;R1 ← prev(old)
	MOV QNEXT(R0),QNEXT(R1)	;Transfer forward link.
	MOV QNEXT(R0),R1	;R1 ← next(old)
	BEQ 1$			;If any
	MOV QPREV(R0),QPREV(R1)	;Transfer backward link.
1$:	RTS PC			;Done.


SAMEID:
COMMENT ⊗ R0 = header of queue.  R1 = ID to look for.  If there is a
node in the queue with that ID, it is returned in R0.  Otherwise, R0
← 0.  Exclusion should be on before this routine is called; it will
remain on afterwards.  ⊗
1$:	MOV QNEXT(R0),R0	;R0 ← next (real) node in queue
	BEQ 2$			;If any.
	CMP QID(R0),R1		;Match the ID?
	BNE 1$			;No.  Try next one.
	JSR PC,UNLQUE		;R0 ← same node, now unlinked.
2$:	RTS PC			;Done

;  TREATMESSAGE, GETOFS, DOERR, SNDANS

TREATMESSAGE:
COMMENT ⊗ R0 = LOC[buffer from the 10].  Print out its contents and
treat it.  ⊗
	MOV R2,-(SP)	;Save R2
	MOV R0,R2	;R2 ← LOC[buffer]

	;print the message
   .IFZ DEBUG
	EVWAIT CSLEVT	;
   .ENDC
	MOV #CRLFX,R0	;
	JSR PC,TYPSTR	;
	MOV R2,R0	;
	ADD #MESBEG,R0	;R0 ← LOC[start of message itself]
	JSR PC,TYPSTR	;Print it
   .IFZ DEBUG
	EVSIG CSLEVT	;
   .ENDC

	;see what kind of message it is
	MOV R2,R0	;
	MOV MESTYP(R0),R1	;R1 ← MESTYPE;
	BIT #ANSWER,R1	;An  answer?
	BEQ 2$		;No
	

	;got a response.  See if anyone is waiting to hear it.
	MOV MESID(R0),R1;R1 ← MESID
	EVWAIT ALDEVT	;Enter critical section
	MOV #WAITQ,R0	;R0 ← head of wait.
	JSR PC,SAMEID	;R0 ← queue node waiting for this MESID.
	EVSIG ALDEVT	;End of critical section
	TST R0		;Was there a waiting process?
	BNE 1$		;Yes.
	ALERR TRTMMS	;None found.  A bug!
1$:	MOV R2,QBUF(R0)	;Give him his result.
	EVSIG QEVT(R0)	;Give him his signal
	BR 3$		;Prepare to leave
	
	;got a question.  Get someone to look at it.
2$:	JSR PC,RLOOKP	;Start up a process to fulfill the request and
			;delete the message

3$:	MOV (SP)+,R2	;Restore R2
	RTS PC		;

DATA
TRTMMS:	ASCIE </GOT UNEXPECTED ANSWER FROM THE 10./>
CODE

GETOFS:	
COMMENT ⊗ R2 = LOC[answer block].  We want to see (OFFSET n).  If we
do, we put LOC[graph node for n] in GPHPTR(R2); otherwise R0 ← 0.  R2 is
still LOC[answer block], but ARGPTR is properly updated. ⊗
	MOV AGARG(R2),R0;R0 ← LOC[argument string]
	CMPB (R0)+,#'(	;A left paren?
	BNE 1$		;No.  
	JSR PC,LOOKUP	;R0 ← next thing on arg, R1 ← OFSCOD, we hope.
	CMP R1,#OFSCOD	;Was it offset?
	BNE 1$		;No.
	JSR PC,GETOCT	;R0 ← after the arg, R1 ← octal number found.
	MOV R0,AGPTR(R2);Save arg. ptr
	MOV R1,R0	;R0 ← integer offset
	MOV CURNAM,R4	;R4 ← LOC[ISB of active interpreter]
	JSR PC,GETARG	;R0 ← LOC[environment entry for variable]
	MOV R0,GPHPTR(R2)
	BEQ 1$		;If anyone home.  Else will return failure.
	MOV AGPTR(R2),R0;
	JSR PC,SKIPSP	;Skip spaces.
	MOV #'),R1	;
	JSR PC,SKIPOP	;Skip the ), if it is there.
	MOV R0,AGPTR(R2);
	RTS PC		;
1$:	CLR R0		;Failure return
	RTS PC		;

DOERR:	
COMMENT ⊗ There has been an error in parsing some command. R2 =
LOC[answer block].  We will say "ERROR (message)".  R2 will be left
with ANPTR fixed up.  ⊗
	MOV ANPTR(R2),R0;R0 ← answer pointer
	MOV #ERRMES,R1	;
	JSR PC,TACK	;Tack on "ERROR "
	MOV #LPAREN,R1	;
	JSR PC,TACK	;Tack on " ( "
	MOV AGBUF(R2),R1;
	ADD #MESBEG,R1	;
	JSR PC,TACK	;Tack on the original message
	MOV #RPAREN,R1	;
	JSR PC,TACK	;Tack on " ) "
	MOV R0,ANPTR(R2);
	JMP SNDANS	;He will never return.

SNDANS:
COMMENT ⊗ R2 = LOC[answer block]. ANPTR(R2) = end of the message.
ANSBUF(R2) = front of the message.  Compute the message length, send
the message out, reclaim the answer block, including the AGBUF, and
then reclaim the interpreter stack, the PDB of this process and
dismiss. ⊗

	;compute MESLTH
	MOV ANPTR(R2),R1;R1 ← ans. ptr
	MOV ANSBUF(R2),R0	;R0 ← LOC[answer buffer]
	SUB R0,R1	;R1 ← length in bytes of message
	ASR R1		;in words
	BCC 1$		;HN OK if even numbers of bytes
	INC R1		;HN otherwise add 1 to the length in words
	INC ANPTR(R2)	;HN reflct on the ans. ptr
	MOVB #' ,@ANPTR(R2)	;HN and put a blank byte at the end of the mess.
1$:	MOV R1,MESLTH(R0); MESLTH


	;send the result back.  R0 = LOC[message]
	MOV #NOTSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new note to send]
	MOV #TAKBUF,(R0);TAKBUF
	MOV (SP),R1	;R1 ← LOC[answer block]
	MOV ANSBUF(R2),ARG1(R0)	;  <adr>
	JSR PC,SNDNOTE	;Send the note off. (He will destroy it)

	;reclaim answer block
	MOV R2,R0	;Reclaim the argument message buffer
	MOV AGBUF(R0),R0;
	JSR PC,RLFREE	;
	MOV R2,R0	;Reclaim the answer block itself
	JSR PC,RLFREE	;

	;reclaim interpreter stack
	MOV R3,R0
	SUB #2*INSTSZ,R0
	JSR PC,RLFREE

	;reclaim Processor Desriptor Block
	MOV R5,R0	;
	JSR PC,RLFREE	;
	DISMIS		;Gone!

;  MAKREQ, SNDREQ

MAKREQ:	
COMMENT ⊗ Returns in R3 a pointer to a brand new request block, with
REQBUF and REQPTR initialized to a new area for assembling a request.
The REQBUF is initialized with MESTYP.  ⊗
	MOV #RQBSIZ,R0	;Get a request block
	JSR PC,GTFREE	;
	MOV R0,R3	;R3 ← LOC[request block]
	MOV #BUFSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[request buffer]
	MOV #FROMELF+REQUEST,MESTYP(R0)
	MOV R0,REQBUF(R3)
	ADD #MESBEG,R0	;
	MOV R0,REQPTR(R3)
	RTS PC		;

SNDREQ:
COMMENT ⊗ R3 = LOC[request block]. REQPTR(R3) = end of the message.
REQBUF(R3) = front of the message.  Compute the message length, send
the message out, wait for a reply, and then put the response in
REQRES(R3).  R3 is left pointing to the request block.  ⊗

	;compute MESLTH
	MOV REQPTR(R3),R1	;R1 ← ans. ptr
	MOV REQBUF(R3),R0	;R0 ← LOC[request buffer]
	SUB R0,R1	;R1 ← length in bytes of message
	ASR R1		;in words
	MOV R1,MESLTH(R0); MESLTH

	MOV REQBUF(R3),R0	;R0 ← LOC[message buffer]
	EVMAK		;Get an event that will signal the response to the request.
 	MOV (SP),MESID(R0)	;That will be the MESID.
	MOV (SP)+,REQEVT(R3)	;REQEVT

	MOV #QUELTH,R0	;Enqueue ourselves for the response
	JSR PC,GTFREE	;R0 ← LOC[queue node]
	MOV R0,REQQUE(R3)	;REQQUE
	MOV REQEVT(R3),QEVT(R0)	;QEVT
	EVWAIT ALDEVT	;Enter critical region
	MOV #WAITQ,R1	;
	JSR PC,LINKQUEUE;
	EVSIG ALDEVT	;Leave critical region

	;send the request out.  R0 = LOC[message]
	MOV #NOTSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new note to send]
	MOV #TAKBUF,(R0);TAKBUF
	MOV REQBUF(R3),ARG1(R0)	;  <adr>
	JSR PC,SNDNOTE	;Send the note off. (He will destroy it)
	EVWAIT REQEVT(R3)	;Wait for the event to happen

        COMMENT ⊗ When the answer comes, the server will unlink the
        queue for us.  We must destroy the event and reclaim the
        queue node ourselves.  ⊗

	;the response has come, and the answer is in QBUF(REQQUE(R3))
	EVKIL REQEVT(R3)	;
	MOV REQQUE(R3),R0	;
	MOV QBUF(R0),REQRES(R3)	;REQRES
	JSR PC,RLFREE		;Release the queue node
	RTS PC		;
;  KTABLE, RTABLE, LOOKUP, RLOOKP, GETOCT, ascie messages

DATA
LPAREN:	.ASCIZ / ( /
RPAREN:	.ASCIZ / ) /
DONEMES:.ASCIZ /DONE /
ERRMES:	.ASCIZ /ERROR /
YTHMES:	.ASCIZ /YOUTHERE /
HLTMSG:	.ASCIZ /ALL ACTIVE INTERPRETERS HALTED/	        ;HN
	.EVEN

	.MACRO KWORD KNAME, KINFO
	II == .
	ASCIE /KNAME/
	. = II + 6	;Truncate to 6 characters
	KINFO		;Either code for this keyword, or service routine address
	.ENDM
	
OFSCOD == 1
SCACOD == 2
VCTCOD == 3
TRACOD == 4
PLCCOD == 5

KTABLE:	;List of keywords.
	KWORD <OFFSET>, OFSCOD
	KWORD <SCALAR>, SCACOD
	KWORD <VECTOR>, VCTCOD
	KWORD <TRANS >, TRACOD
	KWORD <PLACE >, PLCCOD
KTEND:	.WORD 0

RTABLE:	;List of requests.
	KWORD <EVAL  >, DOEVAL		;HN
	KWORD <DDT   >, DODDT
RTEND:	.WORD 0
CODE

COMMENT ⊗ R0 = LOC[string]. Find which keyword heads the string,
using a disgusting linear search, and return R1 ← 0 if no keyword
found, otherwise R1 ← code for that keyword.  R0 ← next entry on
string. ⊗

LOOKUP:	
	MOV R2,-(SP)	;Save R2
	MOV #KTABLE,R1	;R1 ← LOC[current try in KTABLE]
1$:	MOV #6,R2	;R2 ← count of how many characters to match.
2$:	CMPB (R0)+,(R1)+;Match the next letter?
	BEQ 4$		;Yes
3$:	ADD R2,R0	;
	SUB #7,R0	;R0 ← start of given string.
	ADD R2,R1	;R1 ← end of test string
	TSTB (R1)+	;R1 ← start of next test string
	CMP R1,#KTEND	;Off the end?
	BLO 1$		;No.
	BR 6$		;Yes.
4$:	SOB R2,2$	;Try the next, if any.
	;found a match.  R1 = LOC[KINFO]
	JSR PC,SKIPSP 	;Skip spaces (does not hurt R1)
	MOV (R1),R1	;R1 ← KINFO
5$:	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done
6$:	CLR R1		;Did not find anything
	BR 5$		;

COMMENT ⊗ R0 = LOC[message buffer request]. Find which request word
heads the string, using a disgusting linear search, and start a
process to handle the request.  He will see to the deletion of the
message buffer.  ⊗

RLOOKP:	
	MOV R2,-(SP)	;Save R2
	MOV R0,-(SP)	;Save LOC[message buffer request]
	ADD #MESBEG,R0	;R0 ← LOC[request string]
	MOV #RTABLE,R1	;R1 ← LOC[current try in KTABLE]
1$:	MOV #6,R2	;R2 ← count of how many characters to match.
2$:	CMPB (R0)+,(R1)+;Match the next letter?
	BEQ 4$		;Yes
3$:	ADD R2,R0	;
	SUB #7,R0	;R0 ← start of given string.
	ADD R2,R1	;R1 ← end of test string
	TSTB (R1)+	;R1 ← start of next test string
	CMP R1,#RTEND	;Off the end?
	BLO 1$		;No.
	MOV #DOERR,R2	;So what we will do is handle the error.
	BR 5$
4$:	SOB R2,2$	;Try the next, if any.
	;found a match.  R1 = LOC[KINFO]
	MOV (R1),R2	;R2 ← KINFO = address of service routine
5$:	JSR PC,SKIPSP 	;Skip spaces
	MOV R0,-(SP)	;Save AGPTR

	;build the answer block
	MOV #BUFSIZ,R0	
	JSR PC,GTFREE	;R0 ← LOC[answer buffer]
	MOV 2(SP),R1	;R1 ← AGBUF
	MOV MESID(R1),MESID(R0)	;Transfer the MESID to answer from request.
	MOV #FROMELF+ANSWER,MESTYP(R0)	;MESTYP
	MOV R0,-(SP)	;Save ANSBUF
	MOV #ABKSIZ,R0	;Get an answer block
	JSR PC,GTFREE	;R0 ← LOC[answer block]
	MOV (SP)+,R1	;R1 ← ANSBUF
	MOV R1,ANSBUF(R0)
	ADD #MESBEG,R1	;
	MOV R1,ANPTR(R0);
	MOV (SP),AGARG(R0)
	MOV (SP)+,AGPTR(R0)
	MOV (SP)+,AGBUF(R0)
	MOV R0,-(SP)	;Save LOC[answer block]

	;set up a new process with R2 ← LOC[answer block] to fulfil request.
	INSTSZ == 20	;Size of an interpreter stack
	MOV #INSTSZ,R0	;R3 stack space
	JSR PC,GTFREE	;
	ADD #2*INSTSZ,R0	;to end of space
	MOV R0,-(SP)	;Save stack space
	MOV #210,R0	;Room for process descriptor
	JSR PC,GTFREE	;R0 ← LOC[new process descriptor]
	MOV #UFPUSE+UGRSAV+4,PDBSTA(R0);Use floating point, use saved registers.
	MOV R0,USKMIN(R0)	;Set up min pointer for SP
	ADD #UFEC+36,USKMIN(R0)
	MOV R0,USKMAX(R0)	;Set up max pointer for SP
	ADD #420,USKMAX(R0)
	MOV #144100,UPSW(R0)	;Set up psw
	MOV (SP)+,PDBR3(R0)	;Store away the R3 stack pointer.
	MOV (SP)+,PDBR2(R0)	;Store away the R2 = LOC[answer block]
	MOV CURNAM,PDBR4(R0)	;Start out on the current ISB
	MOV R0,PDBR5(R0)	;Store away the R5 = PDB address.
	MOV #USRIM,UIMAP(R0)	;Map instruction space
	FORK R0,R2,#USRDM	;Cause the new process to be started

6$:	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

GETOCT:
COMMENT ⊗ R0 = string pointer.  Finds an octal number, skipping
spaces to do so, and places its value in R1.  Leaves R0 at end of
spaces following the string. ⊗
	MOV R2,-(SP)	;Save R2
	CLR R1		;R1 is the eventual result
	JSR PC,SKIPSP	;Skip leading spaces
1$:	MOVB (R0)+,R2	;R2 ← Character
	CMP #'0,R2	;Too small?
	BGT 2$		;yes
	CMP #'7,R2	;Too large?
	BGE 3$		;no
2$:	TSTB -(R0)	;Move back one place
	JSR PC,SKIPSP	;skip trailing spaces
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done
3$:	MOV R2,-(SP)	;Save the character
	ASH #3,R1	;Compute new result
	BIC #60,(SP)	;
	ADD (SP)+,R1	;
	BR  1$		;And repeat
   TACK, SKIPSP, SKIPOPT

TACK:
COMMENT ⊗ R1 = LOC[ascie string to tack on], R0 = LOC[where to put
it].  Returns R0 ← next location available in destination string.  ⊗
	MOVB (R1)+,(R0)+;Copy a byte
	BNE TACK	;Repeat while necessary
	DEC R0		;Go back past the null
	RTS PC		;Done

SKIPSP:
COMMENT ⊗ R0 = LOC[string].  Skip past any spaces, returning R0 ← LOC[next
non-space element of the string.  Leaves R1 unchanged.  ⊗
	CMPB (R0)+,#' 	;
	BEQ SKIPSP	;
	DEC R0		;Go back past the non-space
	RTS PC		;

SKIPOPT:
COMMENT ⊗ R0 = LOC[string].  Skip past the character in R1, if it is
the next character, and in any case, skip past any spaces.  ⊗
	CMPB (R0),R1	;The optional character?
	BNE 1$		;No
	TSTB (R0)+	;Yes.  Skip it.
1$:	JMP SKIPSP	;Skip over spaces, and let SKIPSP return.

DODDT:	;Service routine
COMMENT ⊗ Jump to DDT, so that ↑P will proceed. The answer is of the
form "DONE", unless something goes wrong, in which case the answer
will be "ERROR (DDT arg)".  ⊗

	ALERR DODDTMES	;Here we go to DDT.

	;test stuff.  Current test:  Try the turn-around question YOUTHERE
	;at the ten.
	MOV R3,-(SP)	;Save R3
	JSR PC,MAKREQ	;R3 ← request block.
	MOV REQPTR(R3),R0	;R0 ← REQPTR
	MOV #YTHMES,R1	;Tack on "YOUTHERE"
	JSR PC,TACK	;
	MOV R0,REQPTR(R3)
	JSR PC,SNDREQ	;Send the request on its way, and eventually come back
			;with response in the REQRES(R3)
	MOV REQRES(R3),R0	;
	ADD #MESBEG,R0	;Print out the response
	JSR PC,TYPSTR	;
	MOV REQRES(R3),R0	;Reclaim the response buffer
	JSR PC,RLFREE	;
	MOV R3,R0	;Reclaim request block
	JSR PC,RLFREE	;
	MOV (SP)+,R3	;Restore R3

	;prepare the answer. Note that TACK and TACKVAL take a string pointer
	; in R0 and leave it right afterwords.
	MOV ANPTR(R2),R0	;R0 ← answer pointer
	MOV #DONEMES,R1	;
	JSR PC,TACK	;Tack on "DONE "

	;ANPTR(R2) = end of the message.  ANSBUF(R2) = front of the message
	JMP SNDANS	;Send it winging on its way. Reclaim the answer block.
			;Reclaim the PDB.  Dismiss.

DATA
DODDTMES:  ASCIE </SWITCHING TO DDT/>
CODE
DOEVAL:
Comment ⊗ This service routine causes execution (or evaluation) of a list of pcodes
	sent to the 11 (us !) ⊗

	MOV CURNAM,R4	
	MOV R2,-(SP)	;save the answer block pointer
	MOV AGPTR(R2),R0	; address of the first word of the pcode list
	ADD #2,R0	;first word has the number of variables for the environment
	EVMAK		;-(SP)← event to signal when pcode list processed
	MOV (SP),R1	;prepare for spawn
	JSR PC,SPAWN	;R0 ← PDB[new interpreter process].
	MOV AGPTR(R2),R1	; address of the first word of the pcode list
	MOV R0,R2	;R2 ← new process control block 

	;Set up the new environment
	MOV (R1),R0	;Get number of variables used in this environment
	ASL R0		;Need 2 words/variable
	ADD #ENVSIZ,R0	;Add in header size
	JSR PC,GTFREE	;Allocate from large blocks
	MOV R0,LVARS(R0)
	ADD #2*ENVSIZ,LVARS(R0)	;Initialize where the first free entry should go

	MOV PDBR4(R2),CURNAM	;Set current interpreter to this one.
	MOV ENV(R4),SLINK(R0)	;Not necessary to set up OLEV, etc.
	MOV PDBR4(R2),R1
	MOV R0,ENV(R1)
	INC LEV(R1)

	FORK R2,#INTERP,#USRDM	   ;Cause the new process to be started.
	POP <R1>
	EVWAIT R1	;wait until the pcode list is processed
;	EVKIL R1	;event is not needed any more
	MOV (SP)+,R2	;now restore R2 (the answer-block pointer)
	MOV ANPTR(R2),R0	;R0 ← answer pointer
       	MOV #DONEMES,R1	;HN
	JSR PC,TACK	;HN
	MOV R0,ANPTR(R2);HN
	JMP SNDANS	;HN

;  Driver for test of communications, ALINIT, ALKILL

.IFNZ DEBUG

temp == %OFFSE	;Save the current offset
.OFFSET 0	;We want to use real physical addresses here for the kernel

	PUTLOC JOBDAT, MAINBL
	PUTLOC JOBSA, START
	PUTLOC JOBDM, USRDM

.OFFSET temp	;Restore Offset

DATA
MAINBL:	PDBLK 1,200,S	;Makes a process descriptor for main process
CODE
START:	JSR PC,IOINIT	;
	JSR PC,FRINIT	;
	CLR NOTB10
	CLR NOTB11
	EVMAK		;Create and signal once the AL interlock event.
	MOV (SP),ALDEVT	;
	EVSIG		;
	CLR WAITQ+QNEXT	;
	JMP SERVER	;No, he'll never return


GETARG:	MOV R0,FAKE	;
	MOV #FAKE1,R0	;
	RTS PC

DATA
FAKE:	.BLKW 2	;Long enough for floating
FAKE1:	FAKE
CODE

ROUTINE GETVAL,<GTV.ARG>
	MOV GTV.ARG(RF),R0
	RTS PC

ROUTINE CHANGE,<CHG.ND,CHG.VN>
	RTS PC

GETSCA:	MOV #FAKE,R0	;
	MOV R0,-(R3)	;
	RTS PC		;

GETTRN:	MOV #60,R0	;
	JSR PC,GTFREE	;
	MOV R0,-(R3)	;

TACKVAL:
COMMENT ⊗ R1 = LOC[value], R0 ← where to put it ⊗
	MOV #FAKEMES,R1	;
	JMP TACK	;
DATA
FAKEMES:ASCIE </999.999/>
CODE

.ENDC

DATA
ALPDB:	PDBLK 2,150,S	;Makes a process descriptor for server
CODE

ALINIT:
COMMENT ⊗ Start up one copy of the server as a separate job. ⊗
	EVMAK			;Create and signal once the AL interlock event.
	MOV (SP),ALDEVT
	EVSIG
	CLR WAITQ+QNEXT
	CLR NOTB11
	CLR NOTB10
	MOV #1,ALLIVE		;Indicate that the AL interpreter is alive
	MOV #20,R0		;R3 stack space
	JSR PC,GTFREE
	ADD #40,R0		;to end of space
	MOV #ALPDB,R1		;R1 ← LOC[ALAID process descriptor]
	BIS #UGRSAV+USKSAV,PDBSTA(R1)	;Use saved registers.
	MOV R0,PDBR3(R1)	;Store away the R3 stack pointer.
	MOV USKMAX(R1),USKP(R1)	;Make sure we have a good stack pointer
	SCHEDU R1,#SERVER,#USRDM,#2 ;Cause the new process to be started, suspended
	RTS PC

ALKILL:	CLR ALLIVE		;Indicate that the AL interpreter is dead
	RTS PC