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

	.TITLE	GETFILE - Macro Support Routines for COMPIL

	.ENABLE DEBUG
	.EXTERNAL LIB$ANALYZE_SDESC_R2
;This module provides the macro support routines for the COMPIL program.
;There are two types of support needed that cannot easily be written in
;Fortran:  manipulation of the RMS control blocks and generation of the
;keyword tables needed by the keyword scanners.  Both of these are provided
;in this module.

.PSECT	CODE,EXE,LONG
;Keyword table for commands invoking COMPIL:
CMD_TABLE::
	$LIB_KEY_TABLE	< -
		<COMPILE, 1>, -
		<LOAD, 2>, -
		<EXECUTE, 3>, -
		<DEBUG, 4>>

;Keyword table for switches:
SWITCH_TABLE::
	$LIB_KEY_TABLE	< -
		<FORTRAN, 1>, -
		<MACRO, 2>, -
		<BASIC, 3>, -
		<BLISS, 4>, -
		<PASCAL, 5>, -
		<PLI, 6>, -
		<MESSAGE, 7>, -
		<COMPILE, 32>, -
		<LIST, 33>, -
		<CROSS, 34>, -
		<DEBUG, 35>, -
		<NOCOMP, 36>, -
		<NOLIST, 37>, -
		<NOCROSS, 38>, -
		<NODEBUG, 39>, -
		<LIBRARY, 42>, -
		<LINK, 43>, -
		<EXECUTABLE, 44>>
;	RECOMP_FLAG = 40, but not included here so can't be given as a switch
;	CONCAT_FLAG = 41, but not settable as a switch

.SUBTITLE	File Scanning Subroutine

;This is the subroutine to scan the filespecs, see if the files exist,
;so the information needed about the files can be returned to COMPIL.

;Format of the call:
;	CALL SCAN_FILE(FILESPEC, EXTENSION, FILENAME, RECOMP_FLAG)

SCAN_FILE::.WORD	^M<R2,R3,R4,R5,R6,R7>
	PUSHAL	STR_ADDRESS	;Set up to call the analyze string routine
	PUSHAW	STR_LENGTH
	PUSHAL	@4(AP)
	CALLS	#3,G^LIB$ANALYZE_SDESC	;Get length and address from descriptor
	MOVL	STR_ADDRESS,FAB+FAB$L_FNA	;Save the address of the string
	MOVB	STR_LENGTH,FAB+FAB$B_FNS	;Save the size of the string
	CLRW	FAB+FAB$W_IFI
	MOVL	#^A"    ",EXT_ADDR	;Start with no extension
	$OPEN	FAB=FAB			;Get the file
	MOVL	R0,R2			;Save the return status
	$CLOSE	FAB=FAB			;and close the file
	BLBS	R2,CHKOBJ		;Did the file exist?  Yes
	BBC	#NAM$V_EXP_TYPE,MAIN_NAM+NAM$L_FNB,10$
					;Was an explicit file type specified?
	MOVL	#2,R0			;Yes - error
	RET

10$:	MOVL	#NUM_TYPE,R6		;Set up pointer to extension table
CHKFIL:	MOVAL	EXT_TABLE[R6],R7	;Save the default extension
	MOVC3	#4,(R7),EXT_ADDR
	$FAB_STORE FAB=FAB,DNA=EXT_ADDR,DNS=#4
	CLRW	FAB+FAB$W_IFI
	$OPEN	FAB=FAB			;See if this one is there
	MOVL	R0,R2			;Save the status
	$CLOSE	FAB=FAB
	BLBS	R2,CHKOBJ		;Go if file was found
	SOBGEQ	R6,CHKFIL		;Loop through all the extensions
	MOVL	#2,R0			;Not found - error
	RET

