.TITLE	GETCOM -- GET DISK RESIDENT COMMON INFORMATION
	.IDENT	/V1/
;
;
; WRITTEN BY D.B.CURTIS
; SOFTWARE SUPPORT GROUP (R.S.)
; 4-JUN-79
; FERMILAB
;
;
; VERSION 01
; EDIT NUMBER = 0001
; FILE = GETCOMIN.MAC
; EDITED BY: D.B.CURTIS  19 JUL 79  14:42
;
;
; MODIFICATIONS:
;
;+
; FILE DESCRIPTION
;
;	THIS FILE CONTAINS UTILITY ROUTINES FOR OBTAINING INFORMATION 
;	ABOUT DISK RESIDENT COMMON AREAS.
;	THESE ROUTINES ARE USED WITH MAKING LOADABLE COMMON AREAS,
;	BOOTSTRAPING THE LEVEL 3 COMPUTER, AND OTHER TYPES OF OPERATIONS
;	ON TASK IMAGE FILES THAT DO NOT HAVE TASK HEADERS
;
;	THIS ROUTINE HAS A FORTRAN CALLING SEQUENCE -- IF CALLED 
;		FROM FORTRAN IT MAY NOT WORK
;
;	THIS FILE NEEDS TO BE ASSEMBLED WITH
;	=[1,1]EXEMC/ML,[X,X]GETCOMIN
;-
;
;
	.MCALL	WTSE$,FDBDF$,FDRC$A,FDBK$A,FDOP$A,FSRSZ$,RDBBK$,WDBBK$,NMBLK$
	.MCALL	LBLDF$,OPEN$R,READ$,WAIT$
	LBLDF$		;DEFINE LABEL BLOCK OFFSETS

	.PAGE
;+
;  **-COMINF-GET INFORMATION FROM DISK RESIDENT COMMON
;
; THIS ROUTINE RETURNS INFORMATION FROM A SPECIFIED DISK RESIDENT
; COMMON AREA.
; IT IS OBTAINED FROM THE LABEL BLOCK OF THE DISK RESIDENT TASK IMAGE
; THE COMMON MAY RESIDE ON SY:[CURRENT UIC] OR ON LB:[1,1]
; THE FIRST ATTEMPT IS TO FIND THE NAMED COMMON ON SY:[CURRENT UIC]
; IF THIS FAILS, LB:[1,1] IS ATTEMPTED AND IF THAT FAILS YOU HAVE 
; ERRORED OUT
;
;
; CALLING SEQUENCE:
;
;	CALL	COMINF (COMNAM,STATUS,SIZE,BLOCK,LUN,DATE,PIC)
;
;
;	THE FILE ON "LUN" IS OPEN AT THIS TIME AND MUST BE CLOSED
;		BUT NOT BY FORTRAN--- NONE OF THE FILE OPERATIONS
;		MAY BE DONE IN FORTRAN!!!
;
;
;
; INPUTS:
;	COMNAM = NAME OF THE FILE CONTAINING THE COMMON  (MAX OF SIX CHAR)
;
; OUTPUTS:
;	STATUS = 2 WORD INTEGER *2 ARRAY
;		FIRST WORD CONTAINS:
;	
;		 1 => SUCCESSFUL OPERATION
;		-1 => FILE PROBLEMS
;		-2 => COMMON NAMES DO NOT MATCH
;		-3 => FILE HAS WRONG ATTRIBUTES
;		-4 => WRONG ARGUMENTS
;
;		SECOND WORD CONTAINS FCS FILE STATUS
;
;	SIZE = SIZE IN 64. BYTE BLOCKS
;	BLOCK = FIRST VIRTUAL BLOCK OF FILE TO READ
;	LUN = LUN USED TO OPEN FILE
;	DATE = OPTIONAL PARAMETER - 3 WORD ARRAY THAT WILL
;		   CONTAIN THE CREATION DATE OF THE COMMON
;		WORD (1) = YEAR-1900
;		WORD (2) = MONTH
;		WORD (3) = DAY
;
;	PIC = OPTIONAL PARAMETER 1
;	 INTEGER *2 VALUE CAN BE USED AS LOGICAL*2 OR LOGICAL*1
;		-1 => TRUE, COMMON IS PIC
;		 0 => FALSE, COMMON IS NOT PIC
;
;
; SIDE EFFECTS:
;
;    MODIFIED EXTERNALS
;	NONE
;
;    OTHER SIDE EFFECTS
;	A FILE ON "LUN" IS OPENED AND MUST BE CLOSED BY THE USER
;	WHEN FILE PROCESSING IS DONE
;
;	COMFDB -- IS THE FDB GLOBAL
;	COMSB  -- IS THE STATUS GLOBAL
;	COMBN  -- IS THE BLOCK NUMBER TO READ
;
;	THESE GLOBALS ARE AVAILABLE FOR EXTERNAL USE
;	THEY ARE SETUP HERE AND CONTINUED USAGE IS AVAILABLE
;
;
;
; STANDARD REGISTER USAGE
;
;
; BLOCK STRUCTURED COMMENT FORM
;
;BEGIN
; GET COMMON NAME;
; IF COMMON NAME NOT LEGAL THEN ERROR -4;
; SELECT SY: CURRENT UIC;
; IF OPEN-FILE NOT SUCESSFUL
;  THEN BEGIN
;	SELECT LB:[1,1];
;	IF OPEN-FILE NOT SUCESSFUL THEN ERROR -1
;	END;
; READ LABEL BLOCK (BLOCK 1) INTO LB AREA;
; IF LB.L$BPAR <> COMNAM THEN ERROR -2;
; IF LB.FLAG <> TS$NHD!TS$CHK THEN ERROR -3;
; STATUS := 1;
; LUN := LUN USED;
; SIZE := LB.L$BMXZ;
; BLOCK := LB.L$BHRB+1;
; IF DATE ARGUMENT ADDRESS <> -1
;  THEN	BEGIN
;	DATE=LB.L$BDAT;
;	END;
; IF PIC ARGUMENT <> -1 
;   THEN IF COMMON IS PIC
;          THEN PIC := TRUE
;          ELSE PIC := FALSE;
;
;END;
;-
;
; ROUTINES CALLED
;	$CAT5	-- CONVERT ASCII TO RAD50
;
 
