Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50150/ifile.300
There are 2 other files named ifile.300 in the archive. Click here to see a list.
TITLE	IFILE - OFILE  ROUTINE FOR DOING LOOKUPS FROM FORTRAN
SUBTTL	21-APR-69
;
;MODIFIED FOR SNOBOL TO HANDLE PPNS L.P. WADE 9-8-70
;
ENTRY IFILE
ENTRY OFILE
ENTRY	FILNMQ
;
;
;
; SEQUENCES BELOW MODIFIED FOR PPNS BY CHECKING
; WHETHER THE 3RD AND 4TH ARGUMENTS EXIST. IF SO THEY ARE
; ASSUMED TO BE OCTAL PROJECT-PROGRAMMER NUMBERS.
;
; THIS ALLOWS SYNTAX LIKE
;
; LPT:_SYS:COMMON,DSK:[30,112]FOOBAR,DSK:FOO
;
; OR
; IFILE(20,'NAME.FOO',30,112)
;
;IFILE CALLING SEQUENCE
;
;	JSA	16,IFILE
;	ARG	0,A1
;	ARG	5,A2
;OR
;	JSA	16,IFILE
;	ARG	0,A1
;	ARG	N,A3
;OR
;	JSA	16,IFILE
;	ARG	0,A1
;	ARG	N,A4
;	ARG	N,A5
;
;WHERE
;	A1 - ADDRESS OF FORTRAN LOGICAL UNIT NUMBER
;	A2 - ADDRESS OF 1 OR 2 WORD LITERAL SPECIFING FILE NAME
;	A3 - ADDRESS OF IDENTIFIER SPECIFING FILE NAME IN ONE WORD
;	A4,A5 - ADDRESS OF TWO IDENTIFIERS SPECIFYING FILE NAME
;
;THE FILE NAME AND EXTENSION MUST BE TYPED WITH NO IMBEDDED BLANKS
;AND WITH A PERIOD SEPARATING THE FILENAME AND EXTENSION.
;
;OFILE IS CALLED IN THE SAME WAYS AS IFILE.
;
;IFILE RESULTS EVENTUALLY IN A 'LOOKUP'.
;OFILE RESULTS EVENTUALLY IN AN 'ENTER'.
;
INF.=26B8
OUTF.=27B8
JUMPAR=320
P=17
IFILE:	0
	PUSHJ 	P,KJ1
INF:	INF.	0,INF	;ADDRESS IS MODIFIED.
	JRA	16,2(16)	;RETURN
OFILE:	0
	PUSHJ	P,KJ1
OUTF:	OUTF.	0,OUTF	;ADRESS IS MODIFIED.
	JRA	16,2(16)	;RETURN
FILNMQ:	0
	PUSHJ	P,.+2
	JRST	KJ9
	PUSH	P,1
	PUSH	P,2
	SUBI	16,1
	JRST	KJ8
KJ9:	PUSH	P,1
	HRRZ	1,3(16)
	MOVE	TEMP
	MOVEM	(1)
	MOVE	TEMP+1
	MOVEM	1(1)
	POP	P,1
	JRA	16,3(16)
KJ1:	PUSH	P,1	;SAVE THE ACCUMULATORS
	PUSH	P,2
	MOVE	0,@(16)	;GET FORTRAN LOGICAL UNIT NUMBER.
	HRRM	0,INF	;AND DEPOSIT IT IN THE UUO'S
	HRRM	0,OUTF
KJ8:	CLEARM	TEMP	;CLEAR SIXBIT FILE NAME
	CLEARM	TEMP+1	;AND EXTENSION
	CLEARM  TEMP+2	;CLEAR PROJECT
	CLEARM TEMP+3	;CLEAR PROGRAMMER NO.
	MOVE	1,1(16)	;GET ADDRESS AND TYPE OF 2ND ARGUMENT.
	LDB	0,[POINT  4,1,12]	;EXTRACT ARGUMENT TYPE.
	CAIE	0,5	;IS IT A LITERAL?
	JRST	KJ2	;NO, GO SEE WHICH CALL WE HAVE.
	MOVE	0,1(1)	;YES MOVE LITERAL TO BUFFER.
