%INTEGERFN ENTER LAB(%INTEGER LAB,FLAGS)
!***********************************************************************
!*       ENTER A NEW LABEL ON THE LABEL LIST FOR THE CURRENT LEVEL     *
!*       2**0  OF FLAGS  = 1  CONDITIONAL ENTRY                        *
!*       2**1  OF FLAGS  = 1  UPDATE ENVIRONMENT                       *
!*       2**2  OF FLAGS  = 1  REPLACE ENV     =0  MERGE ENV            *
!*       THE LABEL LIST                                                *
!*       S1 =   USE BITS<<8 ! LABEL ADDR                               *
!*       S2 =   UNFILLED JUMPS LIST                                    *
!*       S3 = LAB NO - RESET TO FFFF WHEN USED FOR INTERNAL LABELS     *
!*       RESULT = 1 LABEL ENTERED                                      *
!*       RESULT = 0 CONDITIONAL LABEL NOT REQUIRED                     *
!***********************************************************************
%INTEGER CELL,AT,JUMPHEAD,DIS,BBASE,OLDCELL,WORK
%RECORD(LISTF)%NAME LCELL
%INTEGERNAME LHEAD
      CELL=LABEL(LEVEL); OLDCELL=0
      %WHILE CELL>0 %CYCLE
         LCELL==ASLIST(CELL)
         %EXIT %IF LCELL_S3=LAB
         OLDCELL=CELL; CELL=LCELL_LINK
      %REPEAT
!
      %IF CELL<=0 %THEN %START;         ! LABEL NOT KNOWN
         %IF FLAGS&1=0 %THEN %START;    ! UNCONDITIONAL ENTRY
            PUSH(LABEL(LEVEL),CA,0,LAB)
            %RESULT=1
         %FINISH
         %RESULT=0
      %FINISH
!
! LABEL HAS BEEN REFERENCED - FILL IN ITS ADDRESS
!
      %IF LCELL_S1&X'FFFFFF'# 0 %THEN %START
         FAULT(2,0,LAB);                ! LABEL SET TWICE
      %FINISH %ELSE %START
         LCELL_S1=X'1000000'!CA
      %FINISH
!
! NOW FILL JUMPS TO THIS LABEL - JUMP LIST FORMAT GIVEN IN 'ENTER JMP'
!
      JUMPHEAD=LCELL_S2
      %WHILE  JUMPHEAD#0  %CYCLE
         POP(JUMPHEAD,AT,BBASE,WORK)
         DIS=CA-(AT+2)
         %IF BBASE=0 %THEN DIS=DIS-1
         %IF BBASE#0 %AND DIS>127 %THEN FAULT(99,0,0)
         PLUG(1,AT+1,DIS&255,1)
         %IF DIS>255 %THEN PLUG (1,AT+2,DIS>>8,1)
      %REPEAT
      LCELL_S2=0
      %IF LAB> MAX ULAB  %THEN %START
         %IF OLDCELL=0 %THEN LHEAD==LABEL(LEVEL) %ELSE %C
            LHEAD==ASLIST(OLDCELL)_LINK
         POP(LHEAD,AT,AT,AT)
      %FINISH
      %RESULT=1
%END
%ROUTINE ENTER JUMP(%INTEGER JCODE,LAB,FLAGS)
!***********************************************************************
!*       IF LAB HAS BEEN ENCOUNTERED THEN PLANT A JCC OTHERWISE ENTER  *
!*       THE LABEL IN THE LABEL LIST AND ATTACH THE JUMP TO IT SO IT   *
!*       CAN BE PLANTED WHEN THE LABEL IS FOUND                        *
!*       THE LABEL LIST IS DESCRIBED UNDER 'ENTER LAB'                 *
!*       THE JUMP SUB-LIST HAS THE FORM                                *
!*       S1= ADDR OF JUMP                                              *
!*       S2=SHORT OR LONG FLAG                                         *
!*       S3=LINE NO OF JUMP FOR DIAGNOSTICS                            *
!*                                                                     *
!*       FLAGS BITS SIGNIFY AS FOLLOWS                                 *
!*       2**0 =1  JUMP IS KNOWN TO BE SHORT                            *
!*       2**1 =1  ENVIRONMENT MERGEING REQUIRED(NOT IMPLEMENTED)       *
!***********************************************************************
%INTEGER AT,CELL,LABADDR,I
%RECORD(LISTF)%NAME LCELL
      AT=CA
      %IF LAB<MAX ULAB %THEN FLAGS=0;! NO MERGE
      CELL=LABEL(LEVEL)
      %WHILE CELL>0 %CYCLE
         LCELL==ASLIST(CELL)
         %IF LAB=LCELL_S3 %THEN %EXIT
         CELL=LCELL_LINK
      %REPEAT
      -> FIRSTREF %IF CELL<=0
      LABADDR=LCELL_S1&X'FFFFFF'
      -> NOT YET SET %IF LABADDR=0
      LCELL_S1=LABADDR!X'1000000';      ! FLAG LABEL AS USED
      I=AT+2-LABADDR
      %IF I<=127 %THEN PB2(JCODE-1,-I) %ELSE PBW(JCODE,-(I+1))
      %RETURN
FIRSTREF:                              ! FIRST REFERENCE TO A NEW LABEL
      PUSH(LABEL(LEVEL),X'1000000',0,LAB)
      CELL=LABEL(LEVEL)
      LCELL==ASLIST(CELL)
      -> CODE
NOT YET SET:                           ! LABEL REFERENCED BEFORE
CODE:                                  ! ACTUALLY PLANT THE JUMP
      %IF FLAGS&1#0 %START;             ! SHORT JUMP
         PB2(JCODE-1,0)
      %FINISH %ELSE %START;             ! LONG JUMP
         PBW(JCODE,0)
      %FINISH
      PUSH(LCELL_S2,AT,FLAGS&1,LINE)
%END
%ROUTINE REMOVE LAB(%INTEGER LAB)
!***********************************************************************
!*    REMOVES A ALBEL FROM THE CURRENT LABEL LIST WHEN KNOWN TO        *
!*    BE REDUNDANT. MAINLY USED FOR CYCLE LABELS                       *
!***********************************************************************
%RECORD(LISTF)%NAME LCELL
%INTEGERNAME LHEAD
%INTEGER CELL,AT
      LHEAD==LABEL(LEVEL); CELL=LHEAD
      %WHILE CELL>0 %CYCLE
         LCELL==ASLIST(CELL)
         %EXIT %IF LCELL_S3=LAB
         LHEAD==LCELL_LINK
         CELL=LHEAD
      %REPEAT
      %IF CELL>0 %THEN POP(LHEAD,AT,AT,AT)
%END