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

TITLE OPEN ROUTINE TO BRING F40 USERS THE BENEFITS OF FOROTS OPEN
SUBTTL WRITTEN BY I.L. GOVERMAN, DIGITAL EQUIPMENT CORP.
COMMENT @
	THIS ROUTINE IS INTENDED TO ALLOW F40 USERS TO TAKE
	ADVANTAGE OF ALL THE POWER OF THE FOROTS OPEN STATEMENT.
	WHILE NOT AS EASY TO USE AS THE EQUIVALENT F10 STATEMENT,
	ANY FILE HANDLING THAT FOROTS OPEN IS CAPABLE OF IS NOW
	AVAILABLE TO THOSE USING F40 AS THEIR FORTRAN COMPILER.

	BNF FORM OF CALL TO OPEN:
	
	CALL TO OPEN:= "CALL OPEN (" , ARGLIST, ")"
	ARGLIST:= ARGPAIR ! ARGLIST,ARGPAIR
	ARGPAIR:= 'ARGNAME',LITERAL ! 'ARGNAME',VALUE ! 'ARGNAME',VARIABLENAME

	WHERE ARGNAME IS ONE OF: (ENCLOSED IN QUOTES)

	UNIT				LOGICAL UNIT (REQUIRED)
	DIALOG				DIALOG MODE LIST
	ACCESS				FILE ACCESS TYPE (REQUIRED)
	DEVICE				DEVICE FOR FILE
	BUFFERCOUNT			NUMBER OF BUFFERS
	BLOCKSIZE			LOGICAL BLOCK SIZE
	FILE				FILE NAME
	PROTECTION			FILE PROTECTION
	DIRECTORY			PPN AND/OR PATH
	LIMIT				USER SPECIFIED FILE LIMITS
	MODE				DATA MODE FOR FILE
	FILESIZE			ALLOCATE SPACE FOR FILE
	RECORDSIZE			SIZE OF RECORDS (REQ. FOR RANDOM ACCESS)
	DISPOSE				DISPOSITION OF FILE WHEN CLOSED
	VERSION				FILE VERSION NUMBER
	REELS				MULTIPLE REEL SPECIFICATIONS
	MOUNT				MOUNT SPECIFICATION
	ERROR				VARIABLE TO RECIEVE ERROR CODE
	ASSOCIATE			RANDOM ACCESS ASSOCIATED VARIABLE
	PARITY				PARITY OF FILE
	DENSITY				MAGTAPE DENSITY

	NOTE: ARGNAME CAN BE SHORTENED TO FIRST FIVE CHARACTERS
	BUT SHOULD BE COMPLETE TO FACILITATE EASY CONVERSION TO
	F10 OPEN FORMAT.


	THE USER IS REFERRED TO THE F10 AND FOROTS MANUALS FOR AN
	EXPLANATION OF THE ARGUMENT NAMES AND THEIR USAGE.

	THE USER IS ALSO REFERRED TO THE F10 AND FOROTS MANUALS FOR
	REFERENCE AS TO THE FORM THAT THE VALUE,CONSTANT OR VARIABLE
	OR LITERAL MUST TAKE FOR EACH ARGUMENT PASSED TO OPEN.
	THIS ROUTINE WILL ALLOW ANY ARGUMENT ALLOWED IN F10 OPEN
	STATEMENTS, BUT THE USER MUST BE AWARE THAT DIFFERENT
	ARGUMENTS TO OPEN REQUIRE DIFFERENT FORMS OF PARAMETERS.
	(I.E. SOME TAKE VARIABLE NAMES, SOME TAKE CONSTANTS,
	SOME TAKE ARRAYS, SOME TAKE DOUBLE PRECISION ARGS, SOME
	REQUIRE LITERALS AND SOME WILL TAKE PARAMETERS IN MORE
	THAN ONE OF THE ABOVE FORMS)

	EXAMPLES:

	OPEN A FILE CALLED FOO.FOO ON DEVICE DSK, UNIT 2, FOR SEQOUT
	WRITING.

	CALL OPEN('UNIT',2, 'DEVICE','DSK', 'FILE', 'FOO.FOO',
	1   'ACCESS','SEQOUT')



	OPEN A FILE CALL RANDOM.FIL ON DEVICE DSK,
	RECORD SIZE IS 12, UNIT IS 15, ACCESS WILL BE RANDOM,
	J WILL BE THE ASSOCIATED VARIABLE:

	DOUBLE PRECISION ACC,FIL
	DATA ACC,FIL/'RANDOM','RANDOM.FIL'/
	IUNIT=15

	CALL OPEN('UNIT',IUNIT,'ACCESS',ACC,'FILE',FIL,
	1  'DEVICE','DSK','ASSOCIATE',J,'RECORDSIZE',12)



	AT RUNTIME THE USER IS NOTIFIED OF THREE TYPES OF ERROR

	1) UNRECOGNIZED ARGNAME
	2) INVALID DATA TYPE FOR THIS ARGUMENT (SPORADIC)
	3) ODD NUMBER OF ARGUMENTS
	THESE MESSAGES ARE NON-FATAL IN THE HOPE THAT FOROTS
	WILL BREAK INTO DIALOG MODE AND RESCUE THE
	ERRANT USER.

	[END OF DOCUMENTATION]
