*DECK             PSICON
USETEXT   TSOURCE 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TCEXEC
USETEXT   TCOM37Q 
USETEXT   TCOM78Q 
USETEXT   TC7DECS 
FUNC PSICON((P1)) I; # POSTS INTEGER CONSTANT-RETURNS WITH ATTRIB STP  #
BEGIN 
  
  
  
  
*CALL COMEX 
  
  
  
  
    ITEM P1; #VALUE#
    ITEM O1,O2; 
    XREF PROC PNAM; 
    XREF PROC POST; 
    XREF FUNC NBITCT; 
    XREF PROC GANAL;
    XREF PROC CALOC;                                                     JANDRE 
    XREF PROC ICFGEN;                                                    JANDRE 
    XDEF PROC PSICONS;                                                   JANDRE 
                                                                         JANDRE 
    ITEM B B=TRUE; # IF TRUE, GANAL ALLOCATES CONSTANT  #                JANDRE 
                   # B IS SET, LOCALLY, TO FALSE BY PSICONS #            JANDRE 
    PNAM(P1,BYPW$,O1);
PSI:O1=NLNK[O1];
    IF CLAS[O1] EQ S"CONS" THEN 
        BEGIN 
        GANAL(O1,B);                                                     JANDRE 
        PSICON=O1; RETURN;
        END 
    IF CLAS[O1] EQ S"NAME" THEN 
        BEGIN 
        POST(O1,CONS$W,O2); 
        CLAS[O2]=S"CONS"; 
        TYPE[O2]=S"IGR";
        IF P1 LS 0 THEN SIGN[O2]=TRUE;
        NBIT[O2]=NBITCT(P1);
        FBIT[O2]=60-NBIT[O2]; 
        GANAL(O2,B);                                                     JANDRE 
        PSICON=O2; RETURN;
        END 
    GOTO PSI; 
CONTROL EJECT;                                                           JANDRE 
PROC PSICONS(CTE,FB,NB,TYP,PT);   # CTE,FB,NB BY VALUE #                 JANDRE 
                                        # GENERATES CONSTANT EVEN WITH # JANDRE 
                                        # SX AND LX INSTRAD OF LOAD    # JANDRE 
BEGIN                                                                    JANDRE 
    ITEM CTE,  # CONSTANT, BY VALUE #                                    JANDRE 
         FB,   # ITS FBT #                                               JANDRE 
         NB,   # ITS NBT #                                               JANDRE 
             # INPUT: TYP=0 IF P1 PREFERRED, TYP=1 IF P2 #               JANDRE 
         TYP,  #  RESULT: TYP= -1 (SX,LX), 0 OR 1 #                      JANDRE 
         PT;   # PT POINTS EITHER ON ICFPTR OR CONST #                   JANDRE 
    ITEM P1,P2,P3,P4;                                                    JANDRE 
    B=FALSE;  # NO CONSTANT ALLOCATION #                                 JANDRE 
    P1=PSICON(CTE);                                                      JANDRE 
    P2=PSICON(LNO CTE);                                                  JANDRE 
    B=TRUE; #RESET CONSTANT ALLOCATION FLAG ON #                         JANDRE 
    IF CONL[P1] EQ S"LOAD" AND CONL[P2] EQ S"LOAD" THEN                  JANDRE 
         BEGIN  # TRY TO AVOID THAT LOAD #                               JANDRE 
         P3=B<FB,NB>CTE;                                                 JANDRE 
          IF P3 GQ 0
          AND P3 LS O"400000" THEN
              BEGIN                                                      JANDRE 
              ICFGEN(QICFOP"LSHC",PSICON(P3),60-(FB+NB));                JANDRE 
              TYP=-1; PT=ICFPTR;                                         JANDRE 
              RETURN;                                                    JANDRE 
              END                                                        JANDRE 
              CALOC(P1);                                                 JANDRE 
              P2=P1;                                                     JANDRE 
         END # LOADS#                                                    JANDRE 
    IF CONL[P1] GR CONL[P2] THEN                                         JANDRE 
         BEGIN                                                           JANDRE 
         IF TYP EQ 0 THEN PT=P1; ELSE PT=P2;                             JANDRE 
         TYP=1;                                                          JANDRE 
         END                                                             JANDRE 
    ELSE BEGIN                                                           JANDRE 
         IF TYP EQ 0 THEN PT=P2; ELSE PT=P1;                             JANDRE 
         TYP=0;                                                          JANDRE 
         END                                                             JANDRE 
END #PSICONS #                                                           JANDRE 
                                                                         JANDRE 
END 
TERM
