	PROGRAM MAKELB
C
C--->	This program creates an RT-11 "handleroid" which can be used
C--->	in the same manner as an RSX-11 resident library containing
C--->	reentrant subroutines which can be shared by different jobs.
C--->	The "handleroid" (LB.SYS) is produced from the null device
C--->	handler (NL.SYS) and file LB.SAV which, in turn, is built
C--->	with the linker's /H:xxxxxx switch, where the value of xxxxxx
C--->	is equal to <RMON's base address>-6.
C
C--->	In order to provide some protection against inadvertent use
C--->	of the handleroid (as a handler, rather than as a resident
C--->	library), the handleroid contains a prologue consisting of
C--->	code copied from the null handler.  In LB.SYS, the word
C--->	immediately preceding the INTEN and FORK pointers contains
C--->	the size of this prologue (in bytes), so that a program can
C--->	determine at run time the address of the resident library
C--->	section of the handleroid, in order to confirm that it is
C--->	indeed loaded at the correct address.
C
C--->	Since this program uses SYSLIB routines LOOKUP and IENTER,
C--->	it's advisable that the USR not swap over it
C
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON  BLKSZW,BLKSZB,NCHN,LCHN,HCHN,NBLK,LBLK,HBLK,
     *   NBUFF(256),LBUFF(256),HBUFF(256)
C
	REAL*8  NFILE,LFILE,HFILE
C
	DATA  BLKSZW,BLKSZB/256,512/, NBLK,LBLK,HBLK/3*-1/
C
	DATA  NFILE/12RSY NL    SYS/, LFILE/12RDK LB    SAV/,
     *   HFILE/12RSY LB    SYS/
C
C
C--->	Open input files
C
	NCHN = IGETC ()
	LCHN = IGETC ()
	HCHN = IGETC ()
C
	IF ( LOOKUP ( NCHN, NFILE ) .LT. 0 ) STOP 'NL.SYS lookup error'
	IF ( LOOKUP ( LCHN, LFILE ) .LT. 0 ) STOP 'LB.SAV lookup error'
