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