%RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
%EXTERNALROUTINESPEC PTREC(%RECORDNAME P)
%EXTRINSICLONGINTEGER KMON
%EXTERNALSTRING(15)%FNSPEC STRINT(%INTEGER N)
%EXTERNALSTRING(15)%FNSPEC HTOS(%INTEGER N,M)
%EXTERNALROUTINESPEC OPMESS(%STRING(63) S)
%EXTERNALROUTINESPEC MONITOR(%STRING(63) S)
%EXTERNALROUTINESPEC PON(%RECORDNAME P)  
!-----------------------------------------------------------------------
%EXTERNALROUTINE SEMAPHORE(%RECORDNAME P)
%RECORDSPEC P(PARMF)
%OWNBYTEINTEGERARRAY HASH(0:31)=0(32)
! ARRAY DIMENSIONS ASSUME ONLY 'MAXPROCS' SEMAPHORES IN USE AT ONCE
%OWNINTEGERARRAY CELL(1:128)=0(128)    ;  ! (1:MAXPROCS)
%OWNBYTEINTEGERARRAY LINK(1:128)=2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,
  17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,
  40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,
  63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,
  85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,
  105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,
  121,122,123,124,125,126,127,128,1
%OWNINTEGER ASL=128
%INTEGERFNSPEC NEWCELL(%INTEGER S)
%INTEGERFNSPEC RETURN CELL(%INTEGER I)
%INTEGER SEMA, HASHP, NCELL, I
%BYTEINTEGERNAME CELLP
%SWITCH ACT(1:3)
   %IF KMON&1<<7#0 %THEN PRINT STRING('SEMAPHORE:') %C
      %AND PTREC(P)
   ->ACT(P_DEST&X'FFFF')
!-----------------------------------------------------------------------
ACT(1):                                 ! P OPERATION
   SEMA=P_P1&X'FFFF'
   HASHP=SEMA-SEMA//31*31
   CELLP==HASH(HASHP)
   %WHILE CELLP#0 %CYCLE
      %IF SEMA=CELL(CELLP)&X'FFFF' %THEN %START
         I=CELL(CELLP)>>16&X'FF'
         %IF I=0 %THEN %START;          ! ALREADY HAD V OPERATION
            P_DEST=P_SRCE
            P_SRCE=X'70001'
            PON(P)
            CELLP=RETURN CELL(CELLP)
         %FINISH %ELSE %START
            NCELL=NEWCELL(P_SRCE)
            LINK(I)=NCELL
            CELL(CELLP)=CELL(CELLP)&X'FF00FFFF'!NCELL<<16
         %FINISH
         %RETURN
      %FINISH
      CELLP==LINK(CELLP)
   %REPEAT
! NO QUEUE YET
   NCELL=NEWCELL(P_SRCE)
   CELLP=NEWCELL(NCELL<<24!NCELL<<16!SEMA)
   %RETURN
!-----------------------------------------------------------------------
ACT(2):                                 ! V OPERATION
   SEMA=P_P1&X'FFFF'
   HASHP=SEMA-SEMA//31*31
   CELLP==HASH(HASHP)
   %WHILE CELLP#0 %CYCLE
      %IF SEMA=CELL(CELLP)&X'FFFF' %THEN %START
         I=CELL(CELLP)>>24
         P_DEST=CELL(I)
         P_SRCE=X'70001'
         PON(P)
         I=RETURN CELL(I)
         %IF I=0 %THEN CELLP=RETURN CELL(CELLP) %C
            %ELSE CELL(CELLP)=CELL(CELLP)&X'00FFFFFF'!I<<24
         %RETURN
      %FINISH
      CELLP==LINK(CELLP)
   %REPEAT
! P OPERATION NOT HERE YET
   CELLP=NEWCELL(SEMA)
   %RETURN
!-----------------------------------------------------------------------
ACT(3):                                 ! DISPLAY SEMAPHORE QUEUES
   %CYCLE HASHP=0,1,31
      %IF HASH(HASHP)#0 %THEN %START
         CELLP==HASH(HASHP)
         %WHILE CELLP#0 %CYCLE
            SEMA=CELL(CELLP)&X'FFFF'
            I=CELL(CELLP)>>24
            %WHILE I#0 %THEN OPMESS('SEMA '.STRINT(SEMA). %C
               ' QUEUE :'.HTOS(CELL(I)>>16,2)) %AND I=LINK(I)
            CELLP==LINK(CELLP)
         %REPEAT
      %FINISH
   %REPEAT
   %RETURN
!-----------------------------------------------------------------------
%INTEGERFN NEWCELL(%INTEGER S)
%INTEGER I
   %IF ASL=0 %THEN MONITOR('SEMAPHORE ASL EMPTY')
   I=LINK(ASL)
   %IF I=ASL %THEN ASL=0 %ELSE LINK(ASL)=LINK(I)
   CELL(I)=S
   LINK(I)=0
   %RESULT =I
%END
!-----------------------------------------------------------------------
%INTEGERFN RETURN CELL(%INTEGER I)
%INTEGER J
   J=LINK(I)
   %IF ASL=0 %THEN LINK(I)=I %C
      %ELSE LINK(I)=LINK(ASL) %AND LINK(ASL)=I
   ASL=I
   %RESULT =J
%END
!-----------------------------------------------------------------------
%END
%ENDOFFILE