;
; EQUATED SYMBOLS
;
; LOCAL MACROS
;
	.MACRO	SAVRG
	JSR	R5,$SAVRG
	.ENDM

 
;
; LOCAL DATA
;
; F I L E   D A T A   S T R U C T U R E S
;
COMFDB::				;GLOBAL FOR EXTERNAL REF
FDB:	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	LB,512.,COMBN,,IOSB
	FDOP$A	LBO.LN,DSPT,<FO.RD>

COMSB::					;GLOBAL FOR EXTERNAL REF TO STATUS
IOSB:	.BLKW	2
COMBN::	.BLKW	2			;STORAGE FOR BLOCK NUMBER


;
; D E F A U L T   N A M E   B L O C K S 
;
DFNBLB:	NMBLK$	XXXXXXXXX,TSK,0,LB,0
DFNBSY:	NMBLK$	XXXXXXXXX,TSK,0,SY,0
;
;
; DATA SET POINTER
;
DSPT:	.WORD	0,0
	.WORD	0,0
NAMSZ:	.WORD	0,FILNAM
;
; SYSTEM UIC FOR LIBRARIES
;
SYSUIC:	.ASCII	/[1,1]/
SYSNSZ = .-SYSUIC
	.EVEN

;
; O T H E R   T E M P   S T O R A G E
;
FILNAM:	.ASCII	/         /
	.EVEN

FILN5:	.BLKW	2		;RAD50 REP OF FILE NAME
SAVST:	.WORD	0		;TEMP STORAGE FOR STATUS ARRAY
NUMARG:	.WORD	0		;SAVES NUMBER OF ARGUMENTS
SAVLFG:	.WORD	0		;SAVES LABEL FLAG WORD

;
; S T O R A G E   F O R   L A B E L   B L O C K
;
LB:	.BLKB	520.
;
;
	.PAGE
COMINF::
	SAVRG				;SAVE REGISTERS
	MOVB	(R5)+,NUMARG		;GET THE NUMBER OF ARGUMENTS
	INC	R5			;BUMP PAST JUNK

; FILL TEMP STORAGE WITH SPACES

	MOV	#9.,R0			;PUT SPACES IN COMMON TEMP STORAGE
	MOV	#FILNAM,R1		;ADDRESS FOR TEMP STORAGE
10$:	MOVB	#' ,(R1)+		;FILL WITH BLANKS
	SOB	R0,10$			; TILL ALL DONE

; TRANSFER 6 CHAR OF FILENAME, STOP IF NUL OR SPACE

	MOV	#6,R0			;MOVE ONLY 6 CHAR BUT STOP WITH BLANK
	MOV	#FILNAM,R1		;TO FILNAM
	MOV	(R5)+,R2		;FROM ARRARY
	MOV	(R5)+,SAVST		;SAVE ADDRESS OF STATUS ARRAY
20$:	MOVB	(R2)+,(R1)		;SAVE CHAR
	CMPB	#' ,(R1)		;CHECK IF SPACE
	BEQ	30$			;IF SO EXIT
	TSTB	(R1)+			;CHECK IF NULL ADVANCE POINTER
	BEQ	30$
	SOB	R0,20$			;CONTINUE TILL DONE

30$:	MOV	#6,NAMSZ		;GENERATE NUMBER OF CHAR
	SUB	R0,NAMSZ		;GOT IT
	BNE	40$
	JMP	ERR4			;ERROR 4 BAD PARAMITER