KJ3:	MOVEM	0,FN+1	;IF ONE WORD, THEN 2ND WORD WILL BE ALL ZERO.
	MOVE	0,(1)
	MOVEM	0,FN
DOIT:	MOVE	1,[POINT  7,FN]	;POINTS TO ASCII FILE NAME.
	MOVE	2,[POINT  6,TEMP]	;PTR TO SIXBIT FILE NAME.
KJ6:	PUSHJ	P,GETBYT
	CAIG	0,57	;CHECK FOR BREAK CHAR.
	JRST	KJ4	;YES
	PUSHJ	P,PUTBYT	;NO, ADD TO FILE NAME
	JRST	KJ6	;LOOP FOR NEXT BYTE
KJ4:	CLEARM	TEMP+1	;IN CASE WE GOT OVER 6 CHAR. IN F. N.
	MOVE	2,[POINT  6,TEMP+1]	;PTR FOR 6BIT EXT.
KJ7:	PUSHJ	P,GETBYT
	PUSHJ	P,PUTBYT	;PUT IT IN EXTENSION
	JRST	KJ7	;LOOP FOR NXT. BYTE.
GETBYT:	TLNE	1,760000	;HAVE 5 CHAR. BEEN PICKED FROM WORD?
	JRST	KJ5	;NO, GO GET NEXT BYTE.
	CAMN	1,[POINT  7,FN+1,34]	;YES, IS IT 2ND WORD?
	JRST	UUOCAL	;YES, GO DO UUO CALL.
KJ5:	ILDB	0,1	;GET NEXT ASCII BYTE.
	POPJ	P,	;RETURN FROM GET BYTE.
PUTBYT:	CAIG	0,57	;SLOUGH BREAKS WHEN DOING EXTENSION.
	POPJ	P,	;RETURN SLOUGHING BREAK CHAR.
	TRC	0,40	;CONVERT TO SIXBIT.
	IDPB	0,2	;
	CAME	2,[POINT  6,TEMP+1,17]	;DON'T GO PAST 3 CHAR. EXT.
	POPJ	P,	;RETURN FROM PUTBYT.
;NXT INST. MUST FOLLOW PUTBYT RETURN....
UUOCAL:	POP	P,0	;POP DEAD RETURN FROM STACK
;
; FOLLOWING ADDED FOR PPN HANDLING
;
	LDB 1,[POINT 9,2(16),8]
	CAIE 1,JUMPAR
	JRST UUO1	;NOT 'ARG'
	MOVE 1,@2(16)
	MOVEM 1,TEMP+3
UUO1:
;
;  END OF PPN CHANGE
	HRRZI	0,TEMP	;AC0 CONTAINS ADDRESS OF F. N.
	POP	P,2	;RESTORE AC'S
	POP	P,1
	POPJ	P,	;RETURN TO DO PROPER UUO CALL.
KJ2:	HLRZI	0,0	;PUT ZERO IN AC0.
	MOVE	2,2(16)	;CHECK FOR THREE ARGUMENTS.
	TLCE	2,320000	;IS THIRD WORD A NOOP?
	TLNE	2,777000	;MAYBE - LOOK CLOSER.
	JRST	KJ3	;NO CHANCE USE ZERO FOR 2ND WORD.
	MOVE	0,(2)	;DEFINITELY YES, GET SECOND ARG.
	JRST	KJ3	;AND MOVE TO BUFFER.
;
;
;DATA AREA....
;
;
FN:	BLOCK	2	;BUFFER FOR ASCII FILE NAME AND EXTENSION.
TEMP:	BLOCK	4	;BUFFER FOR SIXBIT FILE NAME AND EXTENSION.
	END