@
; AC DEFINITIONS
	AC0==0
	AC1==1
	AC2==2
	AC3==3
	AC4==4
	AC5==5
	Q==10	;GETS VARIABLE TYPE CODE OF PARAMETERS
	R==12	;GETS OPEN ARG NAME CODE
	T==11	;GETS ASCII ARG NAME (FIRST 5 CHARS.)
	PPNT==13;POINTS TO ARGUMENT VALUE
	TPNT==14;POINTS TO ARGUMENT NAME
	ARGCNT==15	;NUMBER OF ARGUMENTS
	AP==16	;ARG BLOCK POINTER
	PP==17	;PUSH DOWN LIST POINTER
; F40 ARGUMENT PSEUDO-OP
	ARG==320



	EXTERNAL	OPEN.
;ENTRY POINT
	ENTRY OPEN
OPEN:	Z				;ZERO ENTRY WORD
	MOVE	AC0,[1,,SAVAC]		;SET UP TO SAVE ACS
	BLT	AC0,SAVAC+15		;1-16 SAVED
	SETZB	ARGCNT,UNIT		;CLEAR PARAMETER AREA
	MOVE	AC0,[UNIT,,UNIT+1]	
	BLT	AC0,UNIT+26		;DONE
	MOVE	TPNT,AP			;SET UP POINTERS
	MOVE	PPNT,TPNT		;ADJUST
	AOJ	PPNT,
LOOP:	PUSHJ	PP,NEXTA		;ANOTHER ARG?
	JRST	ALLDUN			;NO, FINISH UP
	AOJ	ARGCNT,			;INCREMENT ARG COUNTER
	PUSHJ	PP,CHKT			;LOOKUP ARG NAME
	JRST	TERR			;NOT RECOGNIZED
	PUSHJ	PP,GETP			;GET PARAMETER
	JUMPLE	Q,ATERR			;BAD VARIABEL TYPE
	JUMPN	R,NOTUNI		;SPECIAL HANDLING FOR UNIT#
	MOVE	R,@0(PPNT)		;GET UNIT #
	HRRZM	R,UNIT			;STORE
	SOJA	ARGCNT,FINL		;ADJUST ARGCNT AND FINISH LOOP
NOTUNI:	DPB	Q,[POINT 4,PB-1(ARGCNT),12]	;PUT AWAY TYPE
	DPB	R,[POINT 9,PB-1(ARGCNT),8]	;STORE ARG CODE
	HRRZ	R,0(PPNT)		;GET ADDRESS OF PARAMETER
	HRRM	R,PB-1(ARGCNT)		;PUT AWAY
FINL:	ADDI	TPNT,2			;UPDATE POINTERS
	ADDI	PPNT,2		
	JRST 	LOOP			;TRY NEXT
ALLDUN:	SKIPE	UNIT			;MAYBE UPDATE ARG COUNT
	AOJ	ARGCNT,			;IN CASE DECREMENTED BY UNIT
	ADDI	ARGCNT,2		;ADJUST FOR TWO ZERO WORDS
	MOVN	T,ARGCNT		;-ARGCNT
	HRLZM	T,NUMARG		;STORE
	MOVEI	AP,UNIT			;GET READY FOR OPEN
	PUSHJ	PP,OPEN.		;OPEN
	JFCL				;IN CASE OF SKIP RETURN
	MOVE	AC0,[SAVAC,,1]		;RESTORE ACS
	BLT	AC0,AP			;ZAP!
	JRA	16,1(16)		;GO HOME