; SAVE NAME IN RAD50 FORM

40$:	MOVB	#' ,(R1)		;ADD A BLANK (PERHAPS NOW HAVE 2)
	CLR	FILN5			;CLEAR RAD50 STORAGE
	CLR	FILN5+2
	MOV	#FILNAM,R0		;CONVERT AND SAVE RAD50 FILENAME
	CLR	R1
	CALL	$CAT5			;DO CONVERSION
	MOV	R1,FILN5		;SAVE CONVERTED NAME
	BCS	50$			;IF CARRY SET NO MORE CHAR TO CONVERT
	CLR	R1
	CALL	$CAT5
	MOV	R1,FILN5+2

50$:

; ATTACH SY: CURRENT DEFAULT FILENAME BLOCK TO FDB

	MOV	#DFNBSY,FDB+F.DFNB 	; DONE
	CLR	DSPT+4			;CLEAR OFF UIC AS DEFAULTING TO CURRENT
	CLR	DSPT+6
	OPEN$R	#FDB			;OPEN FILE IF ABLE
	BCC	60$			;SUCESS CONTINUE

; COULD NOT OPEN USER FILE, LETS TRY SYSTEM FILE

	MOV	#DFNBLB,FDB+F.DFNB 	; TRY LB:[1,1]
	MOV	#SYSNSZ,DSPT+4		; INSERT [1,1]
	MOV	#SYSUIC,DSPT+6
	OPEN$R	#FDB			;ATTEMP TO OPEN FILE
	BCC	60$
	JMP	ERR1			;ERROR 1 FILE PROBLEMS

; READ LABEL BLOCK FROM FILE

60$:	CLR	COMBN			;SET INITAL BLOCK NUMBER
	MOV	#1,COMBN+2		;
	READ$	R0			;READ IN FIRST BLOCK
	WAIT$	R0			;WAIT FOR COMPLEATION
	BCC	70$			;OPERATION OK
	JMP	ERR1			;ERROR 1 FILE PROBLEMS

; CHECK COMMON NAME

70$:	MOV	#LB,R4			;GET ADDRESS OF LABEL BLOCK IN R4
	CMP	L$BPAR(R4),FILN5	;FIRST WORD
	BNE	80$
	CMP	L$BPAR+2(R4),FILN5+2	;SECOND WORD
	BEQ	90$

80$:	JMP	ERR2

; CHECK FOR CORRECT ATTRUBUTES

90$:	MOV	L$BFLG(R4),SAVLFG	;SAVE FLAG WORD
	BIC	#TS$PIC,L$BFLG(R4)	;CLEAN OFF JUNK BIT
	CMP	#TS$NHD!TS$CHK,L$BFLG(R4) ;CHECK FOR REAL COMMON
	BEQ	100$
	JMP	ERR3			;COMMON ISN'T A COMMON ERROR 3

; START TO LOAD RETURNED ARGUMENTS

100$:	MOV	L$BMXZ(R4),@(R5)+	;SAVE THE SIZE
	MOV	L$BHRB(R4),@(R5)	;AND THE BLOCK
	INC	@(R5)+			;ADJUST
	MOV	#LBO.LN,@(R5)+		;LOAD THE LUN
	CMP	#6,NUMARG		;CHECK IF 6 OR MORE ARGUMENTS
	BGT	110$			;IF NOT JUST EXIT
	MOV	(R5)+,R2		;GET DATE ARRAY ADDRESS
	CMP	#-1,R2			;CHECK FOR DEFAULT
	BEQ	110$

	MOV	#L$BDAT,R3		;GENERATE ADDRESS OF DATE IN LB
	ADD	R4,R3
	MOV	(R3)+,(R2)+
	MOV	(R3)+,(R2)+
	MOV	(R3)+,(R2)+
110$:
	CMP	#7,NUMARG		;CHECK IF 7 OR MORE ARGUMENTS
	BGT	111$			;NO => NO PIC ARGUMENT
	MOV	(R5)+,R2		;SEE IF DEFALUT ARGUMENT
	CMP	#-1,R2			;IF -1 IT IS
	BEQ	111$
	CLR	(R2)			;ASSUME FALSE
	BIT	#TS$PIC,SAVLFG		;CHECK TO SEE IF IT IS
	BEQ	111$
	DEC	(R2)			;NO SET TRUE
	
111$:
SUC:	MOV	#1,@SAVST		;SUCESS
	BR	DONE
ERR4:	MOV	#-4,@SAVST
	BR	DONE
ERR3:	MOV	#-3,@SAVST
	BR	DONE
ERR2:	MOV	#-2,@SAVST
	BR	DONE
ERR1:	MOV	#-1,@SAVST


DONE:	ADD	#2,SAVST
	MOV	F.ERR(R0),@SAVST	;SAVE ERROR STATUS
	
	RETURN
	.END