*     COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC., 1979, 1980
*
      BLOCK DATA COPYRIT4
      INTEGER COPYRITE(16)
     1   /'COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC., 1979,'
     2  , ' 1980.  '/
      GLOBAL COPYRITE
      END
      FUNCTION PULFLD(START,NBITS,SOURCE)
************************************************************************
*                                                                      *
*            FUNCTION PULFLD                                           *
*                                                                      *
*     PULLS A FIELD FROM A WORD                                        *
*     RETURNS RESULT RIGHT-JUSTIFIED.                                  *
*                                                                      *
*  PARAMETERS:                                                         *
*     START   FIRST BIT OF REQUIRED FIELD                              *
*     NBITS   LENGTH OF FIELD                                          *
*     SOURCE  WORD FROM WHICH FIELD IS TO BE TAKEN                     *
*                                                                      *
************************************************************************
      IMPLICIT INTEGER(A-Z)
      PULFLD=ISL(ISL(SOURCE,START),NBITS-32)
      RETURN
      END
      SUBROUTINE PUTFLD(TARGET,START,NBITS,SOURCE)
************************************************************************
*                                                                      *
*  SUBROUTINE PUTFLD. PLACES FEILD IN TARGET WORD                      *
*     USING NBITS FROM SOURCE WORD.  OVERFLOW IN                       *
*     SOURCE FIELD (NON-ZERO LEFT OF LAST NBITS) IS                    *
*                                                                      *
*  PARAMETERS:                                                         *
*     TARGET  DESTINATION FOR INSERTION OF FIELD                       *
*     START   BIT AT WHICH FIELD IS TO START                           *
*     NBITS   SIZE OF FIELD                                            *
*     SOURCE  VALUE OF FIELD TO BE INSERTED                            *
*                                                                      *
************************************************************************
      IMPLICIT INTEGER(A-Z)
      INTEGER MASKS(33)
      DATA MASKS/8ZFFFFFFFF,8ZFFFFFFFE,8ZFFFFFFFC,8ZFFFFFFF8,
     @8ZFFFFFFF0,8ZFFFFFFE0,8ZFFFFFFC0,8ZFFFFFF80,8ZFFFFFF00,
     @8ZFFFFFE00,8ZFFFFFC00,8ZFFFFF800,8ZFFFFF000,8ZFFFFE000,
     @8ZFFFFC000,8ZFFFF8000,8ZFFFF0000,8ZFFFE0000,8ZFFFC0000,
     @8ZFFF80000,8ZFFF00000,8ZFFE00000,8ZFFC00000,8ZFF800000,
     @8ZFF000000,8ZFE000000,8ZFC000000,8ZF8000000,8ZF0000000,
     @8ZE0000000,8ZC0000000,8Z80000000,8Z00000000/
C
      RDY=ISC(IAND(ISC(TARGET,START+NBITS),MASKS(NBITS+1)),
     @-1*(START+NBITS))
      TARGET=IOR(ISL(ISL(SOURCE,32-NBITS),-START),RDY)
      RETURN
      END
      INTEGER FUNCTION FNDARA(ARANBR)
************************************************************************
*                                                                      *
*            FUNCTION FNDARA                         @1978 11 01       *
*                                                                      *
*     THIS FUNCTION RETURNS THE INDEX OF THE SPECIFIED AREA.           *
*     A ZERO IS RETURNED IF THE AREA DOES NOT EXIST.                   *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ARANBR,INDEX0
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            FNDARA   INTEGER     THE RESULT OF THIS ROUTINE           *
*            ARANBR   INTEGER     PARAMETER; AREA NUMBER TO FIND       *
*            INDEX0   INTEGER     A SCRATCH VARIABLE                   *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
****************************************
*                                      *
*            SEARCH LOOP               *
*                                      *
****************************************
      IF(ARACNT.EQ.0)GOTO 10
      DO 20 INDEX0=1,ARACNT
      IF(AREA(INDEX0).EQ.ARANBR)FNDARA=INDEX0;RETURN
20    CONTINUE
*
*  AREA NOT DEFINED
*
10    CONTINUE
      FNDARA=0
      RETURN
      END
      INTEGER FUNCTION FNDGRP(GRPNBR,GAREA)
