Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	title crlbrd - Routine to read a LBR module from fortran
;
;	This routine can be called from a FORTRAN program to read
;	a LBR module from a LBR library. There are 2 routines -
;	CRLBOP - open a module in a library
;	CRLBRD - read a record from a module in the library
;
;	NOTE: This routine only reads text files.
;
	search	vtmac,crcsym
	regdef			;define registers, search system universals
	search	lbr		;get LBR definitions.
	external gtbypt		;get a fortran 77 string
	external gtbufa,ptbufa	;use fortran 77 scratch string space

;
;	CALL CRLBOP('LIBRARY','MODULE',JFN,SIZE,ERR)
;
;	Opens MODULE in LIBRARY.LBR, returns useful JFN, size and pointer.
;
;	Errors:	1 - Cannot find library
;		2 - Cannot open library
;		3 - File is not a library, or format incorrect
;		4 - Cannot locate module
;		5 - general JSYS error
;
	entry	crlbop,crlbrd
;
;	Define error macro
;
	DEFINE ERR(N),<
	movei	t1,n
	movem	t1,@error(cx)
	ret>
;
;	Define argument offsets
;
	forarg<lib,mod,jfn,size,error>

crlbop:	move	t1,cx			;copy argument pointer
	movei	t2,5			;unidentified error
	movem	t2,@error(cx)		;start with that
	trvar	<<hdrrec,wih>,<modnam,8>>;reserve space for header words
	move	cx,t1			;get arg pointer back
	call	getlib			;find the library
	 ret				;failed, return
	movei	t3,$hnent		;address of number of modules
	rin%				;now get number of modules in lib
	jumpe	t2,notfnd		;if zero, module not found
	movem	t2,q1			;save for looping
	movei	t3,$hbysz		;address of lib byte size
	rin%				;read it
	movem	t2,q2			;save for later
	movei	t3,<$hdir-1>		;address of directory start
	move	t1,@jfn(cx)		;get jfn of lib
	rin%				;better than SFPTR because of byte
					;size problems
domod:	movei	t2,hdrrec		;get address of record buffer
	hll	t2,[point ^d36,]	;make a byte pointer
	move	t1,@jfn(cx)		;jfn of library
	movni	t3,wpde			;words in directory entry
	sin%				;read an entry
	movei	t1,hdrrec		;get address of record
	skipn	$dmupdt(t1)		;deleted module ?
	 jrst	nxtmod			;yes, so step to next
	hrroi	t1,hdrrec		;point to module name
	hrroi	t2,modnam		;and one desired by user
	stcmp%				;compare names
	jumpe	t1,found		;if 0, they are equal
nxtmod:	sojn	q1,domod		;loop for all modules
notfnd:	move	t1,@jfn(cx)		;get jfn
	closf%				;close library because...
	 trn
	err	4			;...module was not found, return error
;
;	Module is found, reset library to start
;
found:	movei	t1,hdrrec		;get address of directory entry
	move	t2,$dmlen(t1)		;get modules length in bytes
	movem	t2,@size(cx)		;return to user
	move	q1,$dmstrt(t1)		;get address of module start
	move	t2,q2			;get lib byte size
	move	t1,@jfn(cx)		;and library jfn
	sfbsz%				;reset byte size for this opening
	 trn				;tuff on error
	move	t3,q1			;now get module start address
	soj	t3,			;subtract one for pointers
	rin%				;set up for next read
	 trn
	setzm	@error(cx)		;indicate no error
	ret				;return to caller
;
;	Locate and open library
;
getlib:	movei	t1,lib			;want pointer to lib name
	call	gtbypt			;may be fortran v7
	move	t2,t1			;gtjfn% wants it in t2
	movei	t1,[gj%old		;get arg block - old file
		  .nulio,,.nulio	;no I/O for name
		  0			;no def device
		  0			;no def dir
		  0			;no def name
		  -1,,[asciz/LBR/]	;default type
		  0			;no prot
		  0			;or account
		  0]			;or jfn
	gtjfn%				;grab a jfn
	 erjmp	[err 1]			;lose
	movem	t1,@jfn(cx)		;store jfn for FORTRAN user
	movx	t2,of%rd!fld(^d36,of%bsz) ;set up to read directory
	openf%				;open library
	 erjmp	[err 2]			;lose
	bin%				;read first byte
	caie	t2,hdrmrk		;look like a library ?
	 jrst	[err	3]		;no, return
	movei	t1,mod			;want pointer to mod. name
	call	gtbypt			;may be fortran v7
	movn	t3,t2			;make the length -ve in t3
	movei	t2,modnam		;point to our local storage for it
	hrli	t2,(point 7,)		;make into byte pointer
getli1:	jumpl	t3,[	sin%		;if fortran v7 read in the module name
			jrst	getli2 ];terminate with a null
        ildb	t3,t1			;if not get a byte from user's name
	cain	t3," "			;space ?
	 jrst	getli2			;yes, so end of name
	skipn	t3			;null ?
	 jrst	getli2			;yes, so end of name
	idpb	t3,t2			;no, copy it across
	jrst	getli1			;and continue
getli2:	setz	t3,			;get a null
	idpb	t3,t2			;terminate name with it
	move	t1,@jfn(cx)		;return jfn of library
	retskp				;return success

	subttl	CRLBRD - read a record from a library
;
;	This routine reads a text record from the library.
;	CALL CRLBRD(ARRAY,RECLEN,JFN,START,ERROR)
;
;	ARRAY - receives returned record
;	RECLEN - record length in characters
;	JFN - supply that returned by CRLBOP
;	SIZE - supply value returned by CRLBOP to read first record,
;		thereafter use value returned by this routine for next call.
;	ERROR - 0 is OK
;	      1 - end of file
;	      2 - some error reading file
;
	forarg	<array,reclen,jfn,size,error>
crlbrd:	skipn	@size(cx)		;any file left ?
	 jrst	eoferr			;no, give eof error
	movei	t1,array		;yes, want pointer to user's array
	call	gtbufa			;may be fortran v7
;**	skipe	t2			;is it ?
;**	 call	$spfil			;yes, space fill the character variable
	movei	t4,12			;end read on linefeed
	move	t3,t2			;sin wants length in t3
	skipn	t3			;not v7, so think BIG
   	 movei	t3,1000			;max record length
	push	p,t3			;save length
	move	t2,t1			;and o/p pointer in t2
	move	t1,@jfn(cx)		;get jfn
	sin%				;read a record
	 erjmp	[err	2]
	pop	p,t1			;restore length
	sub	t1,t3			;subtract amount remaining
	setz	t4,			;get a null
;**	skipe	t1			;any left ?
	 idpb	t4,t2			;terminate with a null
	move	t3,@size(cx)		;how much was left before ?
	sub	t3,t1			;and how much have we removed ?
	movem	t3,@size(cx)		;remember for next call
	subi	t1,2			;drop off cr/lf
	movem	t1,@reclen(cx)		;store for user
	setzm	@error(cx)		;no error
	movei	t1,array		;yes, want pointer to user's array
	call	ptbufa			;copy fortran 77 characters
	ret				;return to caller
eoferr:	move	t1,@jfn(cx)		;get library jfn
	closf%				;close it
	 erjmp	.+1
	err	1
	end