Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50512/corout.b36
There are no other files named corout.b36 in the archive.
MODULE COROUTINE ( ! Coroutine support for BLISS-36 (CREATE,EXCHANGE)
IDENT = '1'
) =
BEGIN
!
! COPYRIGHT (c) 1978, 1978 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: COROUTINE
!
! ABSTRACT:
!
! Routines to support coroutines. This should be functionally equivalent
! to the BLISS-10 coroutine facility. Each coroutine has its own stack.
!
! The global routines contained herein are:
! A routine "CREATE" to set up a new pseudofork (process block plus stack),
! A routine "FTOP" to be the top level for any created fork,
! A routine "EXCHANGE" to switch from one pseudofork to another.
!
! An external routine "QUIT" is called to clean up a pseudofork on termination
!
!
! ENVIRONMENT: System independant
!
! AUTHOR: Andrew Nourse, CREATION DATE: 31-Dec-79
!
! MODIFIED BY:
!
! , : VERSION
! 01 - The beginning
!--
%IF %SWITCHES(DEBUG) %THEN %ERROR('COROUTINE cannot compile /DEBUG!') %FI
LITERAL SREG=15;
LITERAL VREG=1;
LINKAGE NOPRESERVE_ALL=PUSHJ:
LINKAGE_REGS(SREG,SREG,VREG)
NOPRESERVE(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14);
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
CREATE: NOVALUE, ! Create a new pseudoprocess
FTOP: NOVALUE, ! Top level for created processes
EXCHANGE, ! Save registers & swap stacks
EXCH: NOVALUE NOPRESERVE_ALL; ! Actually swap the stacks
!
! INCLUDE FILES:
!
LIBRARY 'INTR';
!
! MACROS:
!
MACRO ENABLE_FRAME_PTR= %NAME('EFPNT.') %;
!
! EQUATED SYMBOLS:
!
%IF NOT %DECLARED(FREG)
%THEN GLOBAL BIND FREG=%O'15'
%FI;
!
! OWN STORAGE:
!
GLOBAL
LASTRUN: REF PROCESS_BLOCK;
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
QUIT: NOVALUE; !Handle pseudofork termination
EXTERNAL ENABLE_FRAME_PTR; !Ptr to stack of ENABLEs
GLOBAL ROUTINE CREATE(FMAIN,ARG,NEWFORK,STACKLEN):NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Create a pseudoprocess (process block & stack) for coroutining
!
! FORMAL PARAMETERS:
!
! FMAIN: Routine to execute in new pseudoprocess
! ARG: Argument list for above routine
! NEWFORK: Address of process block & stack
! STACKLEN: Length of stack for new pseudoprocess
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! The new pseudoprocess is entered into the pseudoprocess table.
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP
ARG: REF VECTOR, ! Addr of argument list
NEWFORK: REF PROCESS_BLOCK; ! addr of new pseudoprocess
LOCAL
PTR: REF VECTOR; ! Pointer to arg list or stack
PTR=NEWFORK[P$ARGUMENT_LIST]; ! Argument list will go here
INCR I FROM 0 TO .ARG[0] ! Count is 1st word of list
DO ! Copy argument list to safe place
BEGIN !
.PTR=.ARG[.I]; ! Copy a word
PTR=.PTR+1 ! Bump pointer
END; !
PTR[PP$START]=.FMAIN; ! Routine to execute
PTR[PP$ARG]=.ARG; ! Arguments to above routine
PTR[PP$STACK_BASE]=FTOP; ! Transfers control to FTOP when run
NEWFORK[P$SP_PTR]=PTR[PP$STACK_BASE]; !Set up stack pointer
NEWFORK[P$SP_LEN]=-(.STACKLEN-2); !
END; !End of CREATE
GLOBAL ROUTINE FTOP (FMAIN,ARG) :NOVALUE = !
!++
! FUNCTIONAL DESCRIPTION:
!
! Call FMAIN with argument ARG, then QUIT
! The purpose is to prevent FMAIN from returning off the end
!
! FORMAL PARAMETERS:
!
! FMAIN: Routine to execute
! ARG: Argument to above routine
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE (Routine does not return)
!
! SIDE EFFECTS:
!
! Process requests deletion of itself (i.e. QUITs)
! when FMAIN returns
!--
BEGIN
FREG=0; !So SIX12 knows where to stop
QUIT((.FMAIN)(.ARG)); !QUIT never returns
END; !End of FTOP
GLOBAL ROUTINE EXCHANGE (NEXTFORK,VALRET) = !
!++
! FUNCTIONAL DESCRIPTION:
!
! Coroutine jump (Switch from one pseudoprocess to another)
!
! FORMAL PARAMETERS:
!
! NEXTFORK: Process block for next pseudoprocess to run
! VALRET: Value to return
!
! IMPLICIT INPUTS:
!
! LASTRUN should point to us (as always)
!
! IMPLICIT OUTPUTS:
!
! LASTRUN is set to point to NEXTFORK, SREG to his stack
!
! ROUTINE VALUE:
!
! Whatever is passed as VALRET to routine that EXCHANGES back to us
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP NEXTFORK: REF PROCESS_BLOCK; !This is a pseudoprocess pointer
EXCH(.NEXTFORK); !Swap things
.VALRET !Return value when we get back here
END; !End of EXCHANGE
ROUTINE EXCH (NEXTFORK): NOVALUE NOPRESERVE_ALL = !
!++
! FUNCTIONAL DESCRIPTION:
!
! Coroutine jump (Switch from one pseudoprocess to another)
! This routine does the actual switching.
! The outer routine EXCHANGE exists to save the registers.
!
! FORMAL PARAMETERS:
!
! NEXTFORK: Process block for next pseudoprocess to run
!
! IMPLICIT INPUTS:
!
! LASTRUN should point to us (as always)
!
! IMPLICIT OUTPUTS:
!
! LASTRUN is set to point to NEXTFORK, SREG to his stack
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP NEXTFORK: REF PROCESS_BLOCK; !This is a pseudoprocess pointer
LASTRUN[P$ENABLE_FRAME_PTR]=.ENABLE_FRAME_PTR; !Save old Enable frame
LASTRUN[P$SP]=.SREG; !Save current stack pointer
LASTRUN=.NEXTFORK; !Set up pointer to new pseudoprocess
SREG=.LASTRUN[P$SP]; !Set up new stack pointer
ENABLE_FRAME_PTR=.LASTRUN[P$ENABLE_FRAME_PTR];
!Set up Enable frame
END; !End of EXCHANGE
END !End of module
ELUDOM