C
C
C--->	Get file parameters
C
	NLSIZB = GETNL ( "52 )
	PRLSZB = NLSIZB - 4
	PRLSZW = PRLSZB / 2
C
	LBSTRT = GETLB ( "42 )
	LBSIZB = GETLB ( "50 ) - LBSTRT
	LBSIZW = LBSIZB / 2
C
C
C--->	Open output file
C
	LSTADR = BLKSZB + NLSIZB + LBSIZB + 2
	CALL CONVRT ( LSTADR, LSTBLK, DUMMY )
	IF ( IENTER ( HCHN, HFILE, LSTBLK+1 ) .LT. 0 )
     *   STOP 'NL.SYS enter error'
C
C
C--->	Copy handler code from null handler to LB handleroid
C
	NADDR = "1000
	HADDR = "1000
C
	DO 100 W = 1,PRLSZW
100	CALL PUT ( HADDR, GETNL ( NADDR ) )
C
C
C--->	Copy reentrant code from LB.SAV to LB.SYS
C
	LADDR = LBSTRT
C
	DO 200 W = 1,LBSIZW
200	CALL PUT ( HADDR, GETLB ( LADDR ) )
C
C
C--->	Write out prologue size, and fill out with zeroes (at least
C--->	two, for the INTEN and FORK pointers)
C
	CALL PUT ( HADDR, PRLSZB )
	CALL PUT ( HADDR, 0 )
C
300	CALL PUT ( HADDR, 0 )
	IF ( MOD ( HADDR, BLKSZB ) .NE. 0 ) GO TO 300
C
C
C--->	Update information in block 0 of LB.SYS, and close the file
C
	NADDR = 0
	HADDR = 0
C
	DO 400 W  = 1, BLKSZW
	VAL = GETNL ( NADDR )
	IF ( HADDR.EQ."50 .OR. HADDR.EQ."52 ) VAL = VAL + LBSIZB + 2
400	CALL PUT ( HADDR, VAL )
C
	CALL WRTBLK
C
	CALL CLOSEC ( NCHN )
	CALL CLOSEC ( LCHN )
	CALL CLOSEC ( HCHN )
C
	STOP 'LB.SYS handleroid created successfully'
C
C
	END
	FUNCTION GETNL ( ADDR )
C
C--->	Returns contents of specified word from NL.SYS; on
C--->	exit, ADDR is bumped to point to next word
C
C
	IMPLICIT INTEGER (A-Z)
	COMMON  BLKSZW,BLKSZB,NCHN,LCHN,HCHN,NBLK,LBLK,HBLK,
     *   NBUFF(256),LBUFF(256),HBUFF(256)
C
C
	CALL CONVRT ( ADDR, BLK, WORD )
	IF ( BLK .EQ. NBLK ) GO TO 100
	IF ( IREADW ( BLKSZW, NBUFF, BLK, NCHN ) .LT. 0 )
     *   STOP 'NL.SYS read error'
	NBLK = BLK
C
100	GETNL = NBUFF ( WORD )
	ADDR = ADDR + 2
	RETURN
C
C
	END
	FUNCTION GETLB ( ADDR )
C
C--->	Returns contents of specified word from LB.SAV; on
C--->	exit, ADDR is bumped to point to next word
C
C
	IMPLICIT INTEGER (A-Z)
	COMMON  BLKSZW,BLKSZB,NCHN,LCHN,HCHN,NBLK,LBLK,HBLK,
     *   NBUFF(256),LBUFF(256),HBUFF(256)
C
C
	CALL CONVRT ( ADDR, BLK, WORD )
	IF ( BLK .EQ. LBLK ) GO TO 100
	IF ( IREADW ( BLKSZW, LBUFF, BLK, LCHN ) .LT. 0 )
     *   STOP 'LB.SAV read error'
	LBLK = BLK
C
100	GETLB = LBUFF ( WORD )
	ADDR = ADDR + 2
	RETURN
C
C
	END
	SUBROUTINE PUT ( ADDR, VALUE )
C
C--->	Writes word to output file LB.SYS (if block change
C--->	is required, current block is written to disk and
C--->	the appropriate block is read in; otherwise, the
C--->	value is simply put into the output buffer); on
C--->	exit, ADDR is bumped to point to the next word
C
C
	IMPLICIT INTEGER (A-Z)
	COMMON  BLKSZW,BLKSZB,NCHN,LCHN,HCHN,NBLK,LBLK,HBLK,
     *   NBUFF(256),LBUFF(256),HBUFF(256)
C
C
	CALL CONVRT ( ADDR, BLK, WORD )
	IF ( BLK .EQ. HBLK ) GO TO 100
C
	IF ( HBLK .GE. 0 ) CALL WRTBLK
	IF ( IREADW ( BLKSZW, HBUFF, BLK, HCHN ) .LT. 0 )
     *   STOP 'LB.SYS read error'
	HBLK = BLK
C
100	HBUFF ( WORD ) = VALUE
	ADDR = ADDR + 2
	RETURN
C
C
	END
	SUBROUTINE WRTBLK
C
C--->	Writes current output buffer to LB.SYS
C
C
	IMPLICIT INTEGER (A-Z)
	COMMON  BLKSZW,BLKSZB,NCHN,LCHN,HCHN,NBLK,LBLK,HBLK,
     *   NBUFF(256),LBUFF(256),HBUFF(256)
C
C
	IF ( IWRITW ( BLKSZW, HBUFF, HBLK, HCHN ) .LT. 0 )
     *   STOP 'LB.SYS write error'
	RETURN
C
C
	END
	SUBROUTINE CONVRT ( ADDR, BLK, WORD )
C
C--->	Routine to convert an address to a <block,word> pair (note
C--->	that WORD ranges from 1 to 256, not from 0 to 255); requires
C--->	a function LSHIFT which performs a logical shift: argument 1
C--->	is value to be shifted, argument 2 is shift count (positive
C--->	for left shift, negative for right shift)
C
C
	IMPLICIT INTEGER (A-Z)
C
C
	BLK = LSHIFT ( ADDR, -9 ) .AND. "177
	WORD = ( LSHIFT ( ADDR, -1 ) .AND. "377 ) + 1
	RETURN
C
C
	END
                                  