CHKOBJ:	MOVQ	DATE_XAB+XAB$Q_RDT,SOURCE_DATE ;Save creation date
	PUSHAL	STR_ADDRESS		;Analyze descriptor for the filename
	PUSHAL	STR_LENGTH
	PUSHAL	@12(AP)
	CALLS	#3,G^LIB$ANALYZE_SDESC
	MOVZBL	MAIN_NAM+NAM$B_NAME,R7	;Transfer the filename to the argument
	MOVC5	R7,@MAIN_NAM+NAM$L_NAME,-; list
		#^A" ",STR_LENGTH,@STR_ADDRESS
	PUSHAL	STR_ADDRESS		;Analyze descriptor for the file type
	PUSHAL	STR_LENGTH
	PUSHAL	@8(AP)
	CALLS	#3,G^LIB$ANALYZE_SDESC
	MOVZBL	MAIN_NAM+NAM$B_TYPE,R7	;Transfer the file type to the argument
	MOVC5	R7,@MAIN_NAM+NAM$L_TYPE,-; list
		#^A" ",STR_LENGTH,@STR_ADDRESS
	CMPL	#^A".OBJ",@STR_ADDRESS	;Is the file an object module?
	BNEQ	10$			;No
5$:	CLRB	@16(AP)			;Yes - clear the recomp flag
	MOVL	#1,R0			;and return success
	RET
10$:	CMPL	#^A".TLB",@STR_ADDRESS	;Is it a library of some kind?
	BEQL	5$			;Yes
	CMPL	#^A".MLB",@STR_ADDRESS
	BEQL	5$			;Yes
	CMPL	#^A".OLB",@STR_ADDRESS
	BEQL	5$			;Yes
	MOVZBL	MAIN_NAM+NAM$B_NAME,R7	;No - build the object file name
	MOVC3	R7,@MAIN_NAM+NAM$L_NAME,OBJ_NAME
	MOVL	#^A".OBJ",OBJ_NAME(R7)	;Add in the extension
	ADDL	#4,R7			;Compute the length
	$FAB_STORE FAB=FAB,DNS=#0,DNA=#0,FNS=R7,-
		   FNA=OBJ_NAME		;Save it in the FAB
	CLRW	FAB+FAB$W_IFI
	$OPEN	FAB=FAB			;See if the object file is there
	MOVL	R0,R2
	$CLOSE	FAB=FAB			;Then close the file
	BLBC	R2,30$			;Was the file there?  No - go force recomp
	CMPL	DATE_XAB+XAB$Q_RDT+4,SOURCE_DATE+4
	BLSS	30$			;Object is older than source
	BGTR	20$			;Object is newer than source
	CMPL	DATE_XAB+XAB$Q_RDT,SOURCE_DATE
	BLSSU	30$			;Object is older than source
20$:	CLRB	@16(AP)			;No need to recompile
	MOVL	#1,R0			;Return success
	RET
30$:	MOVB	#1,@16(AP)		;Indicate need to recompile
	MOVL	#1,R0
	RET

EXT_TABLE:	.ASCII	/.OBJ/
	.ASCII	/.TLB/
	.ASCII	/.MLB/
	.ASCII	/.OLB/
	.ASCII	/.MSG/
	.ASCII	/.BLI/
	.ASCII	/.PAS/
	.ASCII	/.PLI/
	.ASCII	/.MAR/
	.ASCII	/.BAS/
	.ASCII	/.FOR/
NUM_TYPE==<.-EXT_TABLE>/4-1


.PSECT	RWDATA,LONG
.ALIGN	LONG
FAB:	$FAB	DNA=EXT_ADDR,DNS=4,NAM=MAIN_NAM,XAB=DATE_XAB
MAIN_NAM:	$NAM	ESA=EXP_NAME,ESS=127,RSA=RESULT_NAME,RSS=127
DATE_XAB:	$XABDAT

OBJ_NAME:	.BLKB	13
SOURCE_DATE:	.BLKQ	1
STR_ADDRESS:	.BLKL	1
STR_LENGTH:	.BLKW	1
RESULT_NAME:	.BLKB	127
EXP_NAME:	.BLKB	127
EXT_ADDR:	.BLKB	4
	.END