************************************************************************
*                                                                      *
*            FUNCTION FNDGRP                         @1978 11 01       *
*                                                                      *
*     A ZERO IS RETURNED IF THE GROUP DOES NOT EXIST.                  *
*     I.E. IF I=FNDGRP(GRPNBR) THEN GROUP(I)=GRPNBR                    *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER GRPNBR,GAREA,TMPGRP,WORD,BYTE,PULFLD
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            FNDGRP   INTEGER     THE RESULT OF THIS ROUTINE           *
*            GRPNBR   INTEGER     PARAMETER; GROUP NUMBER TO FIND      *
*            GAREA    INTEGER     AREA GROUP RESIDES IN. ONLY USEFUL   *
*                                 IF GROUP NUMBER IS EDMS'S 1002.      *
*            TMPGRP   INTEGER     TEMP. GROUP NUMBER                   *
*            WORD     INTEGER     WORD CONTAINING REQUIRED INDEX       *
*            BYTE     INTEGER     BYTE CONTAINING REQUIRED INDEX       *
*            PULFLD   FUNCTION    PULLS A FIELD FROM A WORD            *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
****************************************
*                                      *
*            TABLE LOOKUP              *
*                                      *
****************************************
      TMPGRP=GRPNBR
*
*  A SPECIAL PLACE IN THE TABLE, TO KEEP THE TABLE SIZE DOWN. THE
*  LOCATION IS THE FIRST IN THE TABLE, WORD 1, BYTE 0.
*
      IF(TMPGRP.EQ.131072)WORD=BYTE=0;GOTO 10
*
*  GROUP #1002 IS EDMS'S OWNER IS AREA GROUP. IT CAN HAVE MULTIPLE
*  DEFINITIONS.  TO GET A UNIQUE NUMBER, WE ADD THE AREA NUMBER
*  AND THEN DO THE LOOKUP.
*
      IF(TMPGRP.EQ.1002)TMPGRP=TMPGRP+GAREA
      WORD=TMPGRP/4
      BYTE=TMPGRP-4*WORD
10    CONTINUE
      FNDGRP=PULFLD(8*BYTE,8,GRPITB(WORD+1))
      RETURN
      END
      INTEGER FUNCTION FNDSET(SETNBR)
************************************************************************
*                                                                      *
*            FUNCTION FNDSET                         @1978 11 01       *
*                                                                      *
*     THIS FUNCTION RETURNS THE INDEX OF THE SPECIFIED SET.            *
*     A ZERO IS RETURNED IF THE SET DOES NOT EXIST.                    *
*     I.E. IF I=FNDSET(SETNBR) THEN SET(I)=SETNBR                      *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER SETNBR,INDEX0
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            FNDSET   INTEGER     THE RESULT OF THIS ROUTINE           *
*            INDEX0   INTEGER     A SCRATCH VARIABLE                   *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
****************************************
*                                      *
*            SEARCH LOOP               *
*                                      *
****************************************
      IF(SETCNT.EQ.0)GOTO 10
      DO 20 INDEX0=1,SETCNT
      IF(SET(INDEX0).EQ.SETNBR)FNDSET=INDEX0;RETURN
20    CONTINUE
*
*  SET NOT DEFINED
*
10    CONTINUE
      FNDSET=0
      RETURN
      END
      SUBROUTINE REFFMT(REFCDE,REFBUF)
************************************************************************
*                                                                      *
*            SUBROUTINE REFFMT                       @1978 11 01       *
*                                                                      *
*     FORMATS UP A REFCODE INTO THE FORM AREA-PAGE-LINE                *
*     THE RESULT IS AN UNPACKED TEXTC CHAR STRING                      *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER REFCDE,ARANBR,PGENBR,LINNBR,PULFLD,FNDARA,LINBIT
      INTEGER BUFPTR,INDEX0,DIGIT,DIGREF,REFBUF,DASH,XCHAR,QUOTE
      INTEGER NYBL,ARAINX
      LOGICAL NONZER
      DIMENSION DIGREF(16),REFBUF(16)
      DATA DIGREF/'0','1','2','3','4','5','6','7','8','9',
     .'A','B','C','D','E','F'/
      DATA DASH/'-'/,XCHAR/'X'/,QUOTE/''''/
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            REFCDE   INTEGER     PARAMETER; REFCODE TO BE FORMATTED   *
*            ARANBR   INTEGER     AREA NUMBER, EXTRACTED FROM REFCODE  *
*            ARAINX   INTEGER     AREA INDEX OF ARANBR                 *
*            PGENBR   INTEGER     PAGE NUMBER, EXTRACTED FROM REFCODE  *
*            LINNBR   INTEGER     LINE NUMBER, EXTRACTED FROM REFCODE  *
*            PULFLD   FUNCTION    RETURNS SUBFIELD OF A WORD, FOR      *
*                                 EXTRACTING AREA, PAGE, AND LINE      *
*                                 NUMBERS                              *
*            FNDARA   FUNCTION    RETURNS INDEX NUMBER OF AN AREA      *
*            LINBIT   INTEGER     NUMBER OF BITS USED FOR LINE NUMBERS *
*                                 IN THIS REFCODE                      *
*            BUFPTR   INTEGER     POINTS AT THE NEXT EMPTY SPOT IN     *
*                                 THE BUFFER, REFBUF                   *
*            INDEX0   INTEGER     A SCRATCH VARIABLE                   *
*            DIGIT    INTEGER     A SCRATCH VARIABLE                   *
*            DIGREF   INTEGER     REFERENCE ARRAY OF CHARACTERS        *
*                                 '0' TO 'F'                           *
*            REFBUF   INTEGER     BUFFER INTO WHICH FORMATTED REFCODE  *
*                                 IS STORED                            *
*            NYBL     INTEGER     FIELD CONTAINING 4 BITS FROM REFCDE  *
*                                 .5 BYTES, (A NIBBLE)                 *
*            XCHAR    CONSTANT    'X' FOR HEX STRING                   *
*            QUOTE    CONSTANT    '''' FOR HEX STRING                  *
*            NONZER   LOGICAL     FLAG TO INDICATE NONZERO DIGITS      *
*                                 FOUND WHILE FORMATTING AN INTEGER    *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
*
*  MESSY BUSINESS FIRST, PULL OUT THE AREA, PAGE, AND LINE NUMBERS
*  GET THE AREA, USE THAT TO FIND THE RIGHT NUMBER OF BITS FOR THE REST,
*  AND PULL THEM OUT.
*
      ARANBR=PULFLD(0,8,REFCDE)
      ARAINX=FNDARA(ARANBR)
      IF(ARAINX.EQ.0)GOTO 70