SUBTTL	UTILITY ROUTINES
;CHECK FOR NEXT ARG PAIR, SKIP RETURN IF THERE

NEXTA:	LDB	T,[POINT 9,0(PPNT),8]
	LDB	R,[POINT 9,0(TPNT),8]
	CAIE	R,ARG			; FIRST ARG THERE?
	POPJ	PP,			; NO, GO BACK, ALL DONE
	CAIE	T,ARG			;SECOND ARG THERE?
	JRST	NOPAIR			;NO, USER ERROR
	AOS	(PP)			;PAIR THERE, TAKE SKIP RETURN
	POPJ	PP,
;LOOKUP ARG NAME IN TTAB
CHKT:	HRLZI	AC1,-TLEN		;AOBJN POINTER
	MOVE	T,@0(TPNT)		;FETCH USER GIVEN NAME
CHKT1:	CAMN	T,TTAB(AC1)		;CHECK
	JRST	CHKT2			;FOUND A MATCH
	AOBJN	AC1,CHKT1		;TRY AGAIN
	POPJ	PP,			;NO MATCH
CHKT2:	AOS	(PP)			;SKIP RETURN
	HRRZ	R,AC1			;R GETS ARG CODE
	POPJ	PP,			;GO BACK
; GET F40 VARIABLE TYPE CODE AND PUT ITS CORR F10 CODE IN REG. Q
GETP:	LDB	Q,[POINT 4,0(PPNT),12]	;GETS F40 CODE
	MOVE	Q,F10TAB(Q)		;CONVERT
	POPJ	PP,			;GO BACK
SUBTTL ERROR ROUTINES
TERR:	TTCALL	3,[ASCIZ/%NOT A RECOGNIZED OPEN PARAMETER: /]
	SETZ	R,
	TTCALL	3,T
	TTCALL	3,[ASCIZ/
/]
	SOJA	ARGCNT,FINL			;ADJUST AND GO BACK
ATERR:	TTCALL	3,[ASCIZ/%PARAMETER OF INVALID TYPE PASSED TO OPEN
/]
	SOJA	ARGCNT,FINL
NOPAIR:	TTCALL	3,[ASCIZ/%ODD NUMBER OF ARGUMENTS IN OPEN CALL
/]
	POPJ	PP,
SUBTTL TABLES FOR SETUP AND CONVERSION
;F40 TO F10 VARIABLE TYPE CONVERSION TABLE
F10TAB:	2	;INTEGER
	-1	;ERROR (UNUSED IN F40)
	4	;1-WORD REAL
	-1	;ERROR, NO LOGICAL ARGS TO OPEN
	6	;OCTAL
	17	;ASCII
	10	;DP INT (DP IN F40)
	10	; DP INT (COMPLEX IN F40)
;
; TABLE OF ARG NAMES ACCEPTED
TTAB:	ASCII/UNIT /
	ASCII/DIALO/
	ASCII/ACCES/
	ASCII/DEVIC/
	ASCII/BUFFE/
	ASCII/BLOCK/
	ASCII/FILE /
	ASCII/PROTE/
	ASCII/DIREC/
	ASCII/LIMIT/
	ASCII/MODE /
	ASCII/FILES/
	ASCII/RECOR/
	ASCII/DISPO/
	ASCII/VERSI/
	ASCII/REELS/
	ASCII/MOUNT/
	ASCII/ERROR/
	ASCII/ASSOC/
	ASCII/PARIT/
	ASCII/DENSI/
;LENGTH OF TABLE
	TLEN=.-TTAB
SUBTTL STORAGE AREA
;PARAMETER BLOCK
NUMARG:	Z			;GETS # OF ARGUMENTS IN BLOCK
UNIT:	Z			;GETS LOGICAL UNIT NUMBER
	Z
	Z
PB:	BLOCK 25		;GETS REST OF JUNK
SAVAC:	BLOCK 16		;AC BLT BLOCK
	LIT
	PRGLEN=.-OPEN
	END
IIIAAAA>>AAA>			
			
AA@@@@IIIA>AAA>			IIIA``~~>AAAA*U*!.7,