****************************************
*                                      *
*     FORMAT AREA-PAGE-LINE            *
*                                      *
****************************************
      LINBIT=ARALSZ(ARAINX)
      PGENBR=PULFLD(8,24-LINBIT,REFCDE)
      LINNBR=PULFLD(32-LINBIT,LINBIT,REFCDE)
*
*  THE FIRST SPOT IN THE BUFFER IS RESERVED FOR THE CHAR COUNT, MAKE
*  THE FIRST FREE SPOT THE SECOND POSITION.
*
      BUFPTR=2
****************************************
*                                      *
*     FORMAT AREA NUMBER               *
*                                      *
****************************************
      NONZER=.FALSE.
      IF(ARANBR.EQ.0)REFBUF(BUFPTR)=DIGREF(1);BUFPTR=BUFPTR+1;GOTO 20
      DO 10 INDEX0=1,3
      DIGIT=MOD(ARANBR/10**(3-INDEX0),10)
      IF(DIGIT.NE.0)NONZER=.TRUE.
      IF(NONZER)REFBUF(BUFPTR)=DIGREF(1+DIGIT);BUFPTR=BUFPTR+1
10    CONTINUE
20    CONTINUE
      REFBUF(BUFPTR)=DASH
      BUFPTR=BUFPTR+1
****************************************
*                                      *
*     FORMAT PAGE NUMBER               *
*                                      *
****************************************
      IF(PGENBR.EQ.0)REFBUF(BUFPTR)=DIGREF(1);BUFPTR=BUFPTR+1;GOTO 40
      NONZER=.FALSE.
      DO 30 INDEX0=1,7
      DIGIT=MOD(PGENBR/10**(7-INDEX0),10)
      IF(DIGIT.NE.0)NONZER=.TRUE.
      IF(NONZER)REFBUF(BUFPTR)=DIGREF(1+DIGIT);BUFPTR=BUFPTR+1
30    CONTINUE
40    CONTINUE
      REFBUF(BUFPTR)=DASH
      BUFPTR=BUFPTR+1
****************************************
*                                      *
*     FORMAT LINE NUMBER               *
*                                      *
****************************************
      IF(LINNBR.EQ.0)REFBUF(BUFPTR)=DIGREF(1);BUFPTR=BUFPTR+1;GOTO 60
      NONZER=.FALSE.
      DO 50 INDEX0=1,3
      DIGIT=MOD(LINNBR/10**(3-INDEX0),10)
      IF(DIGIT.NE.0)NONZER=.TRUE.
      IF(NONZER)REFBUF(BUFPTR)=DIGREF(1+DIGIT);BUFPTR=BUFPTR+1
50    CONTINUE
60    CONTINUE
*
*  FINALLY, STORE THE CHAR COUNT IN THE FIRST WORD.
*
      REFBUF(1)=BUFPTR-2
      GOTO 90
70    CONTINUE
****************************************
*                                      *
*     FORMAT HEXADECIMAL WORD          *
*                                      *
****************************************
*
*  THE CHAR COUNT, LEADING X' AND TRAILING ' ARE FIXED
*
      REFBUF(1)=11
      REFBUF(2)=XCHAR
      REFBUF(3)=QUOTE
      REFBUF(12)=QUOTE
      DO 80 INDEX0=1,8
      NYBL=PULFLD(4*(INDEX0-1),4,REFCDE)
80    CONTINUE
90    CONTINUE
      RETURN
      END
