         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
$ TITLE " MPE-V FILE SYSTEM - BASELINE OPEN-CLOSE "                     00060000
*              MPE-V Baseline File System                             * 00095000
<< FCLOSE recovers from LABELERROR.>>                          <<F1115>>00560100
<< Fix labelled tapes not rewinding after FOPEN failure >>     << 1591>>00561000
<< Change end of data size for floppy diskettes in DISCSIZE >> << 2225>>00561100
<< Fix FLABELINFO to return values on word boundaries >>       <<02055>>00562010
<< Fix FOPEN to deallocate device files on all errs (zap ODD)>><<02085>>00562020
<< Fix MVTABX passed to LUN in GET'USERLABEL of FLABELINFO >>  <<02289>>00562030
<< RFA Changes made for auto logons by Tim Teske: NS (IND) >>  <<02391>>00562040
<< Fix to allow avoidance of PV chk for old disc fls in FOPEN>><<02493>>00562050
<< procedure GETGLOBINFO added to FILESYS7 for TURBOIMAGE >>   <<01473>>00562100
<< Check for bit (12:1) of aops on in FOPEN when deallocing >> << 2219>>00562200
<< For system LOG FCLOSE recs, use ACB for spoofles >>         <<02053>>00562300
<< FOPENDA to keep NOEQUATE bit in FOPTION for old file >>     <<02056>>00562400
<< add additional info to FOPEN ATTIO calls for perf. meas. >> <<01922>>00562600
<< call FFILEINFO 50 instead of 6 in REDIRECT'IT of FOPEN >>   <<02084>>00562700
<<***********************************************************>><<R1889>>00563000
<< FEBRUARY 3, 1986     RICHARD SANTOS                       >><<R1889>>00563010
<<                                                           >><<R1889>>00563020
<<                                                           >><<R1889>>00563030
<< FIXES RELATED TO THE AUTOALLOCATE PROJECT                 >><<R1889>>00563040
<<                                                           >><<R1889>>00563050
<<                                                           >><<R1889>>00563060
<< FILE SYSTEM ASSOCIATION WITH THE AUTOALLCOATE PROJECT     >><<R1889>>00563070
<<                                                           >><<R1889>>00563080
<<  EXAMPLE:                                                 >><<R1889>>00563090
<<   PRIOR TO AUTOALLOCATE:                                  >><<R1889>>00563100
<<    IF THE FILE SYSTEM IS REQUESTED TO PURGE A FILE WHICH  >><<R1889>>00563110
<<    IS LOADED AN EXCLUSIVE ACCESS VIOLATION WOULD OCCUR.   >><<R1889>>00563120
<<                                                           >><<R1889>>00563130
<<   WITH AUTOALLOCATE:                                      >><<R1889>>00563140
<<    IF THE FILE SYSTEM IS REQUEST TO PURGE A FILE WHICH IS >><<R1889>>00563150
<<    LOADED THE LOADER IS CALLED TO SEE IF THE FILE IS      >><<R1889>>00563160
<<    AUTOALLOCATED AND THE REFERENCE COUNT IS 0.  IF SO THE >><<R1889>>00563170
<<    THE FILE IS UNLOADED AND CONTROL IS RETURNED TO THE    >><<R1889>>00563180
<<    FILE SYSTEM TO CONTINUE WITH THE PURGE.                >><<R1889>>00563190
<<                                                           >><<R1889>>00563200
<<                                                           >><<R1889>>00563210
<<   THERE ARE OTHER EVENTS, BESIDE 'PURGE' WHICH CAUSE      >><<R1889>>00563220
<<   THE LOADER TO BE INVOKED TO UNLOAD A FILE IF IT DOESN'T >><<R1889>>00563230
<<   NEED TO BE UNLOADED.  THEY ARE:                         >><<R1889>>00563240
<<         1) OPENING A FILE WITH WRITE ACCESS (ACTUALLY     >><<R1889>>00563250
<<            MODIFIABLE ACCESS)                             >><<R1889>>00563260
<<         2) OPENING A FILE WITH EXCLUSIVE ACCESS           >><<R1889>>00563270
<<         3) CLOSING A FILE WITH DISPOSITION 4 (DELETE)     >><<R1889>>00563280
<<         4) PURGEGROUP, PURGEACCT COMMANDS                 >><<R1889>>00563290
<<----------------------------------------------------------->><<R1889>>00563300
<<  HISTORY OF FIXES ASSOCIATED WITH AUTOALLOCATE            >><<R1889>>00563310
<<                                                           >><<R1889>>00563320
<<  FIX # 1617                                               >><<R1889>>00563330
<<    ORIGINAL FIX. AFFECTED PROCEDURES: FRELSPACE, FOPEN    >><<R1889>>00563340
<<    AND FCLOSE.  IF THE LOAD BIT IN THE FILE LABEL WAS SET >><<R1889>>00563350
<<    THE PROCEDURE "DEALLOC'IF'AUTOALLOC" IN THE LOADER WAS >><<R1889>>00563360
<<    CALLED.                                                >><<R1889>>00563370
<<                                                           >><<R1889>>00563380
<<  FIX # 1833                                               >><<R1889>>00563390
<<    PROBLEM:  DEADLOCK BECAUSE FOPEN, FRELSPACE, FCLOSE ALL>><<R1889>>00563400
<<              HAD THE FILE INTEGRITY SIR PRIOR TO CALLING  >><<R1889>>00563410
<<              LOADER WHICH DID A "GETSIR" ON THE LOADER    >><<R1889>>00563420
<<              SEGMENT TABLE SIR.  THIS WAS GETTING THE SIRS>><<R1889>>00563430
<<              OUT OF ORDER.                                >><<R1889>>00563440
<<    SOLUTION: GOT THE LST SIR IN FRELSPACE, FOPEN AND      >><<R1889>>00563450
<<              FCLOSE.                                      >><<R1889>>00563460
<<                                                           >><<R1889>>00563470
<<  FIX # 1855                                               >><<R1889>>00563480
<<    PROBLEM:  DEADLOCK BECAUSE A DIRECTORY PROCEDURE GOT   >><<R1889>>00563490
<<              THE FILE INTEGRITY SIR PRIOR TO CALLING      >><<R1889>>00563500
<<              FRELSPACE WHICH GOT THE LST SIR WHICH WAS    >><<R1889>>00563510
<<              GETTING SIRS OUT OF ORDER.                   >><<R1889>>00563520
<<    SOLUTION: THE REASON THERE WAS CODE IN FRELSPACE WAS   >><<R1889>>00563530
<<              FOR "PURGEGROUP,PURGEACCT".  REMOVE ALL CODE >><<R1889>>00563540
<<              RELATED TO AUTOALLOCATE FROM FRELSPACE.  PUT >><<R1889>>00563550
<<              INTO "PURGEGROUP,PURGEACCT" COMMAND EXECUTOR >><<R1889>>00563560
<<              TO CALL THE LOADER AND UNLOAD ANYTHING IN    >><<R1889>>00563570
<<              THE GROUP AND/OR ACCOUNT BEING DELETED.      >><<R1889>>00563580
<<  FIX # 1889                                               >><<R2225>>00563590
<<    PROBLEM:  DEADLOCK - FOPEN GOT THE LST SIR AND LATER   >><<R1889>>00563600
<<              DURING FOPEN THE ACB WAS LOCKED VIA THE      >><<R1889>>00563610
<<              "CHECKMUTIACCESS" SUBROUTINE WHICH INDIRECTLY>><<R1889>>00563620
<<              CAUSED THE FMAVT TO BE RELEASED AND REAQUIRED>><<R1889>>00563630
<<              REAQUIRING THE FMAVT SIR CAUSED A PROBLEM    >><<R1889>>00563640
<<              BECAUSE THE LST WAS BEING HELD WHICH WAS     >><<R1889>>00563650
<<              GETTING THE SIRS OUT OF ORDER.               >><<R1889>>00563660
<<    SOLUTION: TO REMOVE THE CODE WHICH GOT THE LST SIR IN  >><<R1889>>00563670
<<              FOPEN. PUT INTO "DEALLOC'IF'AUTOALLOC" IN THE>><<R1889>>00563680
<<              LOADER TO RELEASE THE FILE INTEGRITY SIR AND >><<R1889>>00563690
<<              GET THE LST SIR THEN REAQUIRE THE FILE SIR.  >><<R1889>>00563700
<<              IN FOPEN IF THE LOADER WAS CALLED THE FILE   >><<R1889>>00563710
<<              LABEL WAS REREAD FROM DISK AND THE ACB WAS   >><<R1889>>00563720
<<              UNLOCKED PRIOR TO CALLING THE LOADER AND     >><<R1889>>00563730
<<              RELOCKED UPON RETURNING FROM THE LOADER.     >><<R1889>>00563740
<<                                                           >><<R1889>>00563750
<<              REREADING THE FILE LABLE COMBINED WITH THE   >><<R1889>>00563760
<<              FILE IN QUESTION HAS THE LOAD BIT SET        >><<R1889>>00563770
<<              JUSTIFIED RELEASING THE FILE INTEGRITY SIR   >><<R1889>>00563780
<<              FOR A MOMENT TO GET THE SIRS IN THE CORRECT  >><<R1889>>00563790
<<              ORDER.                                       >><<R1889>>00563800
<<  FIX # --------------------------------------------------->><<02291>>00563810
<<    Problem:  Richard put too many comments in this code.  >><<02291>>00563820
<<              Also had problems with deadlock in FCLOSE as >><<02291>>00563830
<<              well as performance probs with UA-MIT.       >><<02291>>00563840
<<    Solution? Decided to rake the LST GETSIR out of the fs.>><<02291>>00563850
<<              Put in fix to release all resources held in  >><<02291>>00563860
<<              FCLOSE before call to DEAL'IF'AUTO and then  >><<02291>>00563870
<<              reobtain in correct order afterwards.        >><<02291>>00563880
<<***********************************************************>><<02291>>00563890
$EDIT VOID=01181000                                                     01181000
DEFINE                                                        <<0pvuse>>01616000
  PVUSED     = ABSOLUTE(%1365).(12:1)#;                       <<0pvuse>>01617000
   JITJN     = 44, ! Job name, 8 bytes.                        <<09795>>01685000
   JITUN     = 28, ! Job username                                       01685277
   JITGSEC   = 14; ! Jit group security                                 01685555
   AUTO'SUBTYPE     = (13:3)#,  << Subtype for mag tapes >>    <<09517>>02170000
   FULL'SUBTYPE     = (12:4)#,  << complete device subtype >>  <<09517>>02171000
   LPDT'SUBTYPE     = LPDT(DADDR*LPDTENTRY+1).AUTO'SUBTYPE#,   <<09517>>02175000
   LDT'MAIN'PIN          = LDT(1)#,                            <<09905>>02326000
   LDT'CS'DEVICE         = LDT(2).(8:1)#,                      <<01474>>02340000
   LDTX'ALTER'PIN        = LDTX(3)#;                           <<01474>>02341000
MVTAB'DST             = 53,  << Mounted Volume Table DST     >><<01233>>02600000
SIZE'OF'MVTAB'ENTRY   = 22,  << MVTAB entry size             >><<01233>>02605000
SIZE'OF'MVTAB'VS'HEAD = 6,   << MVTAB volume set header size >><<01233>>02610000
SIZE'OF'VOL'ENTRY     = 2;   << Volume entry size            >><<01233>>02615000
                                                               <<01233>>02620000
DEFINE                                                         <<01233>>02621000
MVTAB'VOL'LDEV = MVTAB(VOL'INDEX).(0:8)#; << ldev of volume >> <<01233>>02622000
   MAXDEVPARMLEN = 8,    << max length of DEV= parameter >>    <<09793>>03261000
   DEN'DEFN      = "DN"#,                                      <<09792>>03425000
   VTERM'DEFN    = "VT"#;                                      <<09792>>03427500
   DEN'TOKEN     = DEN'DEFN,                                   <<09792>>03495000
   VTERM'TOKEN   = VTERM'DEFN;                                 <<09792>>03497500
$EDIT VOID=03497750                                            <<09792>>03497750
$PAGE "RFA DEFINITIONS"                                                 03636000
$PAGE                                                          <<09834>>03862750
<<----------------------------------------------------------->>         03863000
<<                                                           >>         03864000
<<        NS/3000 REMOTE FILE ACCESS DEFINITIONS             >>         03864010
<<        For file access procedures in FILESYS8             >>         03864020
<<                                                           >>         03864030
<<----------------------------------------------------------->>         03864040
                                                                        03864050
DEFINE                                                                  03864060
   RFA'VERSION'STR  =  "A0000001" #;                           <<01767>>03864070
                                                                        03864080
<< maximum lengths for various filesystem and DS related parms    >>    03864090
EQUATE                                                                  03864100
   RFA'HEAD       = 3,                                                  03864110
   SESSION'ID'LEN = 3,                                                  03864120
                                                                        03864130
   MAXNODELEN     = 116,                                       <<02391>>03864140
   MAXKSAMKEYLEN  = 128,                                                03864150
   MAXKSAMCTRLEN  = 128,                                                03864160
   MAXKSAMPARMS   = 80,                                                 03864170
   MAXFORMMSGLEN  = 162,                                                03864180
   MAXFGALEN      = 36, << F/L.G.Ax >>                                  03864190
   MAXFDLEN       = 152;  << F/L.G.A:N.D.O[L]x >>              <<02391>>03864200
                                                                        03864210
EQUATE                                                                  03864220
   RFA'MSG'PID    = 3, << protocol id for RFA >>                        03864230
                                                                        03864240
   <<--- RFA Message Request Codes --->>                                03864250
   RFA'OPE   = 0,      << fopen will be first in the CASE RFA'req >>    03864260
   RFA'CLO   = RFA'OPE+1,                                               03864270
                                                                        03864280
   RFA'REA   = RFA'CLO+1,                                               03864290
   RFA'RDI   = RFA'REA+1,                                               03864300
   RFA'RBK   = RFA'RDI+1,                                               03864310
   RFA'RKY   = RFA'RBK+1,                                               03864320
   RFA'RDC   = RFA'RKY+1,                                               03864330
                                                                        03864340
   RFA'WRI   = RFA'RDC+1,                                               03864350
   RFA'WDI   = RFA'WRI+1,                                               03864360
   RFA'UPD   = RFA'WDI+1,                                               03864370
                                                                        03864380
   RFA'CHK   = RFA'UPD+1,                                               03864390
   RFA'CON   = RFA'CHK+1,                                               03864400
   RFA'DEL   = RFA'CON+1,                                               03864410
   RFA'DEV   = RFA'DEL+1,                                               03864420
   RFA'FIL   = RFA'DEV+1,                                               03864430
   RFA'GET   = RFA'FIL+1,                                               03864440
   RFA'LOK   = RFA'GET+1,                                               03864450
   RFA'POI   = RFA'LOK+1,                                               03864460
   RFA'RLB   = RFA'POI+1,                                               03864470
   RFA'RSK   = RFA'RLB+1,                                               03864480
   RFA'REL   = RFA'RSK+1,                                               03864490
   RFA'REN   = RFA'REL+1,                                               03864500
   RFA'SMD   = RFA'REN+1,                                               03864510
   RFA'SPA   = RFA'SMD+1,                                               03864520
   RFA'ULK   = RFA'SPA+1,                                               03864530
   RFA'WLB   = RFA'ULK+1,                                               03864540
   RFA'FKY   = RFA'WLB+1,                                               03864550
   RFA'FDN   = RFA'FKY+1,                                               03864560
   RFA'GKY   = RFA'FDN+1,                                               03864570
   RFA'RMV   = RFA'GKY+1,                                               03864580
   RFA'KSP   = RFA'RMV+1,                                               03864590
   RFA'SPE   = RFA'KSP+1,                                               03864600
                                                                        03864610
   NUM'RFA'REQUESTS     = RFA'SPE+1,                                    03864620
                                                                        03864630
   RDBA'OPE   = RFA'SPE+1,                                              03864640
   RDBA'INF   = RDBA'OPE+1,                                             03864650
   RDBA'CLO   = RDBA'INF+1,                                             03864660
   RDBA'FIN   = RDBA'CLO+1,                                             03864670
   RDBA'GET   = RDBA'FIN+1,                                             03864680
   RDBA'UPD   = RDBA'GET+1,                                             03864690
   RDBA'PUT   = RDBA'UPD+1,                                             03864700
   RDBA'DEL   = RDBA'PUT+1,                                             03864710
   RDBA'LOK   = RDBA'DEL+1,                                             03864720
   RDBA'ULK   = RDBA'LOK+1,                                             03864730
   RDBA'CON   = RDBA'ULK+1,                                             03864740
   RDBA'BEG   = RDBA'CON+1,                                             03864750
   RDBA'END   = RDBA'BEG+1,                                             03864760
   RDBA'MEM   = RDBA'END+1,                                             03864770
                                                                        03864780
   NUM'RDBA'REQUESTS   = RDBA'MEM-RDBA'OPE+1,                           03864790
                                                                        03864800
   RDBA'DSC = RDBA'MEM+1,                                               03864810
   RFA'ADP  = RDBA'DSC+1,                                      <<02391>>03864820
   RFA'CRE  = RFA'ADP+1,                                       <<02391>>03864821
                                                               <<02391>>03864830
   NUM'RA'REQUESTS     = RFA'CRE+1;   << no of RFA intrinsics>><<02391>>03864840
                                                                        03864850
EQUATE                                                                  03864860
                                                                        03864870
   << offset to 0 element of fixed parms array within message array >>  03864880
   RFA'FPARMS0  = 2;                                                    03864890
                                                                        03864900
<< miscellaneous definitions >>                                         03864910
LOGICAL ARRAY                                                           03864920
   AQ (*)          = Q-0,                                               03864930
   A'DUMMY (*)     = S-0;                                               03864940
EQUATE                                                                  03864950
   FCONTROL'ABORTIO = 43;                                               03864960
DEFINE                                                                  03864970
   REQ             = (8:8) #; << field within MESSAGE array >>          03864980
                                                                        03864990
<< error handling >>                                                    03865000
EQUATE                                                                  03865010
   ERR'OLDDS       =  1,                                                03865020
   ERR'DSLINENV    = 201,     << accessing dsline/env table >>          03865030
   ERR'RESOURCE0   = 204,     << unable to create/expand RFA XDS >>     03865040
   ERR'RESOURCE    = 205,     << unable to allocate/manage RFA XDS >>   03865050
   ERR'NONODE      = 214,     << no such node >>                        03865060
   ERR'BADNODE     = 214,     << bad node specification >>              03865070
   ERR'MULTNODE    = 214,     << more than one node specified >>        03865080
   ERR'STACKSPACE  = 217,     << no stack space >>                      03865090
   ERR'FILEQ       = 224,     << file eq for remote is loopback >>      03865100
   ERR'TRACE       = 239,     << trace, malfunction >>                  03865110
   ERR'INTERNAL    = 242,     << unknown, unexpected internal err >>    03865120
   ERR'NOPLABS     = 242,     << internal error no rfa plabel >>        03865130
   ERR'DISCONNECT  = 246,     << remote disconnected >>                 03865140
   ERR'ADOPTION    = 249,     << cannot adopt remote server to CI >>    03865150
   ERR'TRANSPORT   = 255;     << ipc/transport error on rfa connection>>03865160
                                                               <<09834>>03865170
DOUBLE PROCEDURE RFA'FCLOSE (AFTX, P1, P2, P3, P4, P5, P6, P7, <<09834>>04685010
                             P8, P9, P10, P11, P12, P13, P14); <<09834>>04685020
VALUE AFTX,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14;     <<09834>>04685030
INTEGER AFTX;                                                  <<09834>>04685040
LOGICAL P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14;        <<09834>>04685050
OPTION VARIABLE, FORWARD;                                      <<09834>>04685060
                                                               <<09834>>04685070
DOUBLE PROCEDURE RFA'FRENAME (AFTX,P1,P2,P3,P4,P5,P6,P7,P8,P9, <<09834>>04685080
                              P10,P11,P12,P13,P14);            <<09834>>04685090
VALUE AFTX,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14;     <<09834>>04685100
INTEGER AFTX;                                                  <<09834>>04685110
LOGICAL P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14;        <<09834>>04685120
OPTION VARIABLE, FORWARD;                                      <<09834>>04685130
                                                               <<09834>>04685140
DOUBLE PROCEDURE RFA'FOPEN (AFTX, FOPTIONS, AOPTIONS, RECSIZE, <<09834>>04685150
   USERLABELS, BLOCKFACTOR, NUMBUFFERS, FILESIZE, NUMEXTENTS,  <<09834>>04685160
   INITALLOC, FILECODE, FOPENPMASK, PMODEFLAG, KSAM, DISP,     <<11610>>04685170
   FILENAME, ENVID, DEVICE, FORMMSG);                          <<11610>>04685180
VALUE AFTX, FOPTIONS, AOPTIONS, RECSIZE, USERLABELS,           <<09834>>04685190
   BLOCKFACTOR, NUMBUFFERS, FILESIZE, NUMEXTENTS, INITALLOC,   <<09834>>04685200
   FILECODE, FOPENPMASK, PMODEFLAG, KSAM, DISP;                <<11610>>04685210
LOGICAL FOPTIONS, AOPTIONS, FOPENPMASK, PMODEFLAG, KSAM, DISP; <<11610>>04685220
INTEGER AFTX, RECSIZE, USERLABELS, BLOCKFACTOR, NUMBUFFERS,    <<09834>>04685230
   NUMEXTENTS, INITALLOC, FILECODE;                            <<09834>>04685240
DOUBLE FILESIZE;                                               <<09834>>04685250
BYTE ARRAY FILENAME, ENVID, DEVICE, FORMMSG;                   <<09834>>04685260
OPTION FORWARD;                                                <<09834>>04685270
                                                               <<09834>>04685280
INTEGER PROCEDURE RFA'CIPIN (PIN);                             <<01767>>04685290
VALUE PIN;                                                     <<01767>>04685292
INTEGER PIN;                                                   <<01767>>04685294
OPTION FORWARD;                                                <<01767>>04685296
                                                               <<01767>>04685298
                                                               <<R1617>>04715100
PROCEDURE DEALLOC'IF'AUTOALLOC(LDEV,FADDR,FILECODE,FLAGS);     <<R1889>>04715200
   VALUE LDEV,FADDR,FILECODE,FLAGS;                            <<R1889>>04715300
   INTEGER LDEV,FILECODE,FLAGS;                                <<R1889>>04715400
   DOUBLE  FADDR;                                              <<R1889>>04715500
   OPTION EXTERNAL;                                            <<R1889>>04715600
LOGICAL PROCEDURE AUTOALLOCATE'IS'ON;                          <<R1889>>04716000
   OPTION EXTERNAL;                                            <<R1889>>04716100
LOGICAL PROCEDURE GETLDTX(LDEV,BUF);                           <<01474>>04721000
VALUE LDEV;                                                    <<01474>>04721100
INTEGER LDEV; INTEGER ARRAY BUF;                               <<01474>>04721200
OPTION EXTERNAL;                                               <<01474>>04721300
INTEGER PROCEDURE ADDJTENTRY (N1,N2,N3,N4,TNO,SIZE,INFO);      <<09792>>04790000
   BYTE ARRAY N1,N2,N3,N4;                                     <<09792>>04800000
                                                               <<09792>>04927500
LOGICAL PROCEDURE AS'DSPLABEL(INDEX);                          <<09792>>04927750
VALUE INDEX; INTEGER INDEX;                                    <<09792>>04928000
OPTION EXTERNAL;                                               <<09792>>04928250
                                                               <<09792>>04928500
<<        4  DS PAD terminal                                >> <<09947>>05330000
<<        5  NS pseudo terminal                             >> <<09947>>05331000
PROCEDURE FCCLOSE(FILENUM,FCB,FLAB,DISP,DOMAIN);               <<F1142>>05740000
   VALUE FILENUM,FCB,FLAB,DISP,DOMAIN;                         <<F1142>>05745000
   INTEGER FILENUM,DISP,DOMAIN;                                <<F1142>>05750000
INTEGER PROCEDURE REMJTENTRY (N1,N2,N3,N4,TNO,ADR);            <<09792>>06290000
   BYTE ARRAY N1,N2,N3,N4;                                     <<09792>>06300000
INTEGER PROCEDURE RETJTENTRY (N1,N2,N3,N4,SIZE,TNO);           <<09792>>06350000
   BYTE ARRAY N1,N2,N3,N4;                                     <<09792>>06355000
INTEGER PROCEDURE XRETJTENTRY (N1,N2,N3,N4,SIZE,INFO);         <<09792>>06545000
   BYTE ARRAY N1,N2,N3,N4;                                     <<09792>>06560000
<< STACKCHECK returns true if the DST number sent is a      >> <<09834>>07075000
<< stack, any stack, not necessarily our own.               >> <<09834>>07080000
                                                                        07081000
LOGICAL PROCEDURE STACKCHECK(DST'NUM);                         <<09834>>07085000
VALUE DST'NUM; INTEGER DST'NUM;                                <<09834>>07090000
OPTION EXTERNAL;                                               <<09834>>07095000
                                                               <<09834>>07100000
INTEGER PROCEDURE WHERES'DB;                                   <<09834>>07105000
OPTION EXTERNAL;                                               <<09834>>07110000
                                                               <<09834>>07115000
$EDIT VOID=07121214                                                     07115500
                                                               <<*1280>>07116000
   PROCEDURE FWRITE (FILENUM, TARGET, TCOUNT, CONTROL);        <<*1280>>07117000
      VALUE FILENUM, TCOUNT, CONTROL;                          <<*1280>>07118000
      INTEGER FILENUM, TCOUNT;                                 <<*1280>>07119000
      LOGICAL CONTROL;                                         <<*1280>>07119100
      ARRAY TARGET;                                            <<*1280>>07119200
      OPTION PRIVILEGED, EXTERNAL;                             <<*1280>>07119300
                                                               <<*1280>>07119400
$PAGE "MPE-V File System - Utility procedures - LUN "          <<09792>>07124285
                                                               <<01233>>07231000
                                                               <<01233>>07236000
   INTEGER POINTER MVTAB;  << Mounted Volume Table Pointer >>  <<01233>>07241000
   INTEGER VOL'INDEX;      << offset into MVTAB >>             <<01233>>07242000
   BEGIN  <<get ldev from mvtab using local vtabinx >>         <<01233>>07305000
       TOS := EXCHANGEDB (MVTAB'DST);                          <<01233>>07310000
       @MVTAB := MVTABX * SIZE'OF'MVTAB'ENTRY;                 <<01233>>07311000
       VOL'INDEX := SIZE'OF'MVTAB'VS'HEAD + ((VTABINX - 1) *   <<01233>>07312000
                    SIZE'OF'VOL'ENTRY);                        <<01233>>07313000
       LUN := MVTAB'VOL'LDEV;                                  <<01233>>07315000
             TOS := MVTAB'DST;                                 <<01233>>07835000
             TOS := INTEGER ((BS3-1)*SIZE'OF'VOL'ENTRY) +      <<01233>>07840000
                    (MVTABX*SIZE'OF'MVTAB'ENTRY) +             <<01233>>07841000
                    SIZE'OF'MVTAB'VS'HEAD;                     <<01233>>07842000
      ASSEMBLE(DEL);  << get rid of q-rel address on stack >>  <<n1296>>14015000
      GET'USER'CB'ENTRY := FALSE;                              <<n1296>>14020000
$EDIT VOID=16340000                                                     16295000
                                                                        16510100
$  IF X0 = ON                                                           16510200
   IF MONOTHER THEN  <<MONITORING?>>                                    16510300
      BEGIN                                                             16510400
      TOS := "SE"; TOS := "TA"; TOS := "CB";                            16510500
      ASSEMBLE(ZERO,DZRO; DZRO);                                        16510600
      FTITLE(*,*,*,*);                                                  16510700
      DEBUG                                                             16510800
      END;                                                              16510900
$  IF                                                                   16511000
                 <<0010>> DISCSIZE:=30D*77D;   <<HP 1-SIDED>>  << 2225>>19705000
                 <<0110>> DISCSIZE:=60D*77D;   <<HP 2-SIDED>>  << 2225>>19725000
      FLIM:=DBL(EXTSIZE/SPB)*DBL(NUMEXTS*BF)                   <<T9345>>20490000
          - DBL(((SECTOFF + SPB - 1)/SPB) * log(BF));          <<T9345>>20492500
<< Make sure User Labels are taken into account when calc   >> <<T9345>>20492750
<< FLIM.  (SECTOFF points past all labels)                  >> <<T9345>>20493000
   FCBSUBTYPE := LPDT(FCBLDEV*LPDTENTRY+1).FULL'SUBTYPE;       <<09517>>20930000
$EDIT VOID=23325000                                            <<09792>>23325000
$EDIT VOID=24075000                                            <<09792>>23335000
$PAGE "MPE-V BASELINE FILE SYSTEM - INTRINSIC FPARSE"          <<09792>>23335250
PROCEDURE FPARSE (FD'STRING,           << Input >>             <<09792>>23335500
                  RESULT,              << Output >>            <<09792>>23335750
                  ITEMS,               << Input >>             <<09792>>23336000
                  USERS'VECTORS);      << Output >>            <<09792>>23336250
BYTE ARRAY                                                     <<09792>>23336500
   FD'STRING;                                                  <<09792>>23336750
INTEGER ARRAY                                                  <<09792>>23337000
   ITEMS,                                                      <<09792>>23337250
   RESULT;                                                     <<09792>>23337500
DOUBLE ARRAY                                                   <<09792>>23337750
   USERS'VECTORS;                                              <<09792>>23338000
OPTION                                                         <<09792>>23338250
   PRIVILEGED, VARIABLE;                                       <<09792>>23338500
                                                               <<09792>>23338750
COMMENT                                                        <<09792>>23339000
***************************************************************<<09792>>23339250
*                                                             *<<09792>>23339500
*                   FUNCTION OF PROCEDURE                     *<<09792>>23339750
*                                                             *<<09792>>23340000
* To parse and validate file designators. With the inception  *<<09792>>23340250
* of this intrinsic it is hoped that, eventually, all of the  *<<09792>>23340500
* file designator parsing and validation will done by this    *<<09792>>23340750
* single procedure.                                           *<<09792>>23341000
*                                                             *<<09792>>23341250
***************************************************************<<09792>>23341500
*                                                             *<<09792>>23341750
*                         ALGORITHM                           *<<09792>>23342000
*                                                             *<<09792>>23342250
* if backref the increment pointer                            *<<09792>>23342500
* if system file process separately                           *<<09792>>23342750
* process file, lockword, group and account names             *<<09792>>23343000
* if ":" is present then call ADS procedure to validate envid *<<09792>>23343250
* it user specified vector array, fill it                     *<<09792>>23343500
*                                                             *<<09792>>23343750
***************************************************************<<09792>>23344000
*                                                             *<<09792>>23344250
*                         PARAMETERS                          *<<09792>>23344500
*                                                             *<<09792>>23344750
* fd'string          : string to be parsed                    *<<09792>>23345000
* result             : = (no err), > ("*" or "$"), < (err #)  *<<09792>>23345250
* items              : specifies items of file designator     *<<09792>>23345500
* vectors            : offset & length of corresponding items *<<09792>>23345750
*                                                             *<<09792>>23346000
***************************************************************<<09792>>23346250
*                                                             *<<09792>>23346500
* GLOBAL DEFINITIONS:                                         *<<09792>>23346750
*                                                             *<<09792>>23347000
* CALLED BY:                                                  *<<09792>>23347250
*                                                             *<<09792>>23347500
* CALLS TO: file system bounds checking procedures            *<<09792>>23347750
*                                                             *<<09792>>23348000
***************************************************************<<09792>>23348250
*                                                             *<<09792>>23348500
*                     NOTES AND CAUTIONS                      *<<09792>>23348750
*                                                             *<<09792>>23349000
* DB SETTING:  ENTRY = Stack            EXIT = Stack          *<<09792>>23349250
* RESOURCES: none                                             *<<09792>>23349500
* CONDITION CODES: Not used                                   *<<09792>>23349750
*                                                             *<<09792>>23350000
***************************************************************<<09792>>23350250
*                                                             *<<09792>>23350500
* CREATOR OF MODULE:  Application Servies of Advance DS       *<<09792>>23350750
*                                                             *<<09792>>23351000
* MODIFICATION HISTORY:                                       *<<09792>>23351250
*  Date    SR #    Fix #   Name           Summary             *<<09792>>23351500
* ------ -------- ------ -------- --------------------------- *<<09792>>23351750
* 8/7/85                 J.S.Hahn Fixes System designator     *<<*1355>>23351751
*                                 parsing.                    *<<*1355>>23351752
*                                                             *<<09792>>23352000
***************************************************************<<09792>>23352250
END OF COMMENT;                                                <<09792>>23352500
                                                               <<09792>>23352750
BEGIN              << of intrinsic FPARSE                    >><<09792>>23353000
<< --------------------------------------------------------- >><<09792>>23353250
<< A fully qualified formal designator may be:               >><<09792>>23353500
<<                                                           >><<09792>>23353750
<< *FILE[/LOCK][.GROUP[.ACCT]][:NODE[.DOMAIN[.ORGANIZATION]]]>><<09792>>23354000
<< 1+8+  1+8+   1+8+   1+ 8+   1+16+ 1+ 16 + 1+ 16     +1=88 >><<09792>>23354250
<<                                                           >><<09792>>23354500
<< The Advance DS envid part is subject to change and FPARSE >><<09792>>23354750
<< does not assume any knowledge of the envid syntax. It lets>><<09792>>23355000
<< the ADS validate the syntax.                              >><<09792>>23355250
<< The string delimiters remain the same as FOPEN.           >><<09792>>23355500
<< --------------------------------------------------------- >><<09792>>23355750
EQUATE                                                         <<09792>>23356000
   CALLSIZE = 5,          << num words of parms below Q-3 >>   <<09792>>23356250
   UBND = -CALLSIZE-4,    << Q-rel upper bnd >>                <<09792>>23356500
   AS'PARSE'ENVID'PLX =30,<< plabel index for as'parse'envid >><<09792>>23356750
                                                               <<09792>>23357000
   MAX'FD'LEN = 88,                                            <<09792>>23357250
   MAX'FILESYS'ID'LEN = 8,                                     <<09792>>23357500
   MAX'ENVID'ID'LEN = 16,                                      <<09792>>23357750
                                                               <<09792>>23358000
   ITEM'VALUE'TERMINATOR = 0,                                  <<09792>>23358250
   MIN'ITEM'VALUE = ITEM'VALUE'TERMINATOR,                     <<09792>>23358500
   ITEM'FILE             = 1,                                  <<09792>>23358750
   ITEM'LOCKWORD         = 2,                                  <<09792>>23359000
   ITEM'GROUP            = 3,                                  <<09792>>23359250
   ITEM'ACCOUNT          = 4,                                  <<09792>>23359500
   ITEM'ENVID            = 5,                                  <<09792>>23359750
   MAX'ITEM'VALUE = ITEM'ENVID,                                <<09792>>23360000
   MAX'NUM'OF'ITEMS = MAX'ITEM'VALUE,                          <<09792>>23360250
                                                               <<09792>>23360500
   DD'STDLIST = 1,                                             <<09792>>23360750
   DD'NEWPASS = 2,                                             <<09792>>23361000
   DD'OLDPASS = 3,                                             <<09792>>23361250
   DD'STDIN   = 4,                                             <<09792>>23361500
   DD'STDINX  = 5,                                             <<09792>>23361750
   DD'NULL    = 6,                                             <<09792>>23362000
                                                               <<09792>>23362250
   RETURN'BACKREF = 1,                                         <<09792>>23362500
   RETURN'SYSFREF = 2,                                         <<09792>>23362750
                                                               <<09792>>23363000
   ERR'NOERR = 0,                                              <<09792>>23363250
   ERR'PARMS = 1,                                              <<09792>>23363500
   ERR'BNDVIOL = 2,                                            <<09792>>23363750
   ERR'ILLCHAR = 3,                                            <<09792>>23364000
   ERR'OPTIONS = 4,                                            <<09792>>23364250
   ERR'ITEMVAL = 5,                                            <<09792>>23364500
   ERR'NUMITEM = 6,                                            <<09792>>23364750
   ERR'UNSYSF  = 7,                                            <<09792>>23365000
   ERR'FDLOCKW = 8,                                            <<09792>>23365250
   ERR'NOADS   = 9,                                            <<09792>>23365500
   ERR'SYNTAX = 101,                                           <<09792>>23365750
   ERR'NOTALPHA = ERR'SYNTAX,                                  <<09792>>23366000
   ERR'IDEXPECTED = ERR'NOTALPHA + 1,                          <<09792>>23366250
   ERR'IDTOOLONG = ERR'IDEXPECTED + 1,                         <<09792>>23366500
   NUM'SYNTAX'ERRS = 3;                                        <<09792>>23366750
                                                               <<09792>>23367000
LOGICAL                                                        <<09792>>23367250
   BACK'REF:=FALSE,                                            <<09792>>23367500
   SYSFILE'REF:=FALSE,                                         <<09792>>23367750
   PMAP = Q-4;                                                 <<09792>>23368000
INTEGER                                                        <<09792>>23368250
   I,                       << scratch >>                      <<09792>>23368500
   ITEMIDX,                                                    <<09792>>23368750
   ITEMNUM,                                                    <<09792>>23369000
   FDIDX:=0;                                                   <<09792>>23369250
POINTER                                                        <<09792>>23369500
   LUSERS'VECTORS = USERS'VECTORS;                             <<09792>>23369750
BYTE POINTER                                                   <<09792>>23370000
   BPTR;                    << utility byte pointer >>         <<09792>>23370250
DOUBLE ARRAY                                                   <<09792>>23370500
   DQVECTORS (0:MAX'NUM'OF'ITEMS);                             <<09792>>23370750
ARRAY                                                          <<09792>>23371000
   LITEMS (*) = ITEMS,                                         <<09792>>23371250
   QVECTORS (*) = DQVECTORS;                                   <<09792>>23371500
INTEGER ARRAY                                                  <<09792>>23371750
   IQVECTORS (*) = QVECTORS;                                   <<09792>>23372000
BYTE ARRAY                                                     <<*1355>>23372100
   TEMP'BUF (0:9);                                             <<*1355>>23372200
DEFINE                                                         <<09792>>23372250
   << -------------------------- >>                            <<09792>>23372500
   << parameter mask definitions >>                            <<09792>>23372750
   << -------------------------- >>                            <<09792>>23373000
   PMAP'VECTORS = PMAP.(15:1) #,                               <<09792>>23373250
   PMAP'ITEMS   = PMAP.(14:1) #,                               <<09792>>23373500
   PMAP'RESULT  = PMAP.(13:1) #,                               <<09792>>23373750
   PMAP'FD'STRING = PMAP.(12:1) #,                             <<09792>>23374000
   OPTIONS'ERR = PMAP'VECTORS + PMAP'ITEMS #,                  <<09792>>23374250
   << ------------------------ >>                              <<09792>>23374500
   << Vector array definitions >>                              <<09792>>23374750
   << ------------------------ >>                              <<09792>>23375000
   DEFDESIG'VECTOR = IQVECTORS(0) #,                           <<09792>>23375250
   INDEX'VECTOR = IQVECTORS(ITEMNUM*2) #,                      <<09792>>23375500
   LENGTH'VECTOR = IQVECTORS(ITEMNUM*2+1) #,                   <<09792>>23375750
   << ------------------ >>                                    <<09792>>23376000
   << result definitions >>                                    <<09792>>23376250
   << ------------------ >>                                    <<09792>>23376500
   RESULT'ERR = RESULT(0) #,                                   <<09792>>23376750
   RESULT'SUBSYS = RESULT(1) #;                                <<09792>>23377000
$page                                                          <<09792>>23377250
SUBROUTINE EXIT (ERROR'NUM);                                   <<09792>>23377500
VALUE ERROR'NUM;                                               <<09792>>23377750
INTEGER ERROR'NUM;                                             <<09792>>23378000
BEGIN           << of subroutine EXIT                        >><<09792>>23378250
   IF ERROR'NUM <> ERR'NOERR THEN                              <<09792>>23378500
   BEGIN           << if an error occurred >>                  <<09792>>23378750
      IF PMAP'VECTORS THEN                                     <<f1544>>23378990
      BEGIN           << if vector parm was provided >>        <<f1544>>23378991
         LUSERS'VECTORS(0) := FDIDX;   << error location >>    <<f1544>>23379000
         LUSERS'VECTORS(1) := 0;                               <<f1544>>23379250
      END;            << if vector parm was provided >>        <<f1544>>23379300
      IF ERROR'NUM >= ERR'SYNTAX THEN                          <<09792>>23379500
         RESULT'ERR := ERROR'NUM + (ITEMNUM-1)*NUM'SYNTAX'ERRS <<09792>>23379750
      ELSE                                                     <<09792>>23380000
         RESULT'ERR := ERROR'NUM;                              <<09792>>23380250
      <<--- Return a Negative Error Number --->>               <<09792>>23380500
      RESULT'ERR := -RESULT'ERR;                               <<09792>>23380750
   END             << if an error occurred >>                  <<09792>>23381000
   ELSE BEGIN      << else valid designator >>                 <<09792>>23381250
      IF BACK'REF THEN                                         <<09792>>23381500
         RESULT'ERR := RETURN'BACKREF                          <<09792>>23381750
      ELSE IF SYSFILE'REF THEN                                 <<09792>>23382000
         RESULT'ERR := RETURN'SYSFREF                          <<09792>>23382250
      ELSE            << else vanilla designator >>            <<09792>>23382500
         RESULT'ERR := ERR'NOERR;                              <<09792>>23382750
   END;            << else valid designator >>                 <<09792>>23383000
   ERROREXIT (CALLSIZE, ERROR'NUM, 0);                         <<09792>>23383250
END;            << of subroutine EXIT                        >><<09792>>23383500
$PAGE                                                          <<09792>>23383750
SUBROUTINE CHECKPARMS;                                         <<09792>>23384000
                                                               <<09792>>23384250
COMMENT                                                        <<09792>>23384500
   -----------------                                           <<09792>>23384750
   If either FD'STRING or RESULT parms are not specified then  <<f1544>>23384760
   just get out procedure.                                     <<f1544>>23384770
   Will bounds check all the address parms and                 <<09792>>23385000
   range check all the item values.                            <<09792>>23385250
   -----------------                                           <<09792>>23385500
END OF COMMENT;                                                <<09792>>23385750
                                                               <<09792>>23386000
BEGIN                 << of subroutine CHECKPARMS            >><<09792>>23386250
   IF NOT PMAP'FD'STRING OR NOT PMAP'RESULT THEN               <<f1544>>23386300
      ERROREXIT (CALLSIZE, 0, 0);                              <<f1544>>23386310
   I := 0;                                                     <<09792>>23386500
   IF PMAP'ITEMS THEN                                          <<09792>>23386750
      WHILE ITEMS(I) <> ITEM'VALUE'TERMINATOR DO               <<09792>>23387000
      BEGIN                 << of while checking item values >><<09792>>23387250
         IF NOT (MIN'ITEM'VALUE <= ITEMS(I) <=                 <<09792>>23387500
                 MAX'ITEM'VALUE) THEN                          <<09792>>23387750
            EXIT (ERR'ITEMVAL);                                <<09792>>23388000
         IF (I:=I+1) > MAX'NUM'OF'ITEMS THEN                   <<09792>>23388250
            EXIT (ERR'NUMITEM);                                <<09792>>23388500
      END;                  << of while checking item values >><<09792>>23388750
                                                               <<09792>>23389000
   IF NOT FBNDCHK (@FD'STRING, -2, UBND) THEN                  <<09792>>23389250
      EXIT (ERR'BNDVIOL);                                      <<09792>>23389500
   IF NOT FBNDCHK (@RESULT, 2, UBND) THEN                      <<09792>>23389750
      EXIT (ERR'BNDVIOL);                                      <<09792>>23390000
   IF OPTIONS'ERR THEN                                         <<09792>>23390250
      EXIT (ERR'OPTIONS);                                      <<09792>>23390500
   IF PMAP'ITEMS THEN                                          <<09792>>23390750
      IF NOT FBNDCHK (@ITEMS, I, UBND) THEN                    <<09792>>23391000
         EXIT (ERR'BNDVIOL);                                   <<09792>>23391250
   IF PMAP'VECTORS THEN                                        <<09792>>23391500
      IF NOT FBNDCHK (@USERS'VECTORS, -I*4, UBND) THEN         <<09792>>23391750
         EXIT (ERR'BNDVIOL)                                    <<09792>>23392000
END;                  << of subroutine CHECKPARMS            >><<09792>>23392250
$PAGE                                                          <<09792>>23392500
INTEGER SUBROUTINE GETIDLENGTH (IDX);                          <<09792>>23392750
VALUE IDX;                                                     <<09792>>23393000
INTEGER IDX;                                                   <<09792>>23393250
                                                               <<09792>>23393500
COMMENT                                                        <<09792>>23393750
   -----------------                                           <<09792>>23394000
   Will start at fd'string (idx) and find the length of this   <<09792>>23394250
   alpha numeric identifier.                                   <<09792>>23394500
   Remember that we have to be careful when we mess around with<<09792>>23394750
   TOS and S-relative variables.                               <<09792>>23395000
   -----------------                                           <<09792>>23395250
END OF COMMENT;                                                <<09792>>23395500
                                                               <<09792>>23395750
BEGIN                 << of subroutine GETIDLENGTH           >><<09792>>23396000
   IF FD'STRING(IDX) = ALPHA THEN                              <<09792>>23396250
   BEGIN                                                       <<09792>>23396500
      MOVE FD'STRING(IDX) := FD'STRING(IDX) WHILE AN,1;        <<09792>>23396750
      I := TOS;   << now S is back to normal >>                <<09792>>23397000
      GETIDLENGTH := I - @FD'STRING(IDX);                      <<09792>>23397250
   END                                                         <<09792>>23397500
   ELSE IF FD'STRING(IDX) = NUMERIC THEN                       <<09792>>23397750
      EXIT (ERR'NOTALPHA);                                     <<09792>>23398000
END;                  << of subroutine GETIDLENGTH           >><<09792>>23398250
INTEGER SUBROUTINE GETENVIDLENGTH (IDX);                       <<09792>>23398500
VALUE IDX;                                                     <<09792>>23398750
INTEGER IDX;                                                   <<09792>>23399000
BEGIN                 << of subroutine GETIDLENGTH           >><<09792>>23399250
   X := IDX;          << idx is S-rel so use index reg. >>     <<09792>>23399500
   TOS := 0;          << return value >>                       <<09792>>23399750
   TOS := @FD'STRING(X);                                       <<09792>>23400000
   TOS := AS'DSPLABEL (AS'PARSE'ENVID'PLX);                    <<09792>>23400250
   IF S0 = 0 THEN        << 0 plabel => ADS not installed >>   <<09792>>23400500
      EXIT (ERR'NOADS);                                        <<09792>>23400750
   ASSEMBLE (PCAL 0);                                          <<09792>>23401000
                                                               <<09792>>23401250
   IF < THEN          << return value on TOS has error code  >><<09792>>23401500
      EXIT (*);                                                <<09792>>23401750
   X := TOS;          << again, we can't realy use S-rel addr>><<09792>>23402000
   GETENVIDLENGTH := X;  << STACK IS BACK TO NORMAL >>         <<09792>>23402250
END;                  << OF SUBROUTINE GETIDLENGTH           >><<09792>>23402500
SUBROUTINE ENDORERROR (MAXIDLEN);                              <<09792>>23402750
VALUE MAXIDLEN;                                                <<09792>>23403000
INTEGER MAXIDLEN;                                              <<09792>>23403250
                                                               <<09792>>23403500
COMMENT                                                        <<09792>>23403750
   -----------------                                           <<09792>>23404000
   check for end of string or syntax errors                    <<09792>>23404250
   -----------------                                           <<09792>>23404500
END OF COMMENT;                                                <<09792>>23404750
                                                               <<09792>>23405000
BEGIN                 << of subroutine ENDORERROR            >><<09792>>23405250
   IF LENGTH'VECTOR = 0 THEN                                   <<09792>>23405500
   BEGIN                 << IF NULL IDENTIFIER >>              <<09792>>23405750
      IF ITEMNUM = ITEM'LOCKWORD THEN                          <<09792>>23406000
         RETURN;                                               <<09792>>23406250
      EXIT (ERR'IDEXPECTED);                                   <<09792>>23406500
   END;                  << IF NULL IDENTIFIER >>              <<09792>>23406750
   IF LENGTH'VECTOR > MAXIDLEN THEN                            <<09792>>23407000
      EXIT (ERR'IDTOOLONG);                                    <<09792>>23407250
                                                               <<09792>>23407500
   <<--- check for illegal delimiters --->>                    <<09792>>23407750
   IF FD'STRING(FDIDX+LENGTH'VECTOR) = "."  THEN               <<09792>>23408000
      IF ITEMNUM = ITEM'ACCOUNT THEN                           <<09792>>23408250
      BEGIN                                                    <<09792>>23408500
         FDIDX := FDIDX+LENGTH'VECTOR;                         <<09792>>23408750
         EXIT (ERR'ILLCHAR);                                   <<09792>>23409000
      END;                                                     <<09792>>23409250
   IF FD'STRING(FDIDX+LENGTH'VECTOR) = ":"                     <<09792>>23409500
      AND ITEMNUM > ITEM'ACCOUNT THEN                          <<09792>>23409750
   BEGIN                                                       <<09792>>23410000
      FDIDX := FDIDX + LENGTH'VECTOR;                          <<09792>>23410250
      EXIT (ERR'ILLCHAR);                                      <<09792>>23410500
   END;                                                        <<09792>>23410750
   IF FD'STRING(FDIDX+LENGTH'VECTOR) = "/"                     <<09792>>23411000
      AND ITEMNUM <> ITEM'FILE THEN                            <<09792>>23411250
   BEGIN                                                       <<09792>>23411500
      FDIDX := FDIDX + LENGTH'VECTOR;                          <<09792>>23411750
      EXIT (ERR'ILLCHAR);                                      <<09792>>23412000
   END;                                                        <<09792>>23412250
END;                  << of subroutine ENDORERROR            >><<09792>>23412500
$PAGE                                                          <<09792>>23412750
SUBROUTINE processsysfiles;                                    <<09792>>23413000
                                                               <<09792>>23413250
COMMENT                                                        <<09792>>23413500
   -----------------                                           <<09792>>23413750
   Handles special processing required for sysfiles.           <<09792>>23414000
   We will just handle the file name and ignore the rest.      <<09792>>23414250
   NOTE: It is important that compare of STDINX take place     <<09792>>23414500
   before STDIN, and as a general rule the longest string      <<09792>>23414750
   compare should be done earliest.                            <<09792>>23415000
   -----------------                                           <<09792>>23415250
END OF COMMENT;                                                <<09792>>23415500
                                                               <<09792>>23415750
BEGIN                 << of subroutine PROCESSSYSFILES       >><<09792>>23416000
   ITEMNUM := ITEM'FILE;                                       <<09792>>23416250
   MOVE TEMP'BUF := FD'STRING(FDIDX+1),(MAX'FILESYS'ID'LEN+1); <<*1355>>23416300
   MOVE TEMP'BUF := TEMP'BUF WHILE AS,1;                       <<*1355>>23416500
   @BPTR := TOS;                                               <<09792>>23416750
   IF BPTR = NUMERIC THEN                                      <<09792>>23417000
      EXIT (ERR'UNSYSF);                                       <<09792>>23417250
   IF BPTR = ":" THEN                                          <<*1355>>23417260
   BEGIN                                                       <<*1355>>23417270
      FDIDX := FDIDX+1+(@BPTR - @TEMP'BUF);                    <<*1355>>23417280
      EXIT (ERR'ILLCHAR);                                      <<*1355>>23417290
   END;                                                        <<*1355>>23417300
                                                               <<09792>>23417500
   << When calculating the length we must include "$" since >> <<*1355>>23417510
   << it is part of the name.                               >> <<*1355>>23417520
   IF TEMP'BUF = "STDLIST" THEN                                <<*1355>>23417750
   BEGIN                                                       <<*1355>>23417760
      DEFDESIG'VECTOR := DD'STDLIST;                           <<*1355>>23418000
      LENGTH'VECTOR := 8;                                      <<*1355>>23418100
   END                                                         <<*1355>>23418200
   ELSE IF TEMP'BUF = "NEWPASS" THEN                           <<*1355>>23418250
   BEGIN                                                       <<*1355>>23418260
      DEFDESIG'VECTOR :=  DD'NEWPASS;                          <<*1355>>23418500
      LENGTH'VECTOR := 8;                                      <<*1355>>23418510
   END                                                         <<*1355>>23418520
   ELSE IF TEMP'BUF = "OLDPASS" THEN                           <<*1355>>23418750
   BEGIN                                                       <<*1355>>23418760
      DEFDESIG'VECTOR :=  DD'OLDPASS;                          <<*1355>>23419000
      LENGTH'VECTOR := 8;                                      <<*1355>>23419100
   END                                                         <<*1355>>23419200
   ELSE IF TEMP'BUF = "STDINX" THEN                            <<*1355>>23419250
   BEGIN                                                       <<*1355>>23419350
      DEFDESIG'VECTOR :=  DD'STDINX;                           <<*1355>>23419500
      LENGTH'VECTOR := 7;                                      <<*1355>>23419600
   END                                                         <<*1355>>23419700
   ELSE IF TEMP'BUF = "STDIN" THEN                             <<*1355>>23419750
   BEGIN                                                       <<*1355>>23419850
      DEFDESIG'VECTOR :=  DD'STDIN;                            <<*1355>>23420000
      LENGTH'VECTOR := 6;                                      <<*1355>>23420100
   END                                                         <<*1355>>23420200
   ELSE IF TEMP'BUF = "NULL" THEN                              <<*1355>>23420250
   BEGIN                                                       <<*1355>>23420350
      DEFDESIG'VECTOR :=  DD'NULL;                             <<*1355>>23420500
      LENGTH'VECTOR := 5;                                      <<*1355>>23420600
   END                                                         <<*1355>>23420700
   ELSE                  << Undefined system file >>           <<09792>>23420750
      EXIT (ERR'UNSYSF);                                       <<09792>>23421000
                                                               <<09792>>23421250
   INDEX'VECTOR := FDIDX;                                      <<09792>>23421500
   IF LENGTH'VECTOR <> (@BPTR-@TEMP'BUF+1) THEN                <<*1355>>23421750
      EXIT (ERR'UNSYSF);                                       <<*1355>>23421850
   <<--- increment index to after the name --->>               <<09792>>23422000
   FDIDX := FDIDX + LENGTH'VECTOR;                             <<09792>>23422250
END;                  << of subroutine PROCESSSYSFILES       >><<09792>>23422500
$PAGE                                                          <<09792>>23422750
SUBROUTINE INITIALIZE;                                         <<09792>>23423000
                                                               <<09792>>23423250
COMMENT                                                        <<09792>>23423500
   -----------------                                           <<09792>>23423750
   Initialize local variable(s), skip blanks                   <<09792>>23424000
   -----------------                                           <<09792>>23424250
END OF COMMENT;                                                <<09792>>23424500
                                                               <<09792>>23424750
BEGIN                 << of subroutine INITIALIZE            >><<09792>>23425000
   QVECTORS(0) := 0;   << clear local vector array >>          <<09792>>23425250
   MOVE QVECTORS(1) := QVECTORS(0), (MAX'NUM'OF'ITEMS*2+1);    <<09792>>23425500
   RESULT'ERR := 0;                                            <<09792>>23425750
   RESULT'SUBSYS := 0;                                         <<09792>>23426000
$EDIT VOID=23428500                                            <<01728>>23426250
END;                  << of subroutine INITIALIZE            >><<09792>>23428750
$PAGE                                                          <<09792>>23429000
SUBROUTINE GIVE'ITEMS'TO'USER;                                 <<09792>>23429250
                                                               <<09792>>23429500
COMMENT                                                        <<09792>>23429750
   -----------------                                           <<09792>>23430000
   Give all items requested by user.                           <<09792>>23430250
   In the case where items array wasn't specified, we give all,<<09792>>23430500
   starting with item 1 at user's vector(0) and end with item 0<<09792>>23430750
   at user's vector(MAX'NUM'OF'ITEMS).                         <<09792>>23431000
   -----------------                                           <<09792>>23431250
END OF COMMENT;                                                <<09792>>23431500
                                                               <<09792>>23431750
BEGIN                 << of subroutine GIVE'ITEMS'TO'USER   >> <<09792>>23432000
   ITEMIDX := 0;                                               <<09792>>23432250
   WHILE ITEMS(ITEMIDX) <> ITEM'VALUE'TERMINATOR DO            <<09792>>23432500
   BEGIN                 << while processing items do >>       <<09792>>23432750
      USERS'VECTORS(ITEMIDX) := DQVECTORS(ITEMS(ITEMIDX));     <<09792>>23433000
      ITEMIDX := ITEMIDX + 1;                                  <<09792>>23433250
   END;                  << while processing items do >>       <<09792>>23433500
   <<--- for item 0, set the length of FD string and --->>     <<09792>>23433750
   <<--- possible the def designator                 --->>     <<09792>>23434000
   LUSERS'VECTORS(ITEMIDX*2+1) := FDIDX-IQVECTORS(ITEM'FILE*2);<<09792>>23434250
   LUSERS'VECTORS(ITEMIDX*2) := DEFDESIG'VECTOR;               <<09792>>23434500
END;              << of subroutine GIVE'ITEMS'TO'USER   >>     <<09792>>23434750
$PAGE                                                          <<09792>>23435000
<< ---------------------------------------------------- >>     <<09792>>23435250
<<                    procedure body                    >>     <<09792>>23435500
<< ---------------------------------------------------- >>     <<09792>>23435750
   ERRORON;                                                    <<09792>>23436000
   CHECKPARMS;                                                 <<09792>>23436250
   INITIALIZE;                                                 <<09792>>23436500
                                                               <<09792>>23436750
   IF FD'STRING(FDIDX) = "*" THEN                              <<09792>>23437000
   BEGIN                                                       <<09792>>23437250
      BACK'REF := TRUE;                                        <<09792>>23437500
      FDIDX := FDIDX + 1;                                      <<09792>>23437750
   END                                                         <<09792>>23438000
   ELSE IF FD'STRING(FDIDX) = "$" THEN                         <<09792>>23438250
   BEGIN                                                       <<09792>>23438500
      SYSFILE'REF := TRUE;                                     <<09792>>23438750
$EDIT VOID=23439000                                            <<*1355>>23439000
      PROCESSSYSFILES;                                         <<09792>>23439250
      IF PMAP'VECTORS THEN                                     <<09792>>23439500
         GIVE'ITEMS'TO'USER;                                   <<09792>>23439750
      EXIT (ERR'NOERR);                                        <<09792>>23440000
   END;                                                        <<09792>>23440250
                                                               <<09792>>23440500
   <<--- get file vector --->>                                 <<09792>>23440750
   ITEMNUM := ITEM'FILE;                                       <<09792>>23441000
   LENGTH'VECTOR := GETIDLENGTH (FDIDX);                       <<09792>>23441250
   ENDORERROR (MAX'FILESYS'ID'LEN);                            <<09792>>23441500
   INDEX'VECTOR := FDIDX;                                      <<09792>>23441750
   FDIDX := FDIDX + LENGTH'VECTOR;                             <<09792>>23442000
                                                               <<09792>>23442250
   IF FD'STRING(FDIDX) = "/" THEN                              <<09792>>23442500
   BEGIN              << if lockword is present >>             <<09792>>23442750
      IF BACK'REF THEN                                         <<09792>>23443000
         EXIT (ERR'FDLOCKW);                                   <<09792>>23443250
      ITEMNUM := ITEM'LOCKWORD;                                <<09792>>23443500
      LENGTH'VECTOR := GETIDLENGTH (FDIDX:=FDIDX+1);           <<09792>>23443750
      ENDORERROR (MAX'FILESYS'ID'LEN);                         <<09792>>23444000
      INDEX'VECTOR := FDIDX;                                   <<09792>>23444250
      FDIDX := FDIDX + LENGTH'VECTOR;                          <<09792>>23444500
   END;               << if lockword is present >>             <<09792>>23444750
                                                               <<09792>>23445000
   IF FD'STRING(FDIDX) = "." THEN                              <<09792>>23445250
   BEGIN              << if group is specified >>              <<09792>>23445500
      ITEMNUM := ITEM'GROUP;                                   <<09792>>23445750
      LENGTH'VECTOR := GETIDLENGTH (FDIDX:=FDIDX+1);           <<09792>>23446000
      ENDORERROR (MAX'FILESYS'ID'LEN);                         <<09792>>23446250
      INDEX'VECTOR := FDIDX;                                   <<09792>>23446500
      FDIDX := FDIDX + LENGTH'VECTOR;                          <<09792>>23446750
      IF FD'STRING(FDIDX) = "." THEN                           <<09792>>23447000
      BEGIN              << if account is specified >>         <<09792>>23447250
         ITEMNUM := ITEM'ACCOUNT;                              <<09792>>23447500
         LENGTH'VECTOR := GETIDLENGTH (FDIDX:=FDIDX+1);        <<09792>>23447750
         ENDORERROR (MAX'FILESYS'ID'LEN);                      <<09792>>23448000
         INDEX'VECTOR := FDIDX;                                <<09792>>23448250
         FDIDX := FDIDX + LENGTH'VECTOR;                       <<09792>>23448500
      END;               << if account is specified >>         <<09792>>23448750
   END;               << if group is specified >>              <<09792>>23449000
   IF FD'STRING(FDIDX) = ":" THEN                              <<09792>>23449250
   BEGIN              << if node is specified >>               <<09792>>23449500
      << --------------------------------------------------- >><<09792>>23449750
      << Since we shouldn't have to know about the innards   >><<09792>>23450000
      << of the ADS envid, we will let our good friends in   >><<09792>>23450250
      << Advance DS handle the envid.                        >><<09792>>23450500
      << --------------------------------------------------- >><<09792>>23450750
      ITEMNUM := ITEM'ENVID;                                   <<09792>>23451000
      LENGTH'VECTOR := GETENVIDLENGTH (FDIDX:=FDIDX+1);        <<09792>>23451250
      INDEX'VECTOR := FDIDX;                                   <<09792>>23451500
      FDIDX := FDIDX + LENGTH'VECTOR;                          <<09792>>23451750
   END;               << if node is specified >>               <<09792>>23452000
   << ------------------------------------------------------ >><<09792>>23452250
   << Now that we have fully parsed the FD string we should  >><<09792>>23452500
   << find out what the user wants and let the user have it. >><<09792>>23452750
   << Also, set the result parameter.                        >><<09792>>23453000
   << ------------------------------------------------------ >><<09792>>23453250
   IF PMAP'VECTORS THEN                                        <<09792>>23453500
      GIVE'ITEMS'TO'USER;                                      <<09792>>23453750
   EXIT (ERR'NOERR);                                           <<09792>>23454000
END;               << of intrinsic FPARSE                    >><<09792>>23454250
$PAGE "MPE-V BASELINE FILE SYSTEM - FNFORMAT   "               <<09792>>23454500
LOGICAL PROCEDURE FNFORMAT (STRING,F,G,A,L,E);                 <<09792>>23454750
                                                               <<09792>>23454775
COMMENT                                                        <<09792>>23454800
   Parses the specified file reference string into simple file <<09792>>23455000
   names and places these names into the specified byte arrays.<<09792>>23455250
                                                               <<09792>>23455500
     input variables:                                          <<09792>>23455750
         string - file reference string                        <<09792>>23456000
                                                               <<09792>>23456250
     output variables:                                         <<09792>>23456500
         fnformat - file reference format type                 <<09792>>23456750
            0 - FULL NAME                                      <<09792>>23457000
            1 - ACCOUNT NAME ABSENT                            <<09792>>23457250
            2 - GROUP AND ACCOUNT NAMES ABSENT                 <<09792>>23457500
            3 - NULL NAME                                      <<09792>>23457750
            4 - INVALID NAME                                   <<09792>>23458000
         F  - LOCAL FILE NAME                                  <<09792>>23458250
         G  - GROUP NAME                                       <<09792>>23458500
         A  - ACCOUNT NAME                                     <<09792>>23458750
         L  - LOCKWORD                                         <<09792>>23459000
         E  - ADS ENVID POINTER                                <<09792>>23459250
                                                               <<09792>>23459500
   The resulting simple file names are 8 bytes long, left      <<09792>>23459750
   justified, upshifted and have trailing blanks added.        <<09792>>23460000
   If a simple file name is not in the file reference the      <<09792>>23460250
   corresponding byte array will be blank. For the ADS         <<09792>>23460500
   ENVID pointer, if it is in the file reference then there    <<09792>>23460750
   will be a non-zero address in  the pointer cell other-      <<09792>>23461000
   wise it will be zero.                                       <<09792>>23461250
END OF COMMENT;                                                <<09792>>23461275
                                                               <<09792>>23461300
                                                               <<09792>>23461500
VALUE STRING;                                                  <<09792>>23461750
BYTE POINTER STRING;                                           <<09792>>23462000
INTEGER ARRAY F,G,A,L;                                         <<09792>>23462250
BYTE POINTER E;                                                <<09792>>23462500
OPTION PRIVILEGED,UNCALLABLE;                                  <<09792>>23462750
BEGIN       << of procedure FNFORMAT >>                        <<09792>>23463000
BYTE POINTER FN,GN,AN,LW;                                      <<09792>>23463250
DOUBLE                                                         <<09792>>23463500
   RESULT;                                                     <<09792>>23463750
INTEGER                                                        <<09792>>23464000
   RESULT'ERR = RESULT,                                        <<09792>>23464250
   RESULT'SUBSYS = RESULT + 1,                                 <<09792>>23464500
   ITEMNUM,                                                    <<09792>>23464750
   ITEMINDEX;                                                  <<09792>>23465000
EQUATE                                                         <<09792>>23465250
   RETURN'FULLNAME   = 0,                                      <<09792>>23465500
   RETURN'ACCNTABSENT = 1,                                     <<09792>>23465750
   RETURN'GROUPABSENT = 2,                                     <<09792>>23466000
   RETURN'NULLNAME = 3,                                        <<09792>>23466250
   RETURN'INVALID = 4,                                         <<09792>>23466500
                                                               <<09792>>23466750
   ERR'FNEXPECTED = -102,                                      <<09792>>23467000
                                                               <<09792>>23467250
   ITEM'END   = 0,                                             <<09792>>23467500
   ITEM'FNAME = 1,                                             <<09792>>23467750
   ITEM'LNAME = 2,                                             <<09792>>23468000
   ITEM'GNAME = 3,                                             <<09792>>23468250
   ITEM'ANAME = 4,                                             <<09792>>23468500
   ITEM'ENAME = 5,                                             <<09792>>23468750
   ITEM'MAX   = ITEM'ENAME;                                    <<09792>>23469000
DOUBLE ARRAY                                                   <<09792>>23469250
   VECTOR(0:ITEM'MAX);      << max num of items + 1 >>         <<09792>>23469500
INTEGER ARRAY                                                  <<09792>>23469750
   IVECTORS(*) = VECTOR,                                       <<09792>>23470000
   ITEMS'ARRAY(0:ITEM'MAX); << max num of items + 1 >>         <<09792>>23470250
BYTE ARRAY                                                     <<09792>>23470500
   BLANX(*) = PB := "        ";                                <<09792>>23470750
                                                               <<09792>>23471000
DEFINE                                                         <<09792>>23471250
   NAME'VECTOR = IVECTORS(ITEMINDEX*2) #,                      <<09792>>23471500
   LEN'VECTOR = IVECTORS(ITEMINDEX*2+1) #,                     <<09792>>23471750
                                                               <<09792>>23472000
   ADVDS'ENVID'NAME = ADVDS'ENVID(0) #,                        <<09792>>23472250
   ADVDS'ENVID'LENGTH = ADVDS'ENVID(1) #;                      <<09792>>23472500
                                                               <<09792>>23472750
   <<--- PROCEDURE BODY --->>                                  <<09792>>23473000
                                                               <<09792>>23473250
   @FN := @F&LSL(1);                                           <<09792>>23473500
   @GN := @G&LSL(1);                                           <<09792>>23473750
   @AN := @A&LSL(1);                                           <<09792>>23474000
   @LW := @L&LSL(1);                                           <<09792>>23474250
                                                               <<09792>>23474500
   <<--- Fill in Default Values --->>                          <<09792>>23474750
   MOVE FN := BLANX,(8);                                       <<09792>>23475000
   MOVE GN := BLANX,(8);                                       <<09792>>23475250
   MOVE AN := BLANX,(8);                                       <<09792>>23475500
   @E := 0;                                                    <<09792>>23475750
                                                               <<09792>>23476000
   <<--- fill up items array to request for all items --->>    <<09792>>23476250
   ITEMS'ARRAY(0) := ITEM'FNAME;                               <<09792>>23476500
   ITEMS'ARRAY(1) := ITEM'LNAME;                               <<09792>>23476750
   ITEMS'ARRAY(2) := ITEM'GNAME;                               <<09792>>23477000
   ITEMS'ARRAY(3) := ITEM'ANAME;                               <<09792>>23477250
   ITEMS'ARRAY(4) := ITEM'ENAME;                               <<09792>>23477500
   ITEMS'ARRAY(5) := ITEM'END;                                 <<09792>>23477750
                                                               <<09792>>23478000
   FPARSE (STRING, RESULT, ITEMS'ARRAY, VECTOR);               <<09792>>23478250
   IF RESULT'ERR = 0 THEN                                      <<09792>>23478500
   BEGIN           << if string successfully parsed >>         <<09792>>23478750
      ITEMINDEX := 0;                                          <<09792>>23479000
      MOVE FN := STRING(NAME'VECTOR) WHILE ANS;                <<09792>>23479250
      ITEMINDEX := 1;                                          <<09792>>23479500
      IF LEN'VECTOR <> 0 THEN                                  <<09792>>23479750
         MOVE LW := STRING(NAME'VECTOR) WHILE ANS              <<09792>>23480000
      ELSE IF STRING(NAME'VECTOR-1) = "/" THEN                 <<09792>>23480250
         MOVE LW := "/ ";  << Null lock word >>                <<09792>>23480500
      ITEMINDEX := 2;                                          <<09792>>23480750
      IF LEN'VECTOR <> 0 THEN                                  <<09792>>23481000
      BEGIN           << if gname present >>                   <<09792>>23481250
         MOVE GN := STRING(NAME'VECTOR) WHILE ANS;             <<09792>>23481500
         ITEMINDEX := 3;                                       <<09792>>23481750
         IF LEN'VECTOR <> 0 THEN                               <<09792>>23482000
         BEGIN           << if aname present >>                <<09792>>23482250
            MOVE AN := STRING(NAME'VECTOR) WHILE ANS;          <<09792>>23482500
            FNFORMAT := RETURN'FULLNAME;                       <<09792>>23482750
         END             << if aname present >>                <<09792>>23483000
         ELSE                                                  <<09792>>23483250
            FNFORMAT := RETURN'ACCNTABSENT;                    <<09792>>23483500
      END             << if gname present >>                   <<09792>>23483750
      ELSE                                                     <<09792>>23484000
         FNFORMAT := RETURN'GROUPABSENT;                       <<09792>>23484250
      <<--- return AdvanceDS envid pointer --->>               <<09792>>23484500
      ITEMINDEX := 4;                                          <<09792>>23484750
      IF LEN'VECTOR <> 0 THEN                                  <<09792>>23485000
      BEGIN                                                    <<09792>>23485250
         @E := @STRING(NAME'VECTOR);                           <<09792>>23485500
         TOS := @E;TOS := @E;                                  <<09792>>23485750
         WHILE (S0-@E) < LEN'VECTOR DO                         <<09792>>23486000
         BEGIN                                                 <<09792>>23486010
            MOVE * := * WHILE ANS,0; <<keep the ptr at A&B >>  <<09792>>23486100
            S1 := S1 + 1;                                      <<09792>>23486200
            S0 := S0 + 1;                                      <<09792>>23486210
         END;                                                  <<09792>>23486220
         DDEL;                                                 <<09792>>23486230
      END;                                                     <<09792>>23486250
   END             << if string successfully parsed >>         <<09792>>23486500
   ELSE IF RESULT'ERR > 0 THEN                                 <<09792>>23486750
      FNFORMAT := RETURN'NULLNAME                              <<09792>>23487000
   ELSE IF RESULT'ERR < 0 THEN                                 <<09792>>23487250
   BEGIN           << else error occurred >>                   <<09792>>23487500
      IF RESULT'ERR =  ERR'FNEXPECTED THEN                     <<09792>>23487750
         FNFORMAT := RETURN'NULLNAME                           <<09792>>23488000
      ELSE                                                     <<09792>>23488250
         FNFORMAT := RETURN'INVALID;                           <<09792>>23488500
   END;            << else error occurred >>                   <<09792>>23488750
END;               << of procedure FNFORMAT >>                 <<09792>>23489000
LOGICAL PROCEDURE FQFORMAT (FREF,FN,GN,AN,LW,ENVID);           <<09792>>24090000
      ENVID- ENVID NAME FOR ADVANCE DS                         <<09792>>24142500
      ENVID- ENVID NAME FOR ADVANCE DS                         <<09792>>24202500
BYTE POINTER ENVID;                                            <<09792>>24242500
 BYTE BLANK:=" ";                                              <<09792>>24262500
ARRAY FTAB(0:197);    <<:FILE COMMAND PARM. BUFFER >>          <<09792>>24270000
  GN := " "; AN := " ";                                        <<09792>>24305000
  IF XRETJTENTRY (FREF,GN,AN,BLANK,I,FTAB) = 0 THEN            <<09792>>24310000
        I:=FNFORMAT(FREF,FN,GN,AN,LW,ENVID); <<CHECK IF VALID>><<09792>>24360000
  ARRAY FTAB(0:199);                                           <<09792>>24535000
   BYTE DELIM, BLANK:=" ";                                     <<*1355>>24547500
      GN := " "; AN := " ";                                    <<09792>>24585000
      IF XRETJTENTRY(FD,GN,AN,BLANK,I,FTAB) <> 0 THEN          <<09792>>24590000
      FD(8) := " ";                                            <<01866>>24635000
            DELIM := FD(1+INX(I));                             <<*1355>>24695100
            IF DELIM <> SPECIAL OR DELIM = ":" THEN            <<*1355>>24695200
               BEGIN                                           <<*1355>>24695300
               << Error in delimiting the system file name >>  <<*1355>>24695400
               << or invalid system file name.             >>  <<*1355>>24695500
               FOPDESIGNATOR := 7;                             <<*1355>>24695600
               RETURN;                                         <<*1355>>24695700
               END;                                            <<*1355>>24695800
        9,5,"VTERM",VTERM'DEFN,                                <<09792>>25322500
      PKEYLISTL   = 32,  << length of "SEARCH" dict. >>        <<09792>>25335000
                                                               <<09793>>25701000
   << Check if first parameter (DEV= ) is too long >>          <<09793>>25701100
   MOVE BYTE'STRING := BYTE'STRING WHILE ANS, 1;               <<09793>>25701200
   PARMLEN := TOS - @BYTE'STRING;                              <<09793>>25701300
   IF PARMLEN > MAXDEVPARMLEN THEN                             <<09793>>25701400
      BEGIN   << DEV= parameter is over 8 characters >>        <<09793>>25701500
      PARSE'DEV'PARMS := DEVARRAY'OVERFLOW;                    <<09793>>25701600
      RETURN;                                                  <<09793>>25701700
      END;                                                     <<09793>>25701800
                                                               <<09793>>25701900
         IF (NEXTDELIM<>EQUAL) AND (DEFN<>VTERM'DEFN) THEN     <<09792>>25935000
            BEGIN  << Must be equal following token except >>  <<09792>>25940000
                   << for VTERM keyword which has no value >>  <<09792>>25942500
         IF DEFN <> VTERM'DEFN THEN                            <<09792>>26027500
            IF NOT GETNEXT THEN RETURN;                        <<09792>>26030000
            IF DEFN <> VTERM'DEFN THEN                         <<09792>>26162500
           << we dont want to add value to VTERM keyword >>    <<09792>>26162750
               IF NOT UPDATE'DEV'PARM THEN RETURN;             <<09792>>26165000
LOGICAL PROCEDURE FILECOMVALS (N1,N2,N3,N4,FD,DEVL,            <<09792>>26400000
   FOPT,AOPT,NBUFS,DISP,                                       <<09792>>26402500
         N4 - ENVID NAME FOR ADVANCE DS                        <<09792>>26462500
   BYTE ARRAY N1,N2,N3,N4,FD,DEVL,FMSG;                        <<09792>>26640000
   INTEGER ARRAY FTAB (0:197); <<:FILE COMMAND PARM BUFF>>     <<09792>>26700000
   IF XRETJTENTRY(N1,N2,N3,N4,I,FTAB) = 0 THEN   !FILE COMMAND?<<09792>>26760000
$EDIT VOID=26865000                                                     26775000
      << --------------------------------------------------- >><<09792>>26777500
      << We have the JDT file equation table entry for N1,   >><<09792>>26780000
      << N2, N3, and N4. If this file equation has an act-   >><<09792>>26782500
      << utal designator specified then we want to use that  >><<09792>>26785000
      << in fopen so we put that in FD, otherwise we put the >><<09792>>26787500
      << formal designator part in the FD. Remember that     >><<09792>>26790000
      << XRETJTENTRY followed the file equations to the end  >><<09792>>26792500
      << until there wasn't any "=*file" types. Also if this >><<09792>>26795000
      << is not the original file equation then the formal   >><<09792>>26797500
      << designaotr name would different from what was spe-  >><<09792>>26800000
      << in FOPEN. To enlightened you further:               >><<09792>>26802500
      <<                                                     >><<09792>>26805000
      <<     Case 1.                   Case 2.               >><<09792>>26807500
      << FILE A;DEV=TAPE               FILE T=FOOBAR         >><<09792>>26810000
      << FILE B=*B                     FILE B=*T             >><<09792>>26812500
      <<                                                     >><<09792>>26815000
      << when FOPEN ("*B") is done, and this procedure is    >><<09792>>26817500
      << called the "new" FD must be A in case 1 and FOOBAR  >><<09792>>26820000
      << in case 2.                                          >><<09792>>26822500
      << --------------------------------------------------- >><<09792>>26825000
      I := FTAB.(8:8)&LSL(1); << FTAB FD len, # wds to bytes >><<09792>>26827500
      @BSCAN := @BFTAB(2);    << points to FTAB FD >>          <<09792>>26830000
      MOVE FD := BSCAN,(I);   << copy FTAB FD to Fopen FD >>   <<09792>>26832500
      FD(I) := " ";           << append a blank at end >>      <<09792>>26835000
      @BSCAN := @BSCAN+I+6;   << to FTAB AD, FD len + 3 wds  >><<09792>>26837500
      @FTAB := @FTAB+FTAB.(8:8)+1;  << 1st wd of FTAB pmask  >><<09792>>26840000
      @BFTAB := @FTAB&LSL(1); << set byte pointer of FTAB >>   <<09792>>26842500
      TOS := FTAB;            << load 1st wd of pmask >>       <<09792>>26845000
      IF LS0.(15:1) THEN                                       <<09792>>26847500
      BEGIN             << if there is an AD, case 2 of above>><<09792>>26850000
         I := BFTAB(4);       << AD len in bytes >>            <<09792>>26852500
         MOVE FD := BSCAN,(I);<< copy FTAB AD to Fopen FD >>   <<09792>>26855000
         FD(I) := " ";        << append a blank at end >>      <<09792>>26857500
         @BSCAN := @BSCAN+I;  << update to after AD string >>  <<09792>>26860000
      END;              << if there is an AD, case 2 of above>><<09792>>26862500
$EDIT VOID=30140000                                            <<*1280>>30125000
                                                               <<*1280>>30125100
   << PROMPT FOR THE LOCKWORD. USE FWRITE TO FOLLOW >>         <<*1280>>30125200
   << $STDLIST IF REDIRECTED.                       >>         <<*1280>>30125300
   FWRITE (2, BUF, -LENGTH, %320);                             <<*1280>>30125400
   IF <> THEN GO NFG; << ERROR OCCURED >>                      <<*1280>>30125500
                                                               <<*1280>>30125600
$EDIT VOID=32630000                                            <<09949>>32630000
   << need to preserve NOEQUATE bit in passed FOPTIONs >>      <<02056>>32742000
   IF FOPTION'PASSED THEN   << treat it like an AOPTION >>     <<02056>>32743000
      TOS.FOPNOEQUATEF:=FOPNOEQUATE;                           <<02056>>32744000
$EDIT VOID=35501000                                            <<D1855>>35501000
$EDIT VOID=35757000                                            <<D1855>>35755500
$EDIT VOID=35817200                                            <<D1855>>35816000
$EDIT VOID=35867000                                            <<D1855>>35866000
   RELSIR(FISIR,A); <<RELEASE FILE INTEGRITY SIR>>             <<D1833>>36100000
$EDIT VOID=36101000                                            <<D1855>>36101000
$ PAGE "MPE-V FILE SYSTEM - ADVANCED NET SUPPORT VTERM'ALLOC " <<09792>>36105100
$CONTROL SEGMENT=FILESYS6A                                     <<09792>>36105200
INTEGER PROCEDURE VTERM'ALLOC(LDEV,DEVICE,ENVID);              <<09794>>36105300
VALUE LDEV, DEVICE, ENVID;                                     <<09794>>36105400
LOGICAL LDEV;                                                  <<09792>>36105500
BYTE POINTER DEVICE, ENVID;                                    <<09794>>36105600
OPTION PRIVILEGED, UNCALLABLE;                                 <<09792>>36105700
<<*********************************************************>>  <<09792>>36105800
<< This procedure is called by FOPEN when allocating a     >>  <<09792>>36105900
<< virtual terminal.  The virtual terminal is already      >>  <<09792>>36106000
<< allocated and ADVANCED NET must be called to setup the  >>  <<09792>>36106100
<< link to the virtual device.                             >>  <<09792>>36106200
<< INPUT PARAMETERS - LDEV - Logical device number of the  >>  <<09792>>36106300
<<                           allocated VTERM device        >>  <<09792>>36106400
<<                    DEVICE - Device string parameter to  >>  <<09792>>36106500
<<                             FOPEN.                      >>  <<09792>>36106600
<< OUTPUT PARAMETERS - VTERM'ALLOC - Error number, 0 if no >>  <<09792>>36106700
<<                                   error.                >>  <<09792>>36106800
<<*********************************************************>>  <<09792>>36106900
                                                               <<09792>>36107000
BEGIN                                                          <<09792>>36107100
EQUATE AM'RVT'INDEX = 4;                                       <<09792>>36107200
                                                               <<09792>>36107300
LOGICAL AM'RVT'PLABEL;                                         <<09792>>36107400
                                                               <<09792>>36107500
AM'RVT'PLABEL := AS'DSPLABEL(AM'RVT'INDEX);                    <<09792>>36107600
IF AM'RVT'PLABEL = 0  THEN                                     <<09792>>36107700
   VTERM'ALLOC := VT'NO'ADVNET                                 <<09792>>36107800
ELSE                                                           <<09792>>36107900
   BEGIN                                                       <<09792>>36108000
   TOS := 0;  << Stack parameters, RETURN VALUE >>             <<09792>>36108100
   TOS :=   LDEV;    << VTERM logical device number >>         <<09792>>36108200
   TOS := @DEVICE;  << Device string               >>          <<09792>>36108300
   TOS := @ENVID;   << Envid if specified in Formal Desig. >>  <<09794>>36108310
   TOS := AM'RVT'PLABEL;                                       <<09792>>36108400
   ASSEMBLE(PCAL 0);                                           <<09792>>36108500
   IF TOS = 0 THEN << successful >>                            <<09792>>36108600
      VTERM'ALLOC := 0                                         <<09792>>36108700
   ELSE                                                        <<09792>>36108800
      VTERM'ALLOC := NAVAILDEV;                                <<09792>>36109100
   END;                                                        <<09792>>36109300
END;                                                           <<09792>>36109400
                                                               <<09792>>36109500
$PAGE "FILEACCESS   MPE-V FILE SYSTEM -GETGLOBINFO"            <<01473>>37332040
$CONTROL SEGMENT=FILESYS7                                      <<01473>>37332080
PROCEDURE GETGLOBINFO(BASENAME,BASEGRP,BASEACCT,SETARRAY,      <<01473>>37332120
  SETLENGTH,FIDARRAY);                                         <<01473>>37332160
BYTE ARRAY BASENAME,BASEGRP,BASEACCT;                          <<01473>>37332200
INTEGER ARRAY SETARRAY,FIDARRAY;                               <<01473>>37332240
INTEGER SETLENGTH;                                             <<01473>>37332280
OPTION PRIVILEGED,UNCALLABLE;                                  <<01473>>37332320
                                                               <<01473>>37332360
comment                                                        <<01473>>37332400
  This procedure is called by a TURBO-IMAGE program to return  <<01473>>37332440
  two arrays with information on GLOBAL files belonging to a   <<01473>>37332480
  certain set.  It simply goes through the global AFT DST,     <<01473>>37332520
  looking for any gloabl files which belong to the given set.  <<01473>>37332560
  For each hit, GETGLOBINFO returns a set-value and filenum,   <<01473>>37332600
  which can then be used to close those files.                 <<01473>>37332640
  If no files are found open in the given set, setlength is    <<01473>>37332680
  returned with a value of zero.                               <<01473>>37332720
  Depending on the initial value of SETLENGTH, the number of   <<01473>>37332760
  files returned may be less than the total number of matched  <<01473>>37332800
  files for the set.  If this is so, SETLENGTH will be set to  <<01473>>37332840
  -1 to indicate that the arrays returned are full, and there  <<01473>>37332880
  are more to close.  This way, IMAGE can call this procedure  <<01473>>37332920
  again after the first MAX files are closed to get the rest.  <<01473>>37332960
                                                               <<01473>>37333000
  Input variables:                                             <<01473>>37333040
    BASENAME = name of set (this should be six or fewer chars  <<01473>>37333080
               long, terminated by a non-alphanumeric!)        <<01473>>37333120
    BASEGRP  = group to which set belongs                      <<01473>>37333160
    BASEACCT = account to which set belongs                    <<01473>>37333200
    SETLENGTH = maximum number of files returned               <<01473>>37333240
  Output variables:                                            <<01473>>37333280
    SETARRAY = array which holds the set numbers of files      <<01473>>37333320
               which are found open in the given set           <<01473>>37333360
    FIDARRAY = array which holds the corresponding file        <<01473>>37333400
               numbers to the SETARRAY elements                <<01473>>37333440
    SETLENGTH = the total number of elements found             <<01473>>37333480
                ( := -1 if more than MAX files match )         <<01473>>37333520
                                                               <<01473>>37333560
end comment;                                                   <<01473>>37333600
                                                               <<01473>>37333640
BEGIN                                                          <<01473>>37333680
INTEGER                                                        <<01473>>37333720
  AFT'SIZE, << size in words of global AFT DST >>              <<01473>>37333760
  AFT'OFFSET,  << used to traverse global AFT >>               <<01473>>37333800
  COUNT, LENGTH,  << used in FILLER to access string >>        <<01473>>37333840
  BASELEN,  << set to length of base file name for compare >>  <<01473>>37333880
  FNUM,     << file number passed to FFILEINFO >>              <<01473>>37333920
  MAX;      << maximum number of files (size of arrays+1) >>   <<01473>>37333960
LOGICAL                                                        <<01473>>37334000
  ADDR;     << used to hold string pointer >>                  <<01473>>37334040
DOUBLE                                                         <<01473>>37334080
  AFTDBL;   << used to check validity of AFT entry >>          <<01473>>37334120
ARRAY                                                          <<01473>>37334160
   N(0:3),G(0:3),A(0:3),U(0:3);                                <<01473>>37334200
            << parameters used in call to FNFORMAT >>          <<01473>>37334240
BYTE ARRAY                                                     <<01473>>37334280
  FREF(0:27), << file reference returned from FFILEINFO >>     <<01473>>37334320
  FNAME(*)=N,FGRP(*)=G,FACCT(*)=A,UNUSED(*)=U;                 <<01473>>37334360
            << parameters returned from FNFORMAT >>            <<01473>>37334400
BYTE POINTER                                                   <<01473>>37334440
  UNUSEDPT=UNUSED; << parameter returned from FNFORMAT >>      <<01473>>37334480
LOGICAL                                                        <<01473>>37334520
  LSET;      << set to set number from filename >>             <<01473>>37334560
BYTE POINTER                                                   <<01473>>37334600
  BSET:=@LSET;                                                 <<01473>>37334640
DEFINE                                                         <<01473>>37334680
  DST'SIZE = (ABS(ABS(DSTP)+GLOBAL'AFT'DSTN*4).(3:13))*4#;     <<01473>>37334720
                                                               <<01473>>37334760
SUBROUTINE FILLER(STRING);                                     <<01473>>37334800
<< This routine upshifts the 8-byte long string and >>         <<01473>>37334840
<< pads it with blanks for string compare >>                   <<01473>>37334880
BYTE ARRAY STRING;                                             <<01473>>37334920
BEGIN                                                          <<01473>>37334960
  MOVE STRING:=STRING WHILE ANS,1; <<UPSHIFT>>                 <<01473>>37335000
  ADDR:=TOS;                                                   <<01473>>37335040
  LENGTH:=ADDR-LOGICAL(@STRING);                               <<01473>>37335080
  COUNT:=8-LENGTH;                                             <<01473>>37335120
  << see if the name needs to be padded >>                     <<01473>>37335160
  IF COUNT<1 THEN RETURN;                                      <<01473>>37335200
  STRING(LENGTH):=" ";                                         <<01473>>37335240
  MOVE STRING(LENGTH+1):=STRING(LENGTH),(COUNT-1);             <<01473>>37335280
END; <<FILLER>>                                                <<01473>>37335320
                                                               <<01473>>37335360
<<MAIN BODY>>                                                  <<01473>>37335400
ERRORON;                                                       <<01473>>37335440
                                                               <<01473>>37335480
CHECKDB;                                                       <<01473>>37335520
IF <> THEN BEGIN                                               <<01473>>37335560
  << split stack calls not allowed >>                          <<01473>>37335600
  CONDCODE:= CCL;                                              <<01473>>37335640
  GOTO EXIT;                                                   <<01473>>37335680
END; <<if>>                                                    <<01473>>37335720
                                                               <<01473>>37335760
MAX:= SETLENGTH;                                               <<01473>>37335800
SETLENGTH:= 0;                                                 <<01473>>37335840
                                                               <<01473>>37335880
<< upshift and pad input names so they will compare OK >>      <<01473>>37335920
<< with results from FFILEINFO and FNFORMAT >>                 <<01473>>37335960
FILLER(BASENAME);                                              <<01473>>37336000
IF LENGTH > 6 THEN BEGIN                                       <<01473>>37336040
  << invalid base name specified >>                            <<01473>>37336080
  CONDCODE:= CCL;                                              <<01473>>37336120
  GOTO EXIT;                                                   <<01473>>37336160
END; <<if>>                                                    <<01473>>37336200
BASELEN:= LENGTH;  <<set length of base filename for compare>> <<01473>>37336240
FILLER(BASEGRP);                                               <<01473>>37336280
FILLER(BASEACCT);                                              <<01473>>37336320
                                                               <<01473>>37336360
IF GLOBAL'AFT'DSTN <> 0 THEN BEGIN                             <<01473>>37336400
  << at least one global file was open >>                      <<01473>>37336440
  AFT'SIZE:= DST'SIZE;                                         <<01473>>37336480
  AFT'OFFSET:= AFTENTRY;  << position at first entry >>        <<01473>>37336520
  WHILE AFT'OFFSET<AFT'SIZE DO BEGIN                           <<01473>>37336560
    << for each aft entry >>                                   <<01473>>37336600
    << need to move AFT entry into our stack >>                <<01473>>37336640
    TOS:= @AFTDBL;                                             <<01473>>37336680
    TOS:= GLOBAL'AFT'DSTN;                                     <<01473>>37336720
    TOS:= AFT'OFFSET;                                          <<01473>>37336760
    TOS:= 2;                                                   <<01473>>37336800
    ASSEMBLE(MFDS 4);                                          <<01473>>37336840
    IF AFTDBL<>0D THEN BEGIN                                   <<01473>>37336880
      << valid file found >>                                   <<01473>>37336920
      FNUM:= -(AFT'OFFSET/AFTENTRY);                           <<01473>>37336960
      FFILEINFO(FNUM,1,FREF);                                  <<01473>>37337000
      IF <> THEN BEGIN                                         <<01473>>37337040
        << bad return from ffileinfo should not happen >>      <<01473>>37337080
        CONDCODE:= CCG;                                        <<01473>>37337120
        GOTO EXIT;                                             <<01473>>37337160
      END; <<if>>                                              <<01473>>37337200
      FNFORMAT(FREF,N,G,A,U,UNUSEDPT);                         <<01473>>37337240
      << need to determine length of file name >>              <<01473>>37337280
      SCAN FNAME UNTIL "  ",1;                                 <<01473>>37337320
      ADDR:= TOS;                                              <<01473>>37337360
      LENGTH:= ADDR-LOGICAL(@FNAME);                           <<01473>>37337400
      IF LENGTH>8 THEN LENGTH:= 8;                             <<01473>>37337440
      << check for set match >>                                <<01473>>37337480
      IF LENGTH=BASELEN+2 AND FNAME=BASENAME,(BASELEN)         <<01473>>37337520
         AND FGRP=BASEGRP,(8) AND FACCT=BASEACCT,(8)           <<01473>>37337560
      THEN BEGIN                                               <<01473>>37337600
        << check to see if arrays have overflowed >>           <<01473>>37337640
        IF SETLENGTH >= MAX THEN BEGIN  << overflow >>         <<01473>>37337680
          SETLENGTH:= -1;                                      <<01473>>37337720
          CONDCODE:= CCE;  << condcode OK anyways >>           <<01473>>37337760
          GOTO EXIT;                                           <<01473>>37337800
        END; <<if>>                                            <<01473>>37337840
        FIDARRAY(SETLENGTH):= FNUM;                            <<01473>>37337880
        MOVE BSET:= FNAME(BASELEN),(2); << 2 chars of set id >><<01473>>37337920
        SETARRAY(SETLENGTH):= INTEGER(LSET);                   <<01473>>37337960
        SETLENGTH:= SETLENGTH+1;                               <<01473>>37338000
      END <<if>>                                               <<01473>>37338040
    END; <<if>>                                                <<01473>>37338080
    AFT'OFFSET:= AFT'OFFSET+AFTENTRY;                          <<01473>>37338120
  END <<while>>                                                <<01473>>37338160
END; <<if>>                                                    <<01473>>37338200
CONDCODE:= CCE;  <<looks like it worked>>                      <<01473>>37338240
EXIT:                                                          <<01473>>37338280
  ERROREXIT(%6,0,0);                                           <<01473>>37338320
END;  << getglobinfo >>                                        <<01473>>37338360
   ENTRY VTOPEN;  << Virtual term allocation; change PIN >>    <<09918>>38406000
   ENTRY ULR'OPEN; << User Logging Warmstart Recovery on tape  <<*1688>>38408000
   LOGICAL ENTRY'POINTS := FALSE; << Flags for entry points >> <<09918>>38490000
   DEFINE                                                      <<09918>>38495000
                                                               <<09918>>38500000
      JOBF      = ENTRY'POINTS.(0:1)#,   << FJOPEN used >>     <<09918>>38501000
      KSF       = ENTRY'POINTS.(1:1)#,   << KSOPEN called >>   <<09918>>38502000
$EDIT VOID=38502500                                            <<09918>>38502500
      PVOPEN'   = ENTRY'POINTS.(2:1)#,   << PVOPEN >>          <<09918>>38503000
      MUSTOPEN' = ENTRY'POINTS.(3:1)#,   << MUSTOPEN >>        <<09918>>38504000
      DIRACCF   = ENTRY'POINTS.(4:1)#,   << DFOPEN >>          <<09918>>38505000
      RECOVER5  = ENTRY'POINTS.(5:1)#,   << ROPEN >>           <<09918>>38506000
      VTOPEN'   = ENTRY'POINTS.(6:1)#,   << VTOPEN >>          <<*1688>>38507000
      ULR'TOPEN = ENTRY'POINTS.(7:1)#;   << USER LOGGING >>    <<*1688>>38507100
   << Flags for file conditions.  Set CHECKSEC to TRUE >>      <<09918>>38508000
   LOGICAL SPECIAL'CASES:= %100000;                            <<09918>>38509000
   DEFINE                                                      <<09918>>38510000
      CHECKSEC  = SPECIAL'CASES.(0:1)#, <<No ASEC check if 0>> <<09918>>38511000
      REMOTE    = SPECIAL'CASES.(1:1)#, << Remote file >>      <<09918>>38512000
      REOPENSTD = SPECIAL'CASES.(2:1)#, <<Reopen STDIN/LIST>>  <<09918>>38513000
      FCOMTRIED = SPECIAL'CASES.(3:1)#; <<Tried File eqn >>    <<09918>>38514000
                                                               <<09918>>38515000
   LOGICAL EN:=0;                                              <<09918>>38516000
   BYTE POINTER ENVID = EN;                                    <<09918>>38517000
       LINK'MVTABX = LINKAGE'INDEXP,                           <<01182>>38541000
       LINK'INDEXP = LINK'MVTABX + 1;                          <<01182>>38545000
   INTEGER SAVAOPS := 0;                                       <<09918>>38565000
   INTEGER ARRAY FIDS (0:43);  << file designator copy >>      <<09792>>38605000
$EDIT VOID=38680000                                            <<09918>>38680000
   ARRAY LDTX(0:5);                                            <<01474>>38761000
   LOGICAL REM'SPOOL'ID := 0;  << Return from FFILEINFO >>     <<02054>>38835000
       HVSMOUNTEDPV = JITMTFF = 1#,                            <<01182>>39051000
$EDIT VOID=39456000                                            <<R1889>>39456000
$EDIT VOID=39520000                                            <<09918>>39505000
$EDIT VOID=39890000                                            <<09918>>39885000
  ARRAY EXTRA'QSPACE (0:12) = Q;                               <<*1688>>39980000
                                                               <<09918>>40030000
           STRATEGY    = EXTRA'QSPACE(6)#, << FCB strategy. >> <<09918>>40035000
           FMAVT'FLAGS = EXTRA'QSPACE(7)#,                     <<09918>>40040000
           REM'FOPT      = EXTRA'QSPACE(8)#,                   <<09918>>40045000
           REM'FCODE     = EXTRA'QSPACE(9)#,                   <<09918>>40050000
$EDIT VOID=40060454                                                     40060454
                 5, REDIRECT'DVTYPE, 50, REDIRECT'LDEV);       <<02084>>40280000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - MASSAGEAOPOTIONS"        <<09918>>40620000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - ADJUSTMSGPARMS"          <<09918>>40690000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - ADJUSTCIRPARMS"          <<09918>>40850000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - RBSIZE"                  <<09918>>41165000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - CIRFILESIZE"             <<09918>>41600000
                                                               <<09918>>41605000
                                                               <<09918>>41616000
<<-------------------------------------------------->>         <<09918>>41617000
                                                               <<09918>>42580010
         << For virtual terminals, call ALLOCATE with the   >> <<09918>>42580100
         << current process pin instead of the JIT main pin >> <<09918>>42580200
         << which may be 1 (PROGEN).  Prevents two different>> <<09918>>42580300
         << processes from opening the same virtual terminal>> <<09918>>42580400
         IF VTOPEN' THEN                                       <<09918>>42580500
            JID := CURPRC/PCBSIZE;                             <<09918>>42580600
         RESOURCES.DEVICELOCK := TRUE; <<SET ALLOCATION FLAG>> <<09792>>42635000
         DADDR := DEVINFO'LDEV; << store LDEV in case of err>> <<09792>>42635250
         SPVDEV := DADDR;  << insure dealloc called if error >><<02085>>42636000
         IF GET'DEV'PARM(VTERM'TOKEN,DEVPARMS,DP'INDEX) THEN   <<09792>>42637500
            BEGIN          << special handling for virtual >>  <<09792>>42637750
                           << terminals, must let advanced >>  <<09792>>42638000
                           << net handle the real allocation>> <<09792>>42638250
            TOS := VTERM'ALLOC(DEVINFO'LDEV,DEVL(6),ENVID);    <<09794>>42638500
            IF S0 = 0 THEN DEL                                 <<09792>>42638750
            ELSE GO ERR;                                       <<09792>>42639000
            END;                                               <<09792>>42639250
      SPVDEV := DADDR;  << insure dealloc call if error >>     <<02085>>42852000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - INIT'AFT"                <<09918>>42995000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - CLEAR'GLOBAL'AFT"        <<09918>>43195000
<< * * * * * * BEGIN main block FOPEN * * * * * * * * * * >>   <<09918>>43436000
                                                               <<09918>>43437000
<< All special entry point flags, except for SPOOLF, have >>   <<09918>>43440000
<< been pre-initialized to false.  Set flags as necessary.>>   <<09918>>43441000
FSOPEN:              << Spoolfile sec entry point >>           <<09918>>43455000
      SPOOLF := TRUE;                                          <<09918>>43460000
   IF FALSE THEN                                               <<09918>>43465000
      BEGIN                                                    <<09918>>43470000
FJOPEN:                 << JOB/CI $STDXX sec entry point >>    <<09918>>43475000
      JOBF := TRUE;                                            <<09918>>43480000
      SPOOLF := FALSE;                                         <<09918>>43485000
      END;                                                     <<09918>>43490000
   IF FALSE THEN                                               <<09918>>43495000
      BEGIN                                                    <<09918>>43500000
KSOPEN:                << KSAM secondary entry point >>        <<09918>>43505000
      KSF := TRUE;                                             <<09918>>43510000
      SPOOLF := FALSE;                                         <<09918>>43515000
      END;                                                     <<09918>>43520000
   IF FALSE THEN                                               <<09918>>43525000
      BEGIN                                                    <<09918>>43530000
PVOPEN:               << Entry point for conditional mounts >> <<09918>>43535000
      PVOPEN' := TRUE;                                         <<09918>>43540000
      SPOOLF := FALSE;                                         <<09918>>43545000
      END;                                                     <<09918>>43550000
   IF FALSE THEN                                               <<09918>>43555000
      BEGIN                                                    <<09918>>43560000
MUSTOPEN:          << Entry to bypass lockword/access check >> <<09918>>43565000
      MUSTOPEN' := TRUE;                                       <<09918>>43570000
      SPOOLF := FALSE;                                         <<09918>>43575000
      END;                                                     <<09918>>43580000
   IF FALSE THEN                                               <<09918>>43585000
      BEGIN                                                    <<09918>>43590000
DFOPEN:                                                        <<09918>>43595000
      DIRACCF := TRUE;                                         <<09918>>43600000
      SPOOLF := FALSE;                                         <<09918>>43605000
      END;                                                     <<09918>>43610000
   IF FALSE THEN                                               <<09918>>43615000
      BEGIN                                                    <<09918>>43620000
ROPEN:             << RECOVER5 kludges ACB/FCB info >>         <<09918>>43625000
      RECOVER5 := TRUE;                                        <<09918>>43630000
      SPOOLF := FALSE;                                         <<09918>>43635000
      END;                                                     <<09918>>43640000
   IF FALSE THEN                                               <<09918>>43645000
      BEGIN                                                    <<09918>>43650000
VTOPEN:        << Virtual terminal entry point >>              <<09918>>43651000
      VTOPEN' := TRUE;                                         <<09918>>43652000
      SPOOLF := FALSE;                                         <<09918>>43653000
      END;                                                     <<09918>>43654000
  IF FALSE THEN  << User Logging Recovery >>                   <<*1688>>43654100
      BEGIN                                                    <<*1688>>43654200
ULR'OPEN:  << User Logging Warmstart Recovery process open >>  <<*1688>>43654300
      ULR'TOPEN:= TRUE;                                        <<*1688>>43654500
      SPOOLF := FALSE;                                         <<*1688>>43654600
      END;                                                     <<*1688>>43654700
   REMOTE := FALSE;                                            <<09792>>43717500
   IF VTOPEN' THEN                                             <<09918>>43966000
      IF NOT PRIVMODE THEN                                     <<09918>>43967000
         BEGIN                                                 <<09918>>43968000
         TOS := ILLCAP;                                        <<09918>>43969000
         GO ERR;                                               <<09918>>43969100
         END;                                                  <<09918>>43969200
$EDIT VOID=44100000                                                     44100000
       MOVE DEVL := "DISC    "                                 <<*1224>>44365000
      MOVE DEVL := DEVICE, (MAXDEVLEN);                        <<09792>>44375000
   DEVL(MAXDEVLEN) := " ";   << Guarantees a blank delimiter>> <<09792>>44377500
       MOVE DEVL := "SPOOL   ";                                <<*1224>>44580000
      MOVE FD := FORMDESIGNATOR,(87); <<COPY DESIGNATOR>>      <<09792>>44620000
      FD(87) := " ";     << makes sure FD is delimited >>      <<09792>>44622500
         DNTYPE := FNFORMAT(FD,FN,GN,AN,LW,ENVID);             <<09792>>44670000
         << if envid pointer EN is 0 then there is no envid  >><<09792>>44672500
         << but we must set the EN to a SPECIAL char for FEQs>><<09792>>44672750
         IF EN = 0 THEN   << set it to a guaranteed blank >>   <<09792>>44673000
            EN := @DEVL(MAXDEVLEN);                            <<09792>>44673250
         IF FILECOMVALS (FN,GN,AN,ENVID,                       <<09792>>44705000
            FD,DEVL,FOPTIONS,AOPTIONS,                        << ADS >> 44705250
   << if ADS envid ptr EN is still 0 then make it point >>     <<09792>>44781250
   << to at least a blank (i.e. SPECIAL) character.     >>     <<09792>>44782500
   IF EN = 0 THEN EN := @DEVL(MAXDEVLEN);                      <<09792>>44783750
      IF GET'DEV'PARM(VTERM'TOKEN,DEVPARMS,DP'INDEX) THEN      <<09792>>44932500
         BEGIN  <<DEVL(MAXDEVLEN) must remain " " for ENVID >> <<09792>>44932525
      MOVE DEVL(MAXDEVLEN-1):=DEVL(MAXDEVLEN-7),(-MAXDEVLEN+6);<<09792>>44932750
         MOVE DEVL := "VTERM;";         << We want to alloc >> <<09792>>44933000
                                << a virtural terminal, not >> <<09792>>44933250
                                << what is actually in devl >> <<09792>>44933500
         END;                                                  <<09792>>44933750
IF KSF THEN                                                             45126000
   IF 1<=INT(AOPACTYPE)<=3 THEN AOPACTYPE := 4;                         45127000
   IF AOPLOCKING AND FOPNEW THEN  <<CANNOT LOCK NEW FILE>>     << 1330>>45316000
      AOPTIONS.AOPLOCKINGF := 0;                               << 1330>>45317000
<< EDIT VOID THE OLD DS CODE FOR REVERSE RFA >>                <<09792>>45380000
$EDIT VOID=45500000                                                     45385000
      IF DEVL <> "VTERM;" THEN                                 <<09794>>45386000
      BEGIN   << Reverse VT is not specified >>                <<09794>>45387000
         MOVE DEVL := DEVL WHILE AN,1;                         <<09794>>45387500
         IF BPS0 = "#" OR ENVID <> " " THEN                    <<09794>>45390000
         BEGIN   << desire to RFA detected in device or fd >>  <<09794>>45392500
            DTYPE := DSDUMMYDEV;                               <<09794>>45395000
            IF BPS0 = "#" AND ENVID = ALPHA THEN               <<09794>>45397500
               @ENVID := TOS                                   <<09794>>45400000
            ELSE                                               <<09794>>45402500
               DEL;                                            <<09794>>45405000
            GO SKIPDEVINFO;                                    <<09794>>45407500
         END;    << desire to RFA detected in device or fd >>  <<09794>>45410000
         DEL;                                                  <<09794>>45412500
      END     << Reverse VT is not specified >>                <<09832>>45413000
      ELSE BEGIN << Else Rev VT >>                             <<09832>>45413100
         IF ENVID = ALPHA THEN                                 <<09832>>45413200
         BEGIN      << Envid is in FD >>                       <<09832>>45413300
         << ------------------------------------------------ >><<09832>>45413400
         << Because ALLOC will use first 32 chars of FD in   >><<09832>>45413500
         << its subroutine, the envid in FD will be right-   >><<09832>>45413600
         << justified (address progressing left to right) so >><<09832>>45413700
         << as to keep it out of the way.                    >><<09832>>45413800
         << The EN logical variable is also byte pointer     >><<09832>>45413900
         << ENVID, but since we have to reset it to the new  >><<09832>>45414000
         << location of the envid it will temporarily be used>><<09832>>45414100
         << as a scratch variable.                           >><<09832>>45414200
         << Max file name + ":" = 36 chars                   >><<09832>>45414300
         << Max Envid + 1char delimiter = 51 chars           >><<09832>>45414400
         << Filenamelen+":" = @ENVID - @FD                   >><<09832>>45414410
         << Rightjustify offset = 36 - Filenamelen+1         >><<09832>>45414420
         << ------------------------------------------------ >><<09832>>45414500
            EN := @ENVID - @FD; << file name len + ":" >>      <<09832>>45414600
            MOVE FD(86) := FD(86-(36-INTEGER(EN))),(-51);      <<09832>>45414700
            << now set the ENVID pointer again >>              <<09832>>45414800
            EN := @FD(36);                                     <<09832>>45414900
         END;       << Envid is in FD >>                       <<09832>>45415000
      END;       << Else Rev VT >>                             <<09832>>45415100
SKIPDEVINFO:                                                            45592500
            SAVAOPS := -1;                                     <<09918>>45701000
      MOVE DEVL := "DISC    "; <<MAKE DEVICE CLASS "DISC">>    <<*1224>>45780000
      TOS := @LGNAME & LSL (1);  << JIT logon group name >>    <<01182>>46341000
      TOS := @GNPTR & LSL (1);   << Formal desig group name >> <<01182>>46342000
      TOS := @HANAME & LSL (1);  << JIT home acct name >>      <<01182>>46343000
      TOS := @ANPTR & LSL (1);   << Formal desig acct name >>  <<01182>>46344000
                                                               <<01182>>46344100
      << Case on DNTYPE, return value from FNFORMAT >>         <<01182>>46344200
         BEGIN     << fully qualified name >>                  <<01182>>46351000
         IF BPS1 = BPS0, (8) THEN                              <<01182>>46352000
            BEGIN  << account names match >>                   <<01182>>46353000
            IF BPS3 = BPS2, (8) AND  << group names match >>   <<01182>>46354000
               << But if PV, must be mounted to use index ptr>><<01182>>46354100
               NOT (HVSPV LAND NOT LOGICAL (HVSMOUNTEDPV)) THEN<<01182>>46354200
               BEGIN   << acct & group names match >>          <<01182>>46355000
               DNTYPE := 2;                                    <<01182>>46356000
               LINKAGE'INDEXP := GRPINDEX;                     <<01182>>46357000
               END                                             <<01182>>46358000
            ELSE                                               <<01182>>46359000
               BEGIN   << only acct names match >>             <<01182>>46360000
               DNTYPE := 1;                                    <<01182>>46361000
               LINKAGE'INDEXP := ACCTINDEX;                    <<01182>>46362000
               END;                                            <<01182>>46363000
            END;                                               <<01182>>46364000
         END;    << 0 >>                                       <<01182>>46365000
                                                               <<01182>>46366000
         BEGIN    << account name missing >>                   <<01182>>46367000
         MOVE AN := HANAME, (4);   << home acct name >>        <<01182>>46368000
         IF BPS3 = BPS2, (8) AND    << group names match >>    <<01182>>46369000
            << But if PV, must be mounted to use index ptr>>   <<01182>>46369100
            NOT (HVSPV LAND NOT LOGICAL (HVSMOUNTEDPV)) THEN   <<01182>>46369200
            BEGIN  << use logon group >>                       <<01182>>46370000
            DNTYPE := 2;                                       <<01182>>46371000
            LINKAGE'INDEXP := GRPINDEX;                        <<01182>>46372000
            END                                                <<01182>>46373000
         ELSE                                                  <<01182>>46374000
            LINKAGE'INDEXP := ACCTINDEX;                       <<01182>>46375000
         END;   << 1 >>                                        <<01182>>46376000
                                                               <<01182>>46377000
         BEGIN     << group name missing >>                    <<01182>>46378000
         MOVE AN := HANAME, (4);   << home acct name >>        <<01182>>46379000
         MOVE GN := LGNAME, (4);   << logon group name >>      <<01182>>46380000
         IF HVSPV AND NOT LOGICAL (HVSMOUNTEDPV) THEN          <<01182>>46381000
            BEGIN   << not mounted, start at acct level >>     <<01182>>46382000
            DNTYPE := 1;                                       <<01182>>46383000
            LINKAGE'INDEXP := ACCTINDEX;                       <<01182>>46384000
            END                                                <<01182>>46385000
         ELSE                                                  <<01182>>46386000
            LINKAGE'INDEXP := GRPINDEX;                        <<01182>>46387000
         END;   << 2 >>                                        <<01182>>46388000
                                                               <<01182>>46390000
         BEGIN   << name missing >>                            <<01182>>46395000
            MOVE GN := LGNAME, (4);   << logon group name >>   <<01182>>46400000
            MOVE AN := HANAME, (4);   << home account name >>  <<01182>>46405000
         END;    << 3 >>                                       <<01182>>46410000
                                                               <<01182>>46415000
         BEGIN   << illegal name, error >>                     <<01182>>46420000
         DDEL; DDEL;   << get rid of names first >>            <<01182>>46425000
         GO TO E1;                                             <<01182>>46430000
         END;                                                  <<01182>>46435000
                                                               <<01182>>46440000
      END;     << of DNTYPE case >>                            <<01182>>46445000
      DDEL; DDEL;   << get rid of names on TOS >>              <<01182>>46450000
                                                               <<01182>>46455000
     << To avoid directory check, if spoolf or if no PVs are >><<02493>>46463000
     << up and is an old domain file, can bypass MOUNT chk >>  <<02493>>46464000
     IF (NOT SPOOLF) AND (PVUSED OR NOT FOPPERMANENT) THEN     <<02493>>46465000
                  << If global file, MOUNT on behalf of     >> <<09904>>46620100
                  << pseudo-pin -1, so they can all go in   >> <<09904>>46620200
                  << the same bind names data segment.      >> <<09904>>46620300
                  IF AOPGLOBALAFT THEN                         <<09904>>46620400
                     MOUNT (HVSIND, GNPTR, ANPTR, REQTYPE,     <<09904>>46620500
                            -1, PVINFO, -1)                    <<09904>>46620600
                  ELSE                                         <<09904>>46620700
                     MOUNT (HVSIND, GNPTR, ANPTR, REQTYPE,     <<09904>>46625000
                            -1, PVINFO);                       <<09904>>46630000
                  IF DNTYPE = 2 THEN <<logon grp bound to PV >><<01182>>46686000
                     LINK'MVTABX := MVTABX;                    <<01182>>46687000
$EDIT VOID=46811900                                            <<R1889>>46811100
         << DEVL(MAXDEVLEN) is guaranteed to have a " "  >>    <<09792>>47107500
         << since env id is irrelvant here we need a blank>>   <<09792>>47107750
         IF RETJTENTRY(FN,GNPTR,ANPTR,DEVL(MAXDEVLEN),JID,FIDS)<<09792>>47110000
            = 0 THEN                                           <<09792>>47112500
      IF LINK'MVTABX <> 0 THEN              << PV file >>      <<01182>>47216000
         DISKADR := DIRECFINDFILE (DNTYPE, LINKAGE'INDEXP,     <<01182>>47220000
                                   ANPTR,GNPTR,FN,AS4,MVTABX)  <<01182>>47225000
      ELSE                                                     <<01182>>47226000
         DISKADR := DIRECFINDFILE (DNTYPE, LINKAGE'INDEXP,     <<01182>>47227000
                                   ANPTR, GNPTR, FN, AS4);     <<01182>>47228000
      IF (NOT FOPOLDPASS) AND (FLLOAD = 1)                     << 2219>>47920100
         THEN << This file is loaded >>                        << 2219>>47920110
         IF  ((AOPACTYPE > 0) LAND (AOPACTYPE < 6)) OR         << 2219>>47920200
             ((AOPACTYPE > 8) LAND (AOPACTYPE < 14)) OR        << 2219>>47920300
             (AOPACMODE = EAR'ACCESS)  OR                      << 2219>>47920400
             (AOPACMODE = EXCL'ACCESS)                         << 2219>>47920410
         THEN                                                  <<R1617>>47920500
         BEGIN  <<FILE IS LOADED!  REQUESTING OPEN IN A    >>  <<R1617>>47920600
                <<MODIFIABLE MODE OR WITH EXCLUSIVE ACCESS >>  <<R1617>>47920700
                <<The check for access type between 8 & 14 >>  << 2219>>47920710
                <<is made because the CI(?) sometimes calls>>  << 2219>>47920720
                <<with the high bit on.  Don't know why.   >>  << 2219>>47920730
                                                               <<R1889>>47920800
         << To avoid deadlocks, we need to release the ACB  >> <<02291>>47920900
         << and the FISIR before calling DEALLOC'IF'AUTOALC >> <<02291>>47920901
         << because it grabs the LST sir.  We will reobtain >> <<02291>>47920902
         << those resources after the call.                 >> <<02291>>47920903
                                                               <<02291>>47920904
         RELSIR(FISIR,A);                                      <<02291>>47920905
         IF PACBLOCKED THEN UNLOCK'CB(0,PACBV);                <<R1889>>47920910
                                                               <<R1889>>47920920
         DEALLOC'IF'AUTOALLOC(DADDR,FADDR,FLFILECODE,0);       <<02291>>47921000
$EDIT VOID=47921300                                                     47921100
                                                               <<R1617>>47921400
         IF PACBLOCKED                                         <<02291>>47921500
            THEN CHECK'MULTI'ACCESS;  << Relock the ACB >>     <<02291>>47921520
         A := GETSIR(FISIR);  << Grab FISIR back >>            <<02291>>47921600
$EDIT VOID=47921610                                                     47921610
         << DEAL'IF'AUTO may alter FLAB, so we need to read >> <<02291>>47921620
         << it in again from disk. >>                          <<02291>>47921630
         DISKADR := FADDR;                                     <<02291>>47921660
         P1.(0:8) := 0;                                        <<02291>>47921680
         LABELIO(0,1);                                         <<02291>>47921690
                                                               <<R1889>>47921700
         END; <<THEN FLLOAD = 1>>                              <<R1889>>47921710
                                                               <<D1833>>47921800
      IF KSF THEN ELSE << to prevent extra lockword prompt>>   <<02121>>47936000
         IF SPOOLF THEN BEGIN                                  <<01922>>48230000
            DADDR:=SPDADDR;                                    <<01922>>48231000
            DISKADR:=SPDISKADDR;                               <<01922>>48232000
            END; <<if spooled>>                                <<01922>>48233000
         << dummy FOPEN ATTIO for performance meas. >>         <<01922>>48234000
         TOS := ATTACHIO(DADDR,FOPTIONS,0,0,2,0,               <<01922>>48235000
                         P1,P2,BSFLAGS);                       <<01922>>48236000
            IF ULR'TOPEN THEN                                  <<*1688>>49204000
               TOS := CREATETLTENT(FORMMSG,FNAMES,FILENUM,     <<*1688>>49205000
                                   -AOPACTYPE,DP'DEN )         <<*1688>>49210000
            ELSE                                               <<*1688>>49211000
               TOS := CREATETLTENT(FORMMSG,FNAMES,FILENUM,     <<*1688>>49212000
                                   AOPACTYPE,DP'DEN);          <<*1688>>49213000
         BEGIN                                                 <<09792>>49380000
         << ----------------------------------------------- >> <<09792>>49380025
         << call RFA'FOPEN, it will return                  >> <<09792>>49380050
         << +--------------------------------+              >> <<09792>>49380052
         << | error code or remote -fcheck # |  S-1         >> <<09792>>49380055
         << |--------------------------------|              >> <<09792>>49380057
         << | remote status  |  not used now |  S-0         >> <<09792>>49380060
         << +--------------------------------+              >> <<09792>>49380062
         <<                                                 >> <<09792>>49380065
         << if CCE then                                     >> <<09792>>49380075
         <<    remote fopen is good                         >> <<09792>>49380100
         <<    update the condcode from s0                  >> <<09792>>49380102
         <<    error code of 0 is left on TOS               >> <<09792>>49380125
         <<    exit                                         >> <<09792>>49380150
         << else (reasons for fopen failure)                >> <<09792>>49380175
         <<    if CCL then a processing error occured       >> <<09792>>49380200
         <<       remote status word is meaningless delete  >> <<09792>>49380202
         <<       if functional return is < 0               >> <<09792>>49380225
         <<          fopen failed on remote side            >> <<09792>>49380250
         <<          functional return == -fcheck number    >> <<09792>>49380275
         <<          go to err                              >> <<09792>>49380300
         <<       else                                      >> <<09792>>49380325
         <<          some other error incurred locally      >> <<09792>>49380350
         <<          functional return is the local err     >> <<09792>>49380375
         <<          go to err                              >> <<09792>>49380400
         <<    else                                         >> <<09792>>49380425
         <<       the specified node is DSI so continue on  >> <<09792>>49380450
         << ----------------------------------------------- >> <<09792>>49380475
            << -------------------------------------------- >> <<09833>>49381010
            << Global RFA fopen, access types 6(exec) and 7 >> <<09833>>49381020
            << (loadprog) and cannot do RFA.                >> <<01208>>49381030
            << -------------------------------------------- >> <<09833>>49381040
            IF AOPGLOBALAFT THEN                               <<09833>>49381100
            BEGIN                                              <<09833>>49381200
               TOS := DSGLOB;                                  <<09833>>49381300
               GO ERR;                                         <<09833>>49381400
            END;                                               <<09833>>49381500
            IF AOPTIONS.AOPACTYPEF > 5 THEN                    <<01208>>49381600
            BEGIN                                              <<09833>>49381700
               TOS := ACCVIOL;                                 <<09833>>49381800
               GO ERR;                                         <<09833>>49381900
            END;                                               <<09833>>49382000
            TOS := RFA'FOPEN (AFTX,                            <<09792>>49387500
                              FOPTIONS,                        <<09792>>49387525
                              AOPTIONS,                        <<09792>>49387550
                              RECSIZE,                         <<09792>>49387575
                              USERLABELS,                      <<09792>>49387600
                              BLOCKFACTOR,                     <<09792>>49387625
                              PRICOPBUFS,                      <<09792>>49387650
                              FILESIZE,                        <<09792>>49387675
                              NUMEXTENTS,                      <<09792>>49387700
                              INITALLOC,                       <<09792>>49387725
                              FILECODE,                        <<09792>>49387750
                              PMAP LOR %007537,                <<01424>>49387775
                              STATUS.(0:1), << priv-mode?   >> <<09792>>49387800
                              KSF.(15:1),   << KSAM file?   >> <<09792>>49387825
                              DISP,     << pending on fclose>> <<11610>>49387830
                              FD,       << file designator  >> <<09792>>49387850
                              ENVID,    << Ads Envid pointer>> <<09792>>49387875
                              DEVL,     << device name      >> <<09792>>49387900
                              FORMMSG); << forms message    >> <<09792>>49387925
            IF = THEN                                          <<09792>>49387950
            BEGIN     << remote file opened successfully    >> <<09792>>49387975
               DEL;                                            <<09792>>49388000
               CONDCODE := CCE;                                <<09792>>49388025
               FOPEN := AFTX;                                  <<09792>>49388027
               << there is a zero returned on TOS already   >> <<09792>>49388050
               GO EXIT;                                        <<09792>>49388075
            END       << remote file opened successfully    >> <<09792>>49388100
            ELSE IF < THEN                                     <<09792>>49388125
            BEGIN     << fopen failure                      >> <<09792>>49388150
               DEL;                                            <<09792>>49388152
               << now TOS has error number, either a local  >> <<09792>>49388175
               << failure, or a remote fcheck err number    >> <<09792>>49388200
               << aft is already zeroed (i.e. released) and >> <<09792>>49388225
               << TOS has the error code >>                    <<09792>>49388250
               GO ERR;                                         <<09792>>49388275
            END;      << fopen failure                      >> <<09792>>49388300
                                                               <<09792>>49388302
            << --------------- OLD DS --------------------- >> <<09792>>49388325
            << if we got to here it means that the remote   >> <<09792>>49388350
            << machine is using old DS line, so we let the  >> <<09792>>49388375
            << old code take over, at least it works        >> <<09792>>49388400
            IF DEVL = "#" THEN   << reverse rfa    >><<DS.04>> <<09792>>49388425
            BEGIN                << TO THE REMOTE  >><<DS.04>> <<09792>>49388450
               TOS := 0;         <<LINE CONNECTED TO   DS.04>> <<09792>>49388475
$EDIT VOID=49388550                                            <<01767>>49388500
               TOS := RFA'CIPIN (CURPRC/PCBSIZE);              <<01767>>49388575
               TOS := SDSLDEVPLABEL;                 <<DS.04>> <<09792>>49388600
               IF = THEN                             <<DS.04>> <<09792>>49388625
               BEGIN             << DS NOT IN SYSTEM   DS.04>> <<09792>>49388650
                 TOS := UNIMPL;                      <<DS.04>> <<09792>>49388675
                 GO TO ERR;                          <<DS.04>> <<09792>>49388700
               END;                                  <<DS.04>> <<09792>>49388725
               ASSEMBLE(PCAL 0); << SDSLDEV >>       <<DS.04>> <<09792>>49388750
               IF S0 = 0 THEN    << NOT A REMOTE >>  <<DS.04>> <<09792>>49388775
               BEGIN                                 <<DS.04>> <<09792>>49388800
                 TOS := UNDEFDEV;                    <<DS.04>> <<09792>>49388825
                 GO TO ERR;                          <<DS.04>> <<09792>>49388850
               END;                                  <<DS.04>> <<09792>>49388875
               TOS := ASCII(LS0,10,LOGICAL'DEV);     <<DS.04>> <<09792>>49388900
               MOVE DEVL(9+S0) := DEVL(9),(-10);     <<02524>> <<09792>>49388925
               << include terminating byte in move >><<02524>> <<09792>>49388950
               MOVE DEVL := LOGICAL'DEV,(S0); <<INSERT DS.04>> <<09792>>49388975
               DDEL;  << LOGICAL DEV AND LENGTH >>   <<DS.04>> <<09792>>49389000
            END;   << reverse rfa         >>         <<DS.04>> <<09792>>49389025
            X := GETDEVINFO(DEVL,DEVINFO); <<GET DEVICE INFO>> <<09792>>49389050
            IF > THEN  <<ERROR?>>                              <<09792>>49389075
            BEGIN                                              <<09792>>49389100
               TOS := UNDEFDEV;                                <<09792>>49389125
               GO ERR                                          <<09792>>49389150
            END;                                               <<09792>>49389175
            IF INT(DEVINFO'LDEV) > 0 THEN                      <<09792>>49389200
               @LDT := @DEVINFO(6)                             <<09792>>49389202
            ELSE @LDT := @DEVINFO(4);                          <<09792>>49389205
            DTYPE := DEVINFO'DEVTYPE;                          <<09792>>49389225
            DEFRS := LDT'RECORD'WIDTH;                         <<09792>>49389375
                                                               <<09792>>49389400
            << --------- Old DS RFA fopen ----------------- >> <<09792>>49389425
$EDIT VOID=49420000                                            <<09833>>49400000
$EDIT VOID=49630000                                            <<09833>>49610000
               TOS := PMAP LOR %007537;    << PMAP >>          <<01424>>49700000
            END                                                <<09792>>50355000
            ELSE BEGIN                                         <<09792>>50355025
               TOS := UNDEFDEV;                                <<09792>>50355050
               GO ERR;                                         <<09792>>50355075
            END;                                               <<09792>>50355100
      << User is not allowed to open DS pseudo devices that >> <<09905>>50785000
      << are not his $STDIN or $STDLIST.  TIP may open DS   >> <<09905>>50790000
      << pseudo-devices, provided that it already owns them.>> <<09905>>50791000
       << Check for illegal DS access only if reverse       >> <<01425>>50841000
       << virtual terminal was not specified.  If reverse   >> <<01425>>50842000
       << VT, it must be OK if we got this far.             >> <<01425>>50843000
                                                               <<01425>>50844000
       IF DEVL <> "VTERM" THEN                                 <<01425>>50844100
         IF (1 <= X <= 3) OR (X=5) THEN                        <<09947>>50855000
            BEGIN                                              <<09905>>50855100
            X := GETDEVINFO (DEVL, DEVINFO);                   <<09905>>50855200
            IF <> THEN                                         <<09905>>50855300
               BEGIN                                           <<09905>>50855400
               TOS := UNDEFDEV;                                <<09905>>50855500
               GO ERR;                                         <<09905>>50855600
               END;                                            <<09905>>50855700
            IF INT(DEVINFO'LDEV) > 0 THEN                      <<09905>>50855800
               BEGIN                                           <<01474>>50855810
               @LDT := @DEVINFO(6);                            <<01474>>50855900
               GETLDTX (INT(DEVINFO'LDEV),LDTX);               <<01474>>50855910
               END                                             <<01474>>50855920
            ELSE                                               <<09905>>50856000
               BEGIN                                           <<01474>>50856010
               @LDT := @DEVINFO(4);                            <<09905>>50856100
               LDTX'ALTER'PIN := 0;                            <<01474>>50856120
               END;                                            <<01474>>50856130
            << CI main pin and owner pin of LDEV must match >> <<09905>>50856200
            IF JID <> INTEGER (LDT'MAIN'PIN)  AND              <<01474>>50856300
              JID <> INTEGER (LDTX'ALTER'PIN) THEN             <<01474>>50856400
               GO E8;   << Can't open a DS pseudo terminal  >> <<09905>>50860000
            END;                                               <<09905>>50861000
   << dummy FOPEN ATTIO for performance meas (new files) >>    <<01922>>52154000
   TOS:= ATTACHIO(DADDR,FOPTIONS,0,0,2,0,P1,P2,BSFLAGS);       <<01922>>52155000
$EDIT VOID=52666100                                            <<R1889>>52666000
         BEGIN                                                 <<*9390>>52731000
         TOS := %400;     ! DEVICE has NOT been primed.        <<*9390>>52732000
         IF NOT( FOPLABELLED LAND (DACCCL = SERIALIO) )        << 1591>>52733000
            THEN TOS.(1:1):= 1;  << set FOPEN FAILED bit >>    << 1591>>52733100
         TOS := DADDR;                                         <<*9390>>52734000
         DEALLOCATE(*);                                        <<*9390>>52735000
         END;                                                  <<*9390>>52736000
       IF AOPGLOBALAFT THEN                                    <<09904>>52845000
          DISMOUNT (HVSIND, GNPTR, ANPTR, REQTYPE, PVINFO, -1) <<09904>>52850000
       ELSE                                                    <<09904>>52850100
          DISMOUNT (HVSIND, GNPTR, ANPTR, REQTYPE, PVINFO);    <<09904>>52850200
$EDIT VOID=52926000                                            <<R1889>>52926000
$ PAGE " FMAKETEMP              "                              <<01592>>53637000
$ CONTROL SEGMENT = FILESYS4                                   <<01592>>53637020
PROCEDURE FMAKETEMP(FILENUM);                                  <<01592>>53637040
   VALUE FILENUM;                                              <<01592>>53637060
   INTEGER FILENUM;                                            <<01592>>53637080
   OPTION PRIVILEGED,UNCALLABLE;                               <<01592>>53637100
   BEGIN                                                       <<01592>>53637120
                                                               <<01592>>53637140
comment                                                        <<01592>>53637160
  This procedure is called to convert an open permanent file   <<01592>>53637180
  into an open temporary file.  It removes the file from the   <<01592>>53637200
  directory, then adds it to the job temporary file list.      <<01592>>53637220
  The DOMAIN specifications in the FLAB, ACB, and FCB are      <<01592>>53637240
  updated accordingly.                                         <<01592>>53637260
end comment;                                                   <<01592>>53637280
                                                               <<01592>>53637300
   <<*******************************************************>> <<01592>>53637320
   <<  Error condition        ACBERROR      Condition Code  >> <<01592>>53637340
   <<                                                       >> <<01592>>53637360
   << invalid FNUM               *               CCL        >> <<01592>>53637380
   << FNUM is $NULL              *               CCE        >> <<01592>>53637400
   << wrong file type            *               CCL        >> <<01592>>53637420
   << devtype <> "DISC"       DEVVIOL            CCL        >> <<01592>>53637440
   << not EXCLUSIVE access    MULITACCERR        CCL        >> <<01592>>53637460
   << R/W Label Error         LBLIOERR           CCL        >> <<01592>>53637480
   << file not OLD PERM       UNDEFFILESD        CCL        >> <<01592>>53637500
   << directory I/O error     DIRIOERR           CCL        >> <<01592>>53637520
   << duplicate TEMP file     DUPNJD             CCL        >> <<01592>>53637540
   << job directory overflow  JTFDIROFL          CCL        >> <<01592>>53637560
   << ****N O R M A L****                        CCE        >> <<01592>>53637580
   <<*******************************************************>> <<01592>>53637600
   << * NOTE: for 1st 3 errors above ACB may not be valid,  >> <<01592>>53637620
   << so cannot stuff errorcode into ACB.                   >> <<01592>>53637640
                                                               <<01592>>53637660
   INTEGER CRIT;            << for setcritical >>              <<01592>>53637680
   INTEGER B := -1;         << used by getsir >>               <<01592>>53637700
   LOGICAL ORIG'DST;        << saves original DB >>            <<01592>>53637720
   << VALIDFILETYPE defines only MSG and FSTYPE files as >>    <<01592>>53637740
   << currently valid types which FMAKETEMP will accept. >>    <<01592>>53637760
   DEFINE VALIDFILETYPE = (FTYPE=0 LOR FTYPE=8)#;              <<01592>>53637780
   DOUBLE DRCODE;           << DRCODEs returned from >>        <<01592>>53637800
   INTEGER RCB = DRCODE;    << directory routines >>           <<01592>>53637820
   INTEGER RCA = DRCODE+1;                                     <<01592>>53637840
   ARRAY FILE'INFO(0:4)=Q;                                     <<01592>>53637860
   INTEGER FCBMQ;           << Q-relative offset to FCB >>     <<01592>>53637880
   INTEGER DSTX;            << Original Stack number >>        <<01592>>53637900
   INTEGER POINTER FCB;     << FCB pointer>>                   <<01592>>53637920
   DOUBLE POINTER FCBDBL = FCB;                                <<01592>>53637940
   DOUBLE                   << DST and offset of ...       >>  <<01592>>53637960
      FCB'CB'ADDR,          << FCB control block address.  >>  <<01592>>53637980
      FCB'STK'ADDR;         << FCB stack address.          >>  <<01592>>53638000
                                                               <<01592>>53638020
   <<file label parameters>>                                   <<01592>>53638040
   INTEGER DADDR;                                              <<01592>>53638060
   DOUBLE LABADR;           << file label sector >>            <<01592>>53638080
   INTEGER P1 = LABADR;                                        <<01592>>53638100
   INTEGER P2 = LABADR+1;                                      <<01592>>53638120
   ARRAY LABADRA (*) = LABADR;                                 <<01592>>53638140
   INTEGER POINTER FLAB;  <<file label buffer>>                <<01592>>53638160
   DOUBLE POINTER FLABDBL=FLAB;                                <<01592>>53638180
                                                               <<01592>>53638200
   BYTE BLANK:= " ";                                           <<01592>>53638220
                                                               <<01592>>53638240
   LOGICAL ACB'FLAGS;         << Flags sent to LOC'ACB      >> <<01592>>53638260
                                                               <<01592>>53638280
   <<*******************************************************>> <<01592>>53638300
   << ACB'POINTERS - Below are the declarations and equates >> <<01592>>53638320
   << for the PACB and AFT arrays.  LOC'ACB places the AFT  >> <<01592>>53638340
   << at ACB(-4) to ACB(-1) and the PACB follows.           >> <<01592>>53638360
                                                               <<01592>>53638380
   INTEGER ACBMQ;          << Q-relative ACB loc for LOC'ACB >><<01592>>53638400
   INTEGER AFTE;    << AFT entry word 0, type and $NULL bit. >><<01592>>53638420
   DOUBLE  PACBV;   << Physical ACB Vector                  >> <<01592>>53638440
   DOUBLE  LACBV;   << Logical  ACB Vector                  >> <<01592>>53638460
   INTEGER IOQX;    << No-wait I/O pending Queue index.     >> <<01592>>53638480
   RFASTUFF;        << Set up remote file variables.        >> <<01592>>53638500
                                                               <<01592>>53638520
   << The order of the above declarationa cannot be changed >> <<01592>>53638540
   << in any way.  Also, the ACB declaration must immed-    >> <<01592>>53638560
   << iately follow.                                        >> <<01592>>53638580
                                                               <<01592>>53638600
   INTEGER ARRAY ACB(0:SIZEXACB-1) = Q;                        <<01592>>53638620
   DOUBLE ARRAY ACBDBL(*)=ACB;                                 <<01592>>53638640
                                                               <<01592>>53638660
   <<*******************************************************>> <<01592>>53638680
                                                               <<01592>>53638700
$ PAGE " FMAKETEMP -SUBROUTINES "                              <<01592>>53638720
   SUBROUTINE LABELIO (RW);                                    <<01592>>53638740
      VALUE RW;                                                <<01592>>53638760
      INTEGER RW;                                              <<01592>>53638780
    comment                                                    <<01592>>53638800
      reads or writes the file label into                      <<01592>>53638820
      the stack buffer                                         <<01592>>53638840
                                                               <<01592>>53638860
        input variables:                                       <<01592>>53638880
            RW - I/O mode                                      <<01592>>53638900
               0 - READ                                        <<01592>>53638920
               1 - WRITE                                       <<01592>>53638940
      end comment;                                             <<01592>>53638960
      BEGIN                                                    <<01592>>53638980
      X := FLABIO(DADDR,LABADR,RW,FLAB);  <<R/W LABEL>>        <<01592>>53639000
      IF <> THEN  <<error?>>                                   <<01592>>53639020
         BEGIN                                                 <<01592>>53639040
         FLABIOERR(X,FILENUM);  <<handle error>>               <<01592>>53639060
         TOS := LBLIOERR;                                      <<01592>>53639080
         TOS := CCL;                                           <<01592>>53639100
         GO RELEASE'FCB;                                       <<01592>>53639120
         END                                                   <<01592>>53639140
      END;                                                     <<01592>>53639160
                                                               <<01592>>53639180
                                                               <<01592>>53639200
   SUBROUTINE UPDATEFCB;                                       <<01592>>53639220
      << Updates the actual FCB in the control block (where >> <<01592>>53639240
      << ever it may be) by overlaying  it with the updated >> <<01592>>53639260
      << FCB that exists on the stack.                      >> <<01592>>53639280
      BEGIN                                                    <<01592>>53639300
      TOS := FCB'CB'ADDR;  << CB DST and offset of FCB.     >> <<01592>>53639320
      TOS := FCB'STK'ADDR; << Stack DST and offset of FCB.  >> <<01592>>53639340
      TOS := SIZEBFCB;     << Now copy minimum FCB back.    >> <<01592>>53639360
      MOVE'DS'5;                                               <<01592>>53639380
      END;                                                     <<01592>>53639400
                                                               <<01592>>53639420
                                                               <<01592>>53639440
$PAGE  " FMAKETEMP - MAIN BLOCK "                              <<01592>>53639460
<<                     MAIN BLOCK                           >> <<01592>>53639480
                                                               <<01592>>53639500
   ERRORON;                                                    <<01592>>53639520
                                                               <<01592>>53639540
   << tweak TOS to insure there will be enough space >>        <<01592>>53639560
   << on the stack while we are critical >>                    <<01592>>53639580
   TOS:= %500;                                                 <<01592>>53639600
   ASSEMBLE(ADDS 0);                                           <<01592>>53639620
   TOS:= %500;                                                 <<01592>>53639640
   ASSEMBLE(SUBS 0);                                           <<01592>>53639660
                                                               <<01592>>53639680
   CRIT := SETCRITICAL;                                        <<01592>>53639700
                                                               <<01592>>53639720
   ORIG'DST:= EXCHANGEDB(0);  << save old DST number >>        <<01592>>53639740
                                                               <<01592>>53639760
   << grab ACB >>                                              <<01592>>53639780
   ACB'FLAGS := STATUS;                                        <<01592>>53639800
   ACB'FLAGS.(1:15):=0;  <<  Privmode check only            >> <<01592>>53639820
   GET'ACB'Q'LOC;                                              <<01592>>53639840
   LOC'ACB(DSTX, ACBMQ, FILENUM, ACB'FLAGS);                   <<01592>>53639860
   DSTX := TOS;  << LOC'ACB returns DST on TOS >>              <<01592>>53639880
                                                               <<01592>>53639900
   IF < THEN BEGIN                                             <<01592>>53639920
      << invalid file number >>                                <<01592>>53639940
      TOS := INVFN;                                            <<01592>>53639960
      TOS := CCL;                                              <<01592>>53639980
      GO EXIT                                                  <<01592>>53640000
   END;                                                        <<01592>>53640020
   IF > THEN BEGIN                                             <<01592>>53640040
      << $NULL file >>                                         <<01592>>53640060
      TOS := 0;  <<no error>>                                  <<01592>>53640080
      TOS := CCE;                                              <<01592>>53640100
      GO EXIT                                                  <<01592>>53640120
   END;                                                        <<01592>>53640140
   IF NOT VALIDFILETYPE THEN BEGIN                             <<01592>>53640160
     << MAKETEMP works only on types defined as valid >>       <<01592>>53640180
     TOS:= UNIMPL;                                             <<01592>>53640200
     TOS:= CCL;                                                <<01592>>53640220
     << Note: no need to release ACB if not valid type >>      <<01592>>53640240
     << because LOC'ACB only works on MSG+Conventional >>      <<01592>>53640260
     GO EXIT;                                                  <<01592>>53640280
   END;                                                        <<01592>>53640300
   IF ACBACCCL<>DIRACC OR ACBSPOOLED OR ACBDTYPE=FDISC THEN    <<01592>>53640320
     BEGIN                                                     <<01592>>53640340
     TOS := DEVVIOL;                                           <<01592>>53640360
     TOS := CCL;                                               <<01592>>53640380
     GO RELEASE'ACB;                                           <<01592>>53640400
   END;                                                        <<01592>>53640420
                                                               <<01592>>53640440
   B := GETSIR(FISIR);  <<get file SIR now!>>                  <<01592>>53640460
                                                               <<01592>>53640480
   << grab FCB >>                                              <<01592>>53640500
   ALLOC'C'FCB;   << Alloc. min FCB w/o full extent map.    >> <<01592>>53640520
   GET'FCB'Q'LOC;                                              <<01592>>53640540
   LOCK'CB(0,0,FCBMQ,ACBFCB);                                  <<01592>>53640560
   FCB'CB'ADDR := DS1;        << Save the FCB addresses for >> <<01592>>53640580
   FCB'STK'ADDR := DS3;       << update back to the FCB CB. >> <<01592>>53640600
   TOS := SIZECFCB;           << Min. FCB plus 1st. extent. >> <<01592>>53640620
   MOVE'DS'5;                 << Copy FCB to our stack.     >> <<01592>>53640640
   DEL;                       << Delete FLAGS parameter.    >> <<01592>>53640660
                                                               <<01592>>53640680
   IF FCBOCNT<>1 THEN BEGIN                                    <<01592>>53640700
     << file must be accessed exclusively >>                   <<01592>>53640720
     TOS := MLTIACCERR;                                        <<01592>>53640740
     TOS := CCL;                                               <<01592>>53640760
     GO RELEASE'FCB;                                           <<01592>>53640780
   END;                                                        <<01592>>53640800
                                                               <<01592>>53640820
   << grab FLAB >>                                             <<01592>>53640840
   ALLOCFLAB; << allocate space for FLAB on stack >>           <<01592>>53640860
   TOS := 0;  <<for LDEV>>                                     <<01592>>53640880
   TOS := FCBLABEL;  <<LDEV and SECTOR number>>                <<01592>>53640900
   TOS := TOS&TASL(8)&DLSR(8);  <<separate LDEV>>              <<01592>>53640920
   LABADR := TOS;  <<FLAB SECTOR number>>                      <<01592>>53640940
   DADDR := TOS;  <<FLAB LDEV>>                                <<01592>>53640960
   LABELIO(0);  <<read file label>>                            <<01592>>53640980
                                                               <<01592>>53641000
   << verify that file is indeed old perm >>                   <<01592>>53641020
   IF FLDOMAIN=0 OR FLDOMAIN=2 THEN BEGIN                      <<01592>>53641040
     TOS:= UNDEFFILESD;                                        <<01592>>53641060
     TOS:= CCL;                                                <<01592>>53641080
     GO RELEASE'FCB;                                           <<01592>>53641100
   END;                                                        <<01592>>53641120
   DIRECFINDFILE(0,0D,FLACCTNAME,FLGRPNAME,FLLOCNAME,          <<01592>>53641140
      FILE'INFO,FCBMVTABX);                                    <<01592>>53641160
   IF < THEN BEGIN                                             <<01592>>53641180
     << directory I/O error >>                                 <<01592>>53641200
     TOS:= DIRIOERR;                                           <<01592>>53641220
     TOS:= CCL;                                                <<01592>>53641240
     GO RELEASE'FCB;                                           <<01592>>53641260
     END                                                       <<01592>>53641280
   ELSE IF > THEN BEGIN                                        <<01592>>53641300
     << file is not in the Directory (not perm) >>             <<01592>>53641320
     TOS:= UNDEFFILESD;                                        <<01592>>53641340
     TOS:= CCL;                                                <<01592>>53641360
     GO RELEASE'FCB;                                           <<01592>>53641380
   END; <<if error>>                                           <<01592>>53641400
                                                               <<01592>>53641420
   << add file to temporary job file table >>                  <<01592>>53641440
   TOS:= ADDJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME,BLANK,      <<01592>>53641460
      2,2,FLLABEL);                                            <<01592>>53641480
   ASSEMBLE(TEST);                                             <<01592>>53641500
   RCA:= TOS;                                                  <<01592>>53641520
   IF <> THEN BEGIN                                            <<01592>>53641540
     TOS:= IF RCA=2 THEN DUPNJD ELSE JTFDIROFL;                <<01592>>53641560
     TOS:= CCL;                                                <<01592>>53641580
     GO RELEASE'FCB;                                           <<01592>>53641600
   END;                                                        <<01592>>53641620
                                                               <<01592>>53641640
   << now remove file from directory >>                        <<01592>>53641660
   DRCODE := DIRECPURGEFILE(-FSECTORS(FLAB),0,FLACCTNAME,      <<01592>>53641680
      FLGRPNAME,FLLOCNAME,FCBMVTABX);                          <<01592>>53641700
   IF <> THEN BEGIN                                            <<01592>>53641720
     TOS:= DIRIOERR;                                           <<01592>>53641740
     TOS:= CCL;                                                <<01592>>53641760
     GO RELEASE'FCB;                                           <<01592>>53641780
   END;                                                        <<01592>>53641800
                                                               <<01592>>53641820
   << update and write out file label >>                       <<01592>>53641840
   FLDOMAIN:= 2;  << temp domain >>                            <<01592>>53641860
   FLLASTMOD := CALENDAR;  <<update modification date>>        <<01592>>53641880
   FLMODTIME := CLOCK;     <<modification time>>               <<01592>>53641900
   LABELIO(1);  <<write file label>>                           <<01592>>53641920
                                                               <<01592>>53641940
   << update the FOPTIONS in the FCB and ACB >>                <<01592>>53641960
    FCBDOMAIN:= 2;                                             <<01592>>53641980
    ACBDOMAIN:= 2;                                             <<01592>>53642000
    UPDATEFCB;                                                 <<01592>>53642020
                                                               <<01592>>53642040
   << if we got here things are looking good >>                <<01592>>53642060
   TOS := 0;  <<no error>>                                     <<01592>>53642080
   TOS := CCE;                                                 <<01592>>53642100
                                                               <<01592>>53642120
RELEASE'FCB:                                                   <<01592>>53642140
   UNLOCK'CB(0,ACBFCB);                                        <<01592>>53642160
                                                               <<01592>>53642180
RELEASE'ACB:                                                   <<01592>>53642200
   << Stuff error code into ACB (for FCHECK) >>                <<01592>>53642220
   ACBERROR := S1;                                             <<01592>>53642240
   UNLOC'ACB(ACBMQ,0);  <<release ACB >>                       <<01592>>53642260
   IF B <> -1 THEN RELSIR(FISIR,B);  <<release file SIR>>      <<01592>>53642280
                                                               <<01592>>53642300
EXIT:                                                          <<01592>>53642320
   CONDCODE := TOS;                                            <<01592>>53642340
   EXCHANGEDB(ORIG'DST);                                       <<01592>>53642360
   RESETCRITICAL(CRIT);                                        <<01592>>53642380
   ERROREXIT(1,S0,0)                                           <<01592>>53642400
   END; << FMAKETEMP >>                                        <<01592>>53642420
   BYTE ARRAY TNEWFREF(0:87);  << TEMP. FILE NAME >>           <<09917>>53840000
   LOGICAL EN:=0;                                              <<09792>>53862500
   BYTE POINTER ENVID = EN;                                    <<09792>>53862750
   BYTE BLANK:= " ";                                           <<09792>>54077500
   NTYPE := FNFORMAT(TNEWFREF,FNPTR,GNPTR,ANPTR,LW,ENVID);     <<09792>>55220000
   << ------------------------------------------------------ >><<09917>>55222500
   << If there is an envid specified here or in the case of  >><<09917>>55222750
   << file equation the actual designator has one (checked   >><<09917>>55222760
   << by FQFORMAT), we will flag it as an error. The new name>><<09917>>55222770
   << must be able to fit in directory or JDT temp file table>><<09917>>55222780
   << that may be later kept permanently into the directory. >><<09917>>55222790
   << Envid is recognized by Fopen and File equation table   >><<09917>>55222800
   << in the JDT, but in cannot be in the Directory.         >><<09917>>55222900
   << ------------------------------------------------------ >><<09917>>55223000
         NTYPE:=FQFORMAT(TNEWFREF,FNPTR,GNPTR,ANPTR,LW,ENVID); <<09792>>55240000
   IF EN = 0 THEN   << Check for envid >>                      <<09917>>55280100
      EN := @BLANK  << Envid ptr not used, but just in case >> <<09917>>55280200
   ELSE                                                        <<09917>>55280300
      GO E1;        << may not rename with envid >>            <<09917>>55280400
      TOS := ADDJTENTRY(FLLOCNAME,GNPTR,ANPTR,BLANK,           <<09917>>55670000
                       2,2,LABADRA);                           <<09792>>55670250
            X := REMJTENTRY(FNPTR,GNPTR,ANPTR,BLANK,2,0).(8:8);<<09917>>55875000
   << ----------------------------------------------------- >> <<09792>>56322525
   << Remote File:                                 FTYPE= 9 >> <<09792>>56322530
   << This is for ADVNDS RFA.                               >> <<09792>>56322535
   << Call to RFA'FRENAME, entry point in RFA'CALLS  in     >> <<09792>>56322540
   << filesystem's code, with the new name string and double>> <<09792>>56322545
   << word will be left on TOS, its format is:              >> <<09792>>56322550
   << |--------------------------------|                    >> <<09792>>56322555
   << | error number                   | S-1                >> <<09792>>56322560
   << |--------------------------------|                    >> <<09792>>56322565
   << |                      Cond Code | S                  >> <<09792>>56322570
   << |--------------------------------|                    >> <<09792>>56322575
   <<    S-0  Condition Code                                >> <<09792>>56322580
   <<    S-1  Error number IF S-0 <> CCE                    >> <<09792>>56322585
   <<  NOTE: above format is chosen because of the way      >> <<09792>>56322595
   <<        filesystem code exits through ERROREXIT        >> <<09792>>56322600
   << ----------------------------------------------------- >> <<09792>>56322670
   BEGIN                           << remote file           >> <<09792>>56322750
      IF NOT ADVNDSRFA THEN                                    <<09792>>56322775
      BEGIN                                                    <<09792>>56322800
         TOS := INVFN;                                         <<09792>>56322825
         TOS := CCL;                                           <<09792>>56322850
         GO EXIT;                                              <<09792>>56322875
      END;                                                     <<09792>>56322900
      TOS := RFA'FRENAME(FILENUM,                              <<09792>>56322925
                         @NEWFREF);                            <<09792>>56322950
                                                               <<09792>>56323050
   END;                            << remote file           >> <<09792>>56323075
                                                               <<09792>>56323100
$EDIT VOID=56996000                                                     56996000
   LOGICAL LYNX2 := FALSE;                                     <<*9338>>57060000
   LOGICAL LOGC := FALSE;   << True if LOGCLOSE was called >>  <<*9338>>57065000
$EDIT VOID=57139500                                                     57136000
   BYTE BLANK := " ";                                          <<09792>>57287500
$EDIT VOID=57382000                                                     57382000
           << If global file, DISMOUNT on behalf of pseudo- >> <<09904>>58455100
           << pin -1, since they all come from the same     >> <<09904>>58455200
           << bind names data segment.                      >> <<09904>>58455300
           IF GLOBAL'FILENUM THEN                              <<09904>>58455400
              DISMOUNT (HVSIND, FCBGN, FCBAN, REQTYPE,         <<09904>>58455500
                        FCBPVINFO, -1)                         <<09904>>58455600
           ELSE                                                <<09904>>58455700
              DISMOUNT (HVSIND, FCBGN, FCBAN, REQTYPE,         <<09904>>58460000
                        FCBPVINFO);                            <<09904>>58465000
   IF IOQX <> 0 AND NOT ADVNDSRFA THEN                         <<09792>>59440000
$EDIT VOID=60071700                                                     60071000
                                                               <<F1115>>60297000
            IF NOT LABELERROR THEN <<IF ERR, LEAVE DISP=0>>    <<F1115>>60332000
              BEGIN                                            <<F1115>>60333000
              DISP := IF LOGICAL(ACBSPOOLIO)                   <<F1115>>60335000
                THEN 0   <<OUTPUT: SAVE FILE>>                 <<F1115>>60340000
                ELSE 4;  <<INPUT: DELETE>>                     <<F1115>>60345000
              END;                                             <<F1115>>60347000
         IF DOMAIN = 2 THEN                                    <<09792>>60530000
            REMJTENTRY (ACBNAME,FCBGN,FCBAN,BLANK,2,0);        <<09792>>60532500
            IF NOT LABELERROR AND NOT FLOLDPASS AND DOMAIN = 0 <<F1115>>61840000
              THEN GO REL;                                     <<F1115>>61842000
                              BLANK,2,0).(8:8);                <<09792>>62065000
               TOS:=ADDJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME, <<09792>>62140000
                  BLANK,2,2,FLLABEL);  <<ADD TO JOB DIRECTORY>><<09792>>62145000
REL:                                                           <<R1617>>62236100
            IF (FLLOAD = 1)  THEN                              <<R1617>>62236200
               BEGIN<<FILE IS LOADED AND TRYING TO BE CLOSED >><<R1617>>62236300
                    <<WITH DISPOSITION 4 (DELETE).  CHECK TO >><<R1617>>62236400
                    <<SEE IF THE FILE IS AUTOALLOCATED AND   >><<R1617>>62236500
                    <<NOT BEING USED IT COULD BE UNLOADED    >><<R1617>>62236600
                                                               <<02291>>62236610
               << To avoid deadlocks we need to release most >><<02291>>62236620
               << of our resources (FCB,FISIR,ACB) before we >><<02291>>62236630
               << call DEAL'IF'AUTO because it needs the LST >><<02291>>62236640
               << sir.  By keeping the FMAVT sir and praying,>><<02291>>62236650
               << we can assume things will be OK when we go >><<02291>>62236660
               << back and reaquire everything afterwards. >>  <<02291>>62236670
                                                               <<02291>>62236680
               UNLOCK'CB(0,FCBV);                              <<02291>>62236690
               RELSIR(FISIR,A);                                <<02291>>62236700
               << PACB won't be locked if no LACB exists >>    <<02291>>62236705
               IF LACBV <> 0D THEN UNLOCK'CB(0,PACBV);         <<02291>>62236710
                                                               <<02291>>62236720
               DEALLOC'IF'AUTOALLOC(DADDR,DISKADR,             <<R1889>>62236800
                                    FLFILECODE,0);             <<R1889>>62236810
                                                               <<02291>>62236820
               << We can now reobtain the ACB, FIsir and FCB >><<02291>>62236900
               << in order, trusting that they still exist.  >><<02291>>62236910
               << LABELIO is required to read our FLAB from  >><<02291>>62236920
               << disk again as DEAL'IF'AUTO changes it. >>    <<02291>>62236930
                                                               <<02291>>62236940
               IF LACBV <> 0D THEN BEGIN                       <<02291>>62237000
                  LOCK'CB(0,0,0,PACBV);                        <<02291>>62237050
                  DDEL; DDEL;  << Delete rtn from LOCK'CB >>   <<02291>>62237100
                  END;  << Multiaccess; need to lock >>        <<02291>>62237150
               A := GETSIR(FISIR);                             <<02291>>62237200
               LOCK'CB(0,0,0,FCBV);                            <<02291>>62237300
               DDEL; DDEL;  << Delete return from LOCK'CB >>   <<02291>>62237330
               LABELIO(0);                                     <<02291>>62237340
                                                               <<02291>>62237350
               END; <<THEN FLLOAD = 1>>                        <<R1617>>62237400
                                                               <<R1617>>62237500
            IF FLLOCK&LSR(13) <> 0 OR FCBLKST <> 0 THEN        <<R1617>>62240000
                              BLANK,2,0).(8:8);                <<09792>>62355000
$EDIT VOID=62398100                                                     62396000
         IF MSGFILE THEN                                       <<F1142>>62400000
            FCCLOSE(FILENUM,FCB,FLAB,PDISP,DOMAIN);            <<F1142>>62402000
         IF MSGFILE THEN                                       <<F1142>>62455000
            FCCLOSE(FILENUM,FCB,FLAB,PDISP,DOMAIN);            <<F1142>>62457000
         PDISP := 0;                                           <<F1142>>62460000
      IF NOT LABELERROR AND FLOLDPASS AND (PDISP <> 0) THEN    <<F1115>>62495000
         BEGIN  <<NEW $OLDPASS?>>                              <<F1115>>62500000
      IF NOT LABELERROR AND NOT PURGE THEN                     <<F1115>>62545000
         BEGIN <<WRITE UPDATED FILE LABEL?>>                   <<F1115>>62550000
$EDIT VOID=63137000                                                     63136000
      IF NOT LABELERROR AND NOT ACBSPOOLED THEN                <<02053>>63452000
         BEGIN                                                 <<F1115>>63453000
         MOVE LOG'BUF := FLLOCNAME,(4);     ! File name.       <<F1115>>63455000
         TOS := @LOG'BUF(4)*2+1;                               <<F1115>>63460000
         TOS := @FLGRPNAME*2;                                  <<F1115>>63465000
         MOVE * := *,(8);                   ! Group name.      <<F1115>>63470000
         MOVE LOG'BUF(9) := FLACCTNAME,(4); ! Account name.    <<F1115>>63475000
         FADDR := FSECTORS(FLAB)                               <<F1115>>63480000
         END                                                   <<F1115>>63480500
      ELSE  <<LABELERROR; CAN NOT USE FLAB FOR LOGGING INFO>>  <<F1115>>63481000
      << if spoolfile, should not use FLAB because it does >>  <<02053>>63481100
      << not contain the file name: use ACB instead >>         <<02053>>63481200
         BEGIN                                                 <<F1115>>63481500
         MOVE LOG'BUF := ACBNAME,(4);     <<FILE NAME>>        <<F1115>>63482000
         TOS := @LOG'BUF(4)*2+1;                               <<F1115>>63482500
         TOS := @FCBGN*2;                                      <<F1115>>63483000
         MOVE * := *,(8);                 <<GROUP NAME>>       <<F1115>>63483500
         MOVE LOG'BUF(9) := FCBAN,(4);    <<ACCOUNT NAME>>     <<F1115>>63484000
         <<CALCULATE # SECTORS IN FILE>>                       <<F1115>>63484500
         FADDR := 0D;                                          <<F1115>>63484700
         TOS := @FCBEXTMAP;  <<EXTENT ENTRY POINTER>>          <<F1115>>63485000
         TOS := FCBNUMEXTS;  <<EXTENT COUNTER>>                <<F1115>>63485500
         DO BEGIN                                              <<F1115>>63486000
            IF DPS1 <> 0D THEN  <<EXTENT ALLOCATED?>>          <<F1115>>63486500
               BEGIN                                           <<F1115>>63487000
               TOS := 0;  << HIGH ORDER EXTENT SIZE >>         <<F1115>>63487500
               IF S1 = 0 THEN        <<LAST EXTENT?>>          <<F1115>>63488000
                  TOS := FCBLASTEXTSIZE                        <<F1115>>63488500
               ELSE                  <<REGULAR EXTENT>>        <<F1115>>63489000
                  TOS := FCBEXTSIZE;                           <<F1115>>63489100
               FADDR := FADDR +TOS;  <<ADD TO TOTAL>>          <<F1115>>63489200
               END;                                            <<F1115>>63489300
            ASSEMBLE(INCB,INCB; DECA)<<INC EXT #, DEC EXT CNT>><<F1115>>63489400
            END UNTIL <                                        <<F1115>>63489500
         END;                                                  <<F1115>>63489600
      END                                                      <<F1115>>63489700
      FADDR := 0D                                              <<F1115>>63515000
$EDIT VOID=63525000                                            <<F1115>>63525000
$EDIT VOID=63966100                                                     63966000
      IF PDISP <> 0 THEN                                       <<11610>>64030000
         DISP := PDISP;   << USE PENDING DISP >>               <<11610>>64035000
$EDIT VOID=64087750                                                     64081000
      CHECKXFER;                                               <<D2649>>64085000
   << ----------------------------------------------------- >> <<09792>>64287525
   << Remote File:                                 FTYPE= 9 >> <<09792>>64287530
   << This is for remote file using DSII Application Service>> <<09792>>64287535
   << to do RFA. Call to RFA'FCLOSE, entry point in         >> <<09792>>64287540
   << RFA'CALLS in filesystem's code, will leave a double   >> <<09792>>64287545
   << word on TOS, they are:                                >> <<09792>>64287550
   << |--------------------------------|                    >> <<09792>>64287555
   << | error number                   | S-1                >> <<09792>>64287560
   << |--------------------------------|                    >> <<09792>>64287565
   << |                       Cond Code| S                  >> <<09792>>64287570
   << |--------------------------------|                    >> <<09792>>64287575
   <<    S-0  Bits 14:2 contain Condition Code              >> <<09792>>64287580
   <<    S-1  Error number if failure was ADVNDS related    >> <<09792>>64287585
   <<  NOTE: above format is chosen because of the way      >> <<09792>>64287595
   <<        filesystem code exits through ERROREXIT        >> <<09792>>64287600
   <<                                                       >> <<09792>>64287605
   << ----------------------------------------------------- >> <<09792>>64287670
   BEGIN                                << remote file      >> <<09792>>64287672
      IF NOT ADVNDSRFA THEN                                    <<09792>>64287750
      BEGIN                                                    <<09792>>64287775
         TOS := INVFN;                                         <<09792>>64287800
         TOS := CCL;                                           <<09792>>64287825
         GO EXIT;                                              <<09792>>64287850
      END;                                                     <<09792>>64287875
                                                               <<09792>>64287900
      TOS := RFA'FCLOSE (FILENUM,                              <<09792>>64287925
                         DISP,                                 <<09792>>64287975
                         SECCODE,                              <<09792>>64287980
                         KSC);    << KFCLOSE flag >>           <<09792>>64288000
                                                               <<09792>>64288025
   END;                                 << remote file      >> <<09792>>64288100
                                                               <<09792>>64288125
$EDIT VOID=64306000                                                     64306000
                                                                        65145000
                                                                        65150000
                                                                        65155000
$CONTROL SEGMENT = FILESYS8                                             65155100
$PAGE "FLABINFO SUPPORT PROCEDURES - RESOLVE'NAME"                      65156000
LOGICAL PROCEDURE RESOLVE'NAME(FNAME,MODE,NEWNAME,DIREC'INDEX,          65158000
                                LEVEL,LOCKWORD,HASPV);                  65160000
<< Resolves the file name given file equations and the file name  >>    65162000
<< RETURNS: True if successful, false otherwise                   >>    65164000
<< PARAMETERS:                                                    >>    65166000
<<    FNAME - Formal designator                                   >>    65168000
<<    MODE - File equation mode, 0 - default, 1 - must, 2 - ignore>>    65169000
<<    NEWNAME - (input) Output parameter, actual designator       >>    65170000
<<    DIREC'INDEX - Output parameter, points to the group iff the >>    65172000
<<                  file resides in the caller's home group and   >>    65174000
<<                  account.  Returns zero otherwise.             >>    65176000
<<    LEVEL - Output parameter, level to start direcfind at,      >>    65178000
<<            Possible values are:                                >>    65180000
<<              0 - Start at beginning of directory               >>    65182000
<<              1 - Start at account level                        >>    65184000
<<              2 - Start at group level                          >>    65186000
<<    LOCKWORD - Lockword of the file (if supplies)               >>    65188000
<<    HASPV - Output variable, True iff default group and account >>    65190000
<<            which happen to be a private volume.                >>    65192000
<<****************************************************************>>    65194000
VALUE FNAME, MODE;                                                      65196000
BYTE POINTER FNAME;                                                     65198000
ARRAY NEWNAME;                                                          65200000
INTEGER MODE;                                                           65201000
DOUBLE DIREC'INDEX;                                                     65202000
INTEGER LEVEL;                                                          65204000
ARRAY LOCKWORD;                                                         65206000
LOGICAL HASPV;                                                          65208000
OPTION PRIVILEGED, UNCALLABLE;                                          65210000
                                                                        65212000
BEGIN                                                                   65214000
                                                                        65216000
<< Global variables (general) >>                                        65218000
                                                                        65220000
INTEGER ARRAY NEW'FNAME (*) = NEWNAME;                                  65222000
BYTE ARRAY NEW'FNAME'B (*) = NEW'FNAME;                                 65223000
INTEGER ARRAY NEW'GNAME (*) = NEWNAME(4);                               65224000
BYTE ARRAY NEW'GNAME'B (*) = NEW'GNAME;                                 65225000
INTEGER ARRAY NEW'ANAME (*) = NEWNAME(8);                               65226000
BYTE ARRAY NEW'ANAME'B (*) = NEW'ANAME;                                 65227000
BYTE ARRAY FORMAL'DESIG(0:87);  << Formal designator >>        <<09906>>65230000
LOGICAL RESULT = RESOLVE'NAME;                                          65232000
INTEGER FQ'FDTYPE;               << FQFORMAT formal desig. type >>      65234000
LOGICAL EN:=0;                                                          65234100
BYTE POINTER ENVID = EN;  << environment id name for NS/3000 >>         65234200
BYTE BLANK := " ";                                                      65234300
                                                                        65236000
BYTE ARRAY DEVICE'STRING(0:MAXDEVLEN); << Device string from    >>      65238000
                       << DEV= parameter of file equations      >>      65240000
                                                                        65242000
ARRAY DEVINFO(0:12);   << Device information array              >>      65244000
BYTE ARRAY TEMP'DESIGNATOR(0:87);  << Temporary array >>       <<09906>>65246000
LOGICAL ARRAY DUMMY(0:40);  << Dummy array >>                           65248000
BYTE ARRAY DUM'BA(*) = DUMMY;                                           65248100
LOGICAL ARRAY DUM'LA(*) = DUMMY;                                        65248200
DOUBLE DUM'D = DUMMY;                                                   65248300
LOGICAL DUM'L = DUMMY;                                                  65248400
INTEGER DUM'I = DUMMY;                                                  65248500
                                                                        65248600
EQUATE     << mode equates for file equation >>                <<09979>>65248700
   MODE'NORMAL  = 0,                                           <<09979>>65248710
   MODE'MUSTUSE = 1,                                           <<09979>>65248720
   MODE'IGNORE  = 2;                                           <<09979>>65248730
                                                                        65250000
                                                                        65252000
<< PXGLOBAL defines and variables >>                                    65254000
                                                                        65256000
INTEGER PCBGLOBLOC;  << PCBX Q-relative offset >>                       65258000
INTEGER CRIT;        << Holds critical return  >>                       65260000
INTEGER ARRAY JITINFO (0:23) = Q;  << JIT info buffer >>                65262000
INTEGER JID = JITINFO + 1;         << JOB main pin #  >>                65264000
LOGICAL ASEC = JITINFO + 3;        << Account security bit map >>       65266000
DOUBLE  GSEC = JITINFO + 4;        << Group security bit map   >>       65268000
BYTE ARRAY HANAME (*) = JITINFO(6);<< Home account name        >>       65270000
INTEGER ARRAY HGNAME (*) = JITINFO(10);<< Home group name          >>   65272000
BYTE ARRAY LGNAME (*) = JITINFO(14);<< Logon group name         >>      65274000
BYTE ARRAY USERID (*) = JITINFO(18);<< User name                >>      65276000
LOGICAL ARRAY USERID'L(*) = JITINFO(18);                                65278000
INTEGER ACCTINXPTR = JITINFO+22;   << Account index pointer    >>       65280000
INTEGER GRPINXPTRWD= JITINFO+23;   << Group index pointer      >>       65282000
                                                                        65284000
DOUBLE                                                                  65286000
  ACCTINDEX,                        << Account index >>                 65288000
  GRPINDEX;                         << Group index   >>                 65290000
                                                                        65292000
DEFINE                                                                  65294000
  JITPVF = (0:1)#,                                                      65296000
  JITMTFFF = (1:1)#,                <<INDEX TO APPROPRIATE DOUBLE>>     65298000
  HVSPV = GRPINXPTRWD.JITPVF= 1#,   << Has private volume      >>       65300000
  JITMTFF = GRPINXPTRWD.JITMTFFF#,  << Pointer to double      >>        65302000
  GRPINXPTR = GRPINXPTRWD.(8:8)#;   << Group index ptr >>               65304000
                                                                        65306000
$PAGE "FLABELINFO SUPPORT PROCEDURES - SETDEFAULTS SUBROUTINE"          65308000
SUBROUTINE SETDEFAULTS(FORMAL'DESIG'TYPE,LEVEL,DIREC'INDEX,HASPV);      65310000
<< Moves in the default group and account names.  Also moves in the >>  65312000
<< account index, and the group index into the group index array.   >>  65314000
<< PARAMETERS:  FORMAL'DESIG'TYPE (input) - Formal designator type  >>  65316000
<<              Has the following possible values:                  >>  65318000
<<                0 - Fully qualified                               >>  65320000
<<                1 - Account name missing                          >>  65322000
<<                2 - Group name and account name missing           >>  65324000
<<                3 - Is not returned                               >>  65326000
<<                4 - Invalid file name                             >>  65328000
<<              LEVEL - output parameter, File name level, has the  >>  65330000
<<                      above possible values and meanings          >>  65332000
<<              DIREC'INDEX (output), directory pointer index       >>  65334000
<<              HASPV (output), True if default grp, acct is PV     >>  65336000
<< GLOBALS:                                                         >>  65338000
<<    HANAME (unchanged)                                            >>  65340000
<<    LGNAME (unchanged)                                            >>  65342000
<<    NEW'ANAME (unchanged)                                         >>  65344000
<<    NEW'GNAME (unchanged)                                         >>  65346000
<<    ACCTINDEX (unchanged)                                         >>  65348000
<<    GRPINDEX (unchanged)                                          >>  65350000
<<******************************************************************>>  65352000
INTEGER FORMAL'DESIG'TYPE, LEVEL;                                       65354000
LOGICAL HASPV;                                                          65356000
DOUBLE DIREC'INDEX;                                                     65358000
                                                                        65360000
BEGIN                                                                   65362000
<< Set default name >>                                                  65364000
IF FORMAL'DESIG'TYPE >= 1 THEN << Fill in default account name >>       65366000
  MOVE NEW'ANAME'B := HANAME,(8);                                       65368000
IF FORMAL'DESIG'TYPE >= 2 THEN << Fill in the default group name >>     65370000
  MOVE NEW'GNAME'B := LGNAME,(8);                                       65372000
                                                                        65374000
<< Fill in index'pointer >>                                             65376000
                                                                        65378000
LEVEL := 0;                                                             65380000
DIREC'INDEX := 0D;                                                      65382000
                                                                        65384000
HASPV := 0;  << Assume no private volume >>                             65386000
                                                                        65388000
IF (NEW'ANAME'B = HANAME,(8)) THEN       << Can use account index >>    65390000
  BEGIN                                                                 65392000
  LEVEL := 1;                                                           65394000
  DIREC'INDEX := ACCTINDEX;                                             65396000
  IF (NEW'GNAME'B = LGNAME,(8)) THEN                                    65398000
    BEGIN                                                               65400000
    IF HVSPV THEN                                                       65402000
      HASPV := TRUE                                                     65404000
    ELSE                                                                65406000
      BEGIN                                                             65408000
      DIREC'INDEX := GRPINDEX;                                          65410000
      LEVEL := 2;                                                       65412000
      END                                                               65414000
    END                                                                 65416000
$EDIT VOID=65418000                                            <<01399>>65418000
  END;                                                                  65420000
END;                                                                    65422000
                                                                        65424000
$PAGE "FLABELINFO SUPPORT PROCEDURES - INITIALIZE SUBROUTINE"           65426000
SUBROUTINE INITIALIZE;                                                  65428000
<< Initialize all global variables                            >>        65430000
                                                                        65432000
BEGIN                                                                   65434000
                                                                        65436000
RESULT := TRUE;  << Assume true >>                                      65438000
                                                                        65442000
<< First set the pxfile variables >>                                    65444000
                                                                        65446000
PXGLOBAL;     << Set PCBGLOBLOC >>                                      65448000
<< Now move in JIT information    >>                                    65450000
TOS := @JITINFO;                                                        65452000
TOS := PXG'JITDST;                                                      65454000
TOS := JITEOF;                                                          65456000
TOS := 24;                                                              65458000
ASSEMBLE(MFDS 4);                                                       65460000
                                                                        65462000
<< Move in ACCOUNT index >>                                             65464000
                                                                        65466000
TOS := @ACCTINDEX;                                                      65468000
TOS := PXG'JITDST;                                                      65470000
TOS := ACCTINXPTR;                                                      65472000
TOS := 2;                                                               65474000
ASSEMBLE(MFDS 4);                                                       65476000
                                                                        65478000
<< Move in GROUP index >>                                               65480000
                                                                        65482000
TOS := @GRPINDEX;                                                       65484000
TOS := PXG'JITDST;                                                      65486000
TOS := GRPINXPTR + (JITMTFF &LSL (1));                                  65488000
TOS := 2;                                                               65490000
ASSEMBLE(MFDS 4);                                                       65492000
END;  << Initialize >>                                                  65494000
                                                                        65496000
$PAGE "FLABELINFO SUPPORT PROCEDURES - CHECK'BACKREF SUBROUTINE"        65497000
LOGICAL SUBROUTINE CHECK'BACKREF (FORMAL'DESIG, MODE);         <<09979>>65497010
   BYTE ARRAY FORMAL'DESIG;                                    <<09979>>65497020
   INTEGER MODE;                                               <<09979>>65497030
                                                               <<09979>>65497040
<<----------------------------------------------------------->><<09979>>65497050
<< CHECK'BACKREF checks for a "*" specifying back reference  >><<09979>>65497060
<< to a file equation.  If "*" is the first character of the >><<09979>>65497070
<< formal designator, the MODE must not be ignore file       >><<09979>>65497080
<< equations (2).  The "*" is moved out of the formal desig- >><<09979>>65497090
<< nator before calling FNFORMAT.                            >><<09979>>65497100
<<                                                           >><<09979>>65497101
<< Parameters:  FORMAL'DESIG - formal designator             >><<09979>>65497102
<<              MODE - file equation use                     >><<09979>>65497103
<<                     0 = normal                            >><<09979>>65497104
<<                     1 = must use                          >><<09979>>65497105
<<                     2 = ignore file equation              >><<09979>>65497106
<<----------------------------------------------------------->><<09979>>65497110
                                                               <<09979>>65497120
BEGIN                                                          <<09979>>65497130
                                                               <<09979>>65497140
CHECK'BACKREF := TRUE;                                         <<09979>>65497170
IF INTEGER (FORMAL'DESIG) = %52 THEN   << "*"? >>              <<09979>>65497180
   BEGIN                                                       <<09979>>65497190
   IF MODE = MODE'IGNORE THEN                                  <<09979>>65497200
      CHECK'BACKREF := FALSE                                   <<09979>>65497210
   ELSE  << move * out >>                                      <<09979>>65497220
      MOVE FORMAL'DESIG := FORMAL'DESIG(1), (87);              <<09979>>65497230
   END;                                                        <<09979>>65497240
END;                                                           <<09979>>65497300
$PAGE "FLABELINFO SUPPORT PROCEDURES - CHECK'FILEEQ SUBROUTINE"         65498000
LOGICAL SUBROUTINE CHECK'FILEEQ(FILE'NAME, GROUP'NAME,                  65500000
                                ACCOUNT'NAME, LEVEL);                   65502000
<< Checks the file equation for this file.  Resets the name if >>       65504000
<< specified by the file equation and insures that an invalid  >>       65506000
<< device was not specified.                                   >>       65508000
<< PARAMETERS: FILE'NAME, GROUP'NAME, ACCOUNT'NAME - Name of   >>       65510000
<<                        file                                 >>       65512000
<<             LEVEL - File specification level:               >>       65514000
<<                     = 1 if account name missing             >>       65516000
<<                     = 2 if account and group name missing   >>       65518000
<<                     = 0 if fully specified                  >>       65520000
<<                     = 4 if no file equation or error        >>       65522000
<< Returns true iff successful                                 >>       65524000
<<                                                             >>       65526000
<< GLOBALS: Dummy parameters DUM's                             >>       65528000
<<          DEVICE'STRING (modified)                           >>       65530000
<<          DEVINFO (modified)                                 >>       65532000
<<          TEMP'DESIGNATOR (modified)                         >>       65534000
<<          ENVID (unchanged)                                  >>       65535000
<<          PMAP (modified)                                    >>       65536000
<<*************************************************************>>       65538000
                                                                        65540000
INTEGER ARRAY FILE'NAME, GROUP'NAME, ACCOUNT'NAME;                      65542000
INTEGER LEVEL;                                                          65544000
                                                                        65546000
BEGIN                                                                   65548000
CHECK'FILEEQ := TRUE;  << Initialize to true >>                         65550000
TEMP'DESIGNATOR(0) := " ";                                              65552000
DEVICE'STRING(0) := " ";  << Initialize return arrays >>                65554000
IF FILECOMVALS(FILE'NAME, GROUP'NAME, ACCOUNT'NAME, ENVID,              65556000
               TEMP'DESIGNATOR, DEVICE'STRING,                          65558000
               DUM'L << FOPT >>, DUM'L << AOPT >>, DUM'I << NBUFS >>,   65560000
               DUM'I << DISP >>, DUM'I << RSIZE >>, DUM'I << NEXTS >>,  65562000
               DUM'I << INITALLOC >>, DUM'I << BF >>, DUM'D             65564000
               << FILESIZE >>, DUM'I << FILECODE >>, DUM'L <<STATE>>,   65566000
               DUM'L <<PMAP>>, DUM'BA <<FMSG>>, DUM'LA << DEVPARMS >>,  65568000
               DUM'I << DP'ERROR >>) THEN                               65570000
   BEGIN << Found a file equation !! >>                                 65572000
   IF TEMP'DESIGNATOR(0) <> " " THEN << New designator there ! >>       65574000
      BEGIN                                                             65576000
      LEVEL := FNFORMAT(TEMP'DESIGNATOR, FILE'NAME, GROUP'NAME,         65578000
                        ACCOUNT'NAME, LOCKWORD, ENVID);                 65580000
      IF LEVEL > 2 THEN                                                 65582000
         CHECK'FILEEQ := FALSE;                                         65584000
      END                                                               65586000
   ELSE LEVEL := 4; << No new designator specified >>                   65588000
   IF DEVICE'STRING(0) <> " " THEN << New device string ! >>            65590000
      BEGIN                                                             65592000
      GETDEVINFO(DEVICE'STRING, DEVINFO);                               65594000
      IF < THEN CHECK'FILEEQ := FALSE                                   65596000
      ELSE IF DEVINFO'DEVTYPE & LSR(3) <> 0 THEN  << Not disc >>        65598000
         CHECK'FILEEQ := FALSE;                                         65600000
      END;  << Device class specified >>                                65602000
   END << File equation found >>                                        65604000
ELSE << No file equation >>                                             65606000
   LEVEL := 4;                                                          65608000
END;  << Subroutine CHECK'FILEEQ >>                                     65610000
                                                                        65612000
$PAGE "FLABELINFO SUPPORT PROCEDURES - SET'FILENAME SUBROUTINE"         65614000
LOGICAL SUBROUTINE SET'FILENAME(FDTYPE,NEW'FNAME, NEW'GNAME, NEW'ANAME);65616000
<< Sets the filename using file equations and the filename supplied >>  65618000
<< Returns true iff successful                                      >>  65620000
<< PARAMETER: FDTYPE (output variable) - Formal designator type,    >>  65622000
<<              = 1 if account name missing                         >>  65624000
<<              = 2 if account and group name missing               >>  65626000
<<              = 0 if fully specified                              >>  65628000
<< The resulting file name is in NEW'FNAME, NEW'GNAME, and NEW'ANAME>>  65630000
<<                                                                  >>  65632000
<< GLOBALS:                                                         >>  65634000
<<    FNAME (unchanged)                                             >>  65636000
<<    FORMAL'DESIG (modified)                                       >>  65638000
<<    FQ'FDTYPE (modified)                                          >>  65640000
<<    ENVID (modified)                                              >>  65641000
<<******************************************************************>>  65642000
                                                                        65644000
INTEGER FDTYPE;                                                         65646000
ARRAY NEW'FNAME, NEW'GNAME, NEW'ANAME;                                  65648000
                                                                        65650000
BEGIN                                                                   65652000
SET'FILENAME := FALSE;   << initialize >>                      <<09979>>65654000
MOVE FORMAL'DESIG := FNAME,(88);                               <<09906>>65662000
                                                                        65664000
<< Check for correct combination of back reference and MODE >> <<09979>>65665000
IF CHECK'BACKREF (FORMAL'DESIG, MODE) THEN                     <<09979>>65665100
   BEGIN  << break up formal desig into file, group and acct >><<09979>>65665200
   FDTYPE := FNFORMAT(FORMAL'DESIG,NEW'FNAME,NEW'GNAME,        <<09979>>65666000
                      NEW'ANAME,LOCKWORD,ENVID);               <<09979>>65668000
   IF EN = 0 THEN    << No ENVID should be there, since NS  >> <<09979>>65669000
      BEGIN          << 3000 RFA access is not supported    >> <<09979>>65669100
      EN := @BLANK;                                            <<09979>>65669200
      IF FDTYPE <= 2 THEN                                      <<09979>>65669300
         BEGIN    << valid file name >>                        <<09979>>65670000
         IF MODE <> MODE'IGNORE THEN  << try file equation >>  <<09979>>65672000
            BEGIN                                              <<09979>>65674000
            IF CHECK'FILEEQ (NEW'FNAME, NEW'GNAME, NEW'ANAME,  <<09979>>65676000
                             FQ'FDTYPE) THEN                   <<09979>>65678000
               IF FQ'FDTYPE <= 2 THEN                          <<09979>>65680000
                  BEGIN                                        <<09979>>65682000
                  FDTYPE := FQ'FDTYPE;                         <<09979>>65684000
                  SET'FILENAME := TRUE;                        <<09979>>65686000
                  END                                          <<09979>>65688000
               ELSE                                            <<09979>>65689000
                  IF MODE <> MODE'MUSTUSE THEN                 <<09979>>65689100
                     SET'FILENAME := TRUE;                     <<09979>>65689200
            END                                                <<09979>>65690000
         ELSE    << file name >>                               <<09979>>65692000
            SET'FILENAME := TRUE;                              <<09979>>65694000
         << All other cases erroneous >>                       <<09979>>65696000
         END;                                                  <<09979>>65698000
      END;                                                     <<09979>>65700000
   END;                                                        <<09979>>65702000
END;  << SET'FILENAME >>                                                65704000
                                                                        65706000
<< ********************** Entry Point ******************** >>           65708000
                                                                        65710000
INITIALIZE;                                                             65712000
                                                                        65714000
IF SET'FILENAME(LEVEL,NEW'FNAME, NEW'GNAME, NEW'ANAME) THEN             65716000
  BEGIN                                                                 65718000
  SETDEFAULTS(LEVEL, LEVEL, DIREC'INDEX, HASPV);                        65720000
  RESOLVE'NAME := TRUE;                                                 65722000
  END                                                                   65724000
ELSE                                                                    65726000
  RESOLVE'NAME := FALSE;                                                65728000
END;                                                                    65730000
                                                                        65732000
                                                                        65734000
$PAGE "FLABELINFO INTRINSIC"                                            65736000
$CONTROL SEGMENT = FILESYS8                                             65737000
PROCEDURE FLABELINFO(FNAME, MODE, MERROR, ITEMS, VALUES, ERRORS);       65738000
                                                                        65740000
VALUE MODE;                                                             65741000
BYTE ARRAY FNAME;                                                       65742000
INTEGER MODE;                                                           65743000
INTEGER MERROR;                                                         65744000
INTEGER ARRAY ITEMS;                                                    65746000
BYTE ARRAY VALUES;                                                      65748000
INTEGER ARRAY ERRORS;                                                   65750000
OPTION PRIVILEGED;                                                      65752000
                                                                        65754000
<<*******************************************************************>> 65756000
<< Returns information on a file without opening that file.          >> 65758000
<< Parameters:                                                       >> 65760000
<<    FNAME - Byte array file name.  May include group name, and     >> 65762000
<<            account name.                                          >> 65764000
<<    MODE - File equation mode.  0 - Use file equation if one exists>> 65766000
<<           1 - Must use a file equation (fail otherwise), 2 -      >> 65768000
<<           ignore any file equations which may exist               >> 65770000
<<                                                                   >> 65774000
<<    MERROR - Master error return.  This variable returns the over- >> 65776000
<<            all success of the procedure.  Possible values are:    >> 65778000
<<              0 - Successful                                       >> 65780000
<<              -1- Some parameter(s) were not successfully processed>> 65782000
<<              >1- The entire call failed.  The number is the file  >> 65784000
<<                  system error number.                             >> 65786000
<<                                                                   >> 65788000
<<    ITEMS - A word array containing the number of the item desired.>> 65790000
<<            The list is terminated by a 0 item number.             >> 65792000
<<                                                                   >> 65794000
<<    VALUES - A byte array returning all the information requested  >> 65796000
<<            by item number in the array ITEMS.  The organization of>> 65798000
<<            the array is determined by ITEMS.  The return values   >> 65800000
<<            are in the same order as the items and the size is of  >> 65802000
<<            each returned value is determined by the particular    >> 65804000
<<            item number.  If there is an error processing a single >> 65806000
<<            item, then the space for the return is undefined (but  >> 65808000
<<            still allocated in the VALUES array.  If the entire    >> 65810000
<<            call failed, then VALUES is undefined.                 >> 65812000
<<            *** NOTE: If size of item returned is only a       00000>>65812100
<<            byte in the FLAB, we need to return a complete     00000>>65812200
<<            word so that languages which need things on        00000>>65812300
<<            word boundaries will be happy.  That way, all      00000>>65812400
<<            values returned will start on word boundaries      00000>>65812500
<<            in the VALUES array.                               00000>>65812600
<<                                                                   >> 65814000
<<    ERRORS - Integer array of error numbers, directly corrosponding>> 65816000
<<            to the item numbers in ITEMS.  If there was no error,  >> 65818000
<<            a 0 is stored for that item, if an error did occur,    >> 65820000
<<            the file system error number is stored for that item.  >> 65822000
<<            If the entire call failed, ERRORS is undefined.        >> 65824000
<<*******************************************************************>> 65826000
                                                                        65828000
BEGIN                                                                   65830000
                                                                        65832000
EQUATE                                                                  65834000
  UBND = -10;   << Uppoer bound for variables >>                        65836000
                                                                        65837000
EQUATE                                                                  65837100
  INTRINSIC'PARAMETER = [10/25,                                         65837200
                         6/6];                                          65837300
                                                                        65837400
                                                                        65838000
ARRAY NEWNAME(0:43);      << Name of actual designator >>      <<09906>>65840000
<< Newname is in the filename (padded to 8 characters) followed         65841000
   by the groupname (padded to 8 characters) followed by the            65841100
   account name (padded to 8 characters) >>                             65841200
BYTE ARRAY NEW'FNAME(*) = NEWNAME;                                      65842000
BYTE ARRAY NEW'GNAME(*) = NEWNAME(4);                                   65844000
BYTE ARRAY NEW'ANAME(*) = NEWNAME(8);                                   65846000
DOUBLE DIREC'INDEX;       << Group index pointer        >>              65848000
DOUBLE DISC'ADDR;         <<Disc address (sector number) of file label>>65850000
INTEGER LDEV;             <<LDEV of device where file label is stored >>65852000
ARRAY FLAB(0:127);        <<File label buffer >>               <<09906>>65854000
DOUBLE ARRAY FLABDBL(*)=FLAB;                                           65856000
BYTE ARRAY FLAB'B(*) = FLAB;                                            65858000
LOGICAL MOUNTED;          <<True if a logical mount was performed >>    65860000
INTEGER INDEX;            <<Temporary index variable>>                  65862000
INTEGER VALUE'SIZE;       <<Size of the value array>>                   65864000
INTEGER LEVEL;            <<Directory level to start search at>>        65866000
LOGICAL SHOULD'MOUNT;     <<True if a mount should be performed>>       65868000
DOUBLE  GSEC;             <<Group security word>>                       65870000
LOGICAL ASEC;             <<Account security word>>                     65872000
INTEGER VALUE'PTR;        <<Local pointer in FILL'VALUES>>              65874000
INTEGER ITEM'NUMBER;      <<Local variable in FILL'VALUES>>             65876000
LOGICAL GLOBAL'ACCESS;    <<Global access bit mask>>                    65878000
LOGICAL GLOBAL'SECURITY;  <<Global security for file>>                  65880000
LOGICAL PRIV'CALL;        <<Called while privileged if true>>           65882000
ENTRY P'FLABELINFO;       <<Entry point for privileged procedure>>      65884000
LOGICAL P1, P2;           <<Temporary parms to ATTACHIO>>               65886000
DOUBLE ATTIO'STATUS;      <<Status returned from attachio>>             65888000
LOGICAL ATTIO'STATUS'L = ATTIO'STATUS;                                  65890000
INTEGER PVINFO;           <<Private volume information>>                65892000
DEFINE MVTABX = PVINFO.(4:4)#;  << Mounted volume table index >>        65894000
INTEGER ARRAY LOCKWORD(0:4); << File lockword >>                        65896000
INTEGER TWO := 2;         <<Guess.>>                                    65898000
INTEGER A;                << return for FISIR >>                        65899000
LOGICAL CRIT;             << setcritical value >>                       65899100
                                                                        65899200
ARRAY USER'LABEL'BUF(0:127);  << user label buffer >>          <<09906>>65899300
BYTE ARRAY B'USER'LABEL'BUF(*) = USER'LABEL'BUF;                        65899400
                                                                        65900000
                                                                        65902000
<< Directory variables >>                                               65904000
                                                                        65906000
ARRAY GROUP'ENTRY(0:GSIZE - 1); << Group entry in directory >>          65908000
LOGICAL STAR := [8/ "*", 8/" "];                                        65910000
EQUATE MOUNT'REQ = 2;           << Unconditional mount >>               65912000
ARRAY FILE'INFO(0:3);           << Information returned from direc>>    65914000
DOUBLE ARRAY D'FILE'INFO(*) = FILE'INFO;                                65916000
INTEGER VTABX;                  << Volume table index             >>    65918000
DOUBLE DIREC'ERROR;             << Error returned from directory  >>    65920000
INTEGER MOUNT'REQUEST := MOUNT'REQ;                                     65922000
INTEGER PCBGLOBLOC;                                                     65924000
LOGICAL ARRAY USERID'L(0:3);                                   <<02055>>65926000
BYTE ARRAY USERID(*)=USERID'L;                                 <<02055>>65928000
                                                                        65930000
                                                                        65932000
$PAGE                                                                   65934000
<<*******************************************************************>> 65936000
<< Following is the info array which contains all the information    >> 65938000
<< about each item possible.                                         >> 65940000
<< Each item has the following format:                               >> 65942000
<<      Size, Byte offset in file label, Security index              >> 65944000
<< The security index is a word describing what is needed to display >> 65946000
<< the specified item.  It's format is as follows:                   >> 65948000
<<   Privileged Mode Call Needed (Bit 15)                            >> 65950000
<<   Manager Capability Needed (Bit 14)                              >> 65952000
<<   Must Be Creator (Bit 13)                                        >> 65954000
<<   Must Have Read or Write Access (Bit 12)                         >> 65956000
<<   Must Have Write Access (Bit 11)                                 >> 65958000
<<   Must Have Read Access (Bit 10)                                  >> 65960000
<<   Bits 0 through 9 are reserved                                   >> 65962000
<<*******************************************************************>> 65964000
                                                                        65966000
EQUATE          << Access constants >>                                  65968000
  ACC'ANY   = 0,              << Anybody can access >>                  65970000
  ACC'P     = 1,              << Privileged access  >>                  65972000
  ACC'P'M   = %3,             << Privileged or manager >>               65974000
  ACC'P'M'C = %7,             << Priv, Manager, or Creator >>           65976000
  ACC'P'M'RW= %13;            << Priv, Manager, or read/write access>>  65978000
                                                                        65980000
EQUATE          << Element definitions >>                               65982000
  ELEMENT'SIZE = 3,                                                     65984000
  SIZE'OFFSET  = 0,                                                     65986000
  OFFSET'OFFSET= 1,                                                     65988000
  ACC'OFFSET   = 2;                                                     65990000
                                                                        65992000
EQUATE          << Global equates for INFO table >>                     65994000
  MIN'ITEM = 1,                                                         65996000
  MAX'ITEM = 26,                                                        65998000
  PARTSIZE = 8,                                                         66000000
  DBLSIZE = 4,                                                          66002000
  LOGSIZE = 2,                                                          66004000
  INTSIZE = 2,                                                          66006000
  BYTESIZE = 1;                                                         66008000
                                                                        66010000
INTEGER ARRAY INFO(*) = PB :=                                           66012000
                                                                        66014000
  <<000>>   0,          0,         ACC'ANY,   <<Head of list   >>       66016000
  <<001>>   PARTSIZE,   0,         ACC'ANY,   <<File Name      >>       66018000
  <<002>>   PARTSIZE,   8,         ACC'ANY,   <<Group Name     >>       66020000
  <<003>>   PARTSIZE,   16,        ACC'ANY,   <<Account Name   >>       66022000
  <<004>>   PARTSIZE,   24,        ACC'P'M'C, <<Creator Name   >>       66024000
  <<005>>   DBLSIZE,    40,        ACC'P'M'C, <<Security Matrix>>       66026000
  <<006>>   LOGSIZE,    46,        ACC'ANY,   <<Creation Date  >>       66028000
  <<007>>   LOGSIZE,    48,        ACC'ANY,   <<Last Access Dte>>       66030000
  <<008>>   LOGSIZE,    50,        ACC'ANY,   <<Last Mod Date  >>       66032000
  <<009>>   INTSIZE,    52,        ACC'ANY,   <<File Code      >>       66034000
  <<010>>   BYTESIZE,   58,        ACC'ANY,   <<#User Labls Wrt>>       66036000
  <<011>>   BYTESIZE,   59,        ACC'ANY,   <<#User Lbls Avil>>       66038000
  <<012>>   DBLSIZE,    60,        ACC'ANY,   <<File Limit     >>       66040000
  <<013>>   LOGSIZE,    72,        ACC'ANY,   <<FOPTIONS       >>       66042000
  <<014>>   LOGSIZE,    74,        ACC'ANY,   <<Record Size    >>       66044000
  <<015>>   LOGSIZE,    76,        ACC'ANY,   <<Block Size     >>       66046000
  <<016>>   BYTESIZE,   79,        ACC'ANY,   <<Num Extents    >>       66048000
  <<017>>   LOGSIZE,    80,        ACC'ANY,   <<Last Ext Size  >>       66050000
  <<018>>   LOGSIZE,    82,        ACC'ANY,   <<Extent Size    >>       66052000
  <<019>>   DBLSIZE,    84,        ACC'ANY,   <<EOF Rec Number >>       66054000
  <<020>>   DBLSIZE,    216,       ACC'ANY,   <<Alloc Time     >>       66056000
  <<021>>   LOGSIZE,    220,       ACC'ANY,   <<Alloc Date     >>       66058000
  <<022>>   DBLSIZE,    232,       ACC'ANY,   <<#open/close rec>>       66060000
  <<023>>   PARTSIZE,   248,       ACC'ANY,   <<Device Name    >>       66062000
  <<024>>   DBLSIZE,    236,       ACC'ANY,  <<Last mod time   >>       66064000
  <<025>>   256,        256,       ACC'P'M'RW,<<First User Labl>>       66065000
  <<026>>   LOGSIZE,      0,       ACC'P;     << security mask >>       66065100
<< items 27 thru 33 are reserved for HPE >>                    <<02055>>66065200
                                                                        66066000
EQUATE  FIRST'SPECIAL'ITEM = 25; << First special item >>               66067000
                                                                        66068000
                                                                        66070000
$PAGE "FLABELINFO INTRINSIC - BOUND'CHECK SUBROUTINE"                   66072000
LOGICAL SUBROUTINE BOUND'CHECK;                                         66074000
<< Check for bounds violation on ERRORS, and VALUES                   >>66076000
BEGIN                                                                   66078000
BOUND'CHECK := TRUE;                                                    66080000
VALUE'SIZE := 0;                                                        66082000
INDEX := 0;                                                             66084000
WHILE ITEMS(INDEX) <> 0 DO                                              66086000
  BEGIN                           << Calculate total size >>            66088000
  IF ITEMS(INDEX) >= MIN'ITEM AND ITEMS(INDEX) <= MAX'ITEM THEN         66090000
    VALUE'SIZE := VALUE'SIZE +                                          66092000
                    INFO(ITEMS(INDEX) * ELEMENT'SIZE + SIZE'OFFSET);    66094000
  INDEX := INDEX + 1;                                                   66096000
  END;                                                                  66098000
<< Must convert byte address to word address >>                         66099000
IF NOT FBNDCHK(@VALUES,-VALUE'SIZE,UBND) THEN                           66100000
  BOUND'CHECK := FALSE;                                                 66102000
IF NOT FBNDCHK(@ERRORS,INDEX,UBND) THEN                                 66104000
  BOUND'CHECK := FALSE;                                                 66106000
END;                                                                    66108000
                                                                        66110000
$PAGE "FLABELINFO INTRINSIC - TRY'MOUNTING SUBROUTINE"                  66112000
LOGICAL SUBROUTINE TRY'MOUNTING(LEVEL, DESIGNATOR, PVINFO, MOUNTED);    66114000
<< Check to see if the designator is a private volume, if it is, mount>>66116000
<< it.                                                                >>66118000
<< RETURNS: True iff successful                                       >>66120000
<< PARAMETERS:  DESIGNATOR (input) - Actual file designator           >>66122000
<<              LEVEL (input) - Level of default for the designator   >>66124000
<<                    0 = Entire designator was specified             >>66126000
<<                    1 = Default group was used                      >>66128000
<<                    2 = Default group and account was used          >>66130000
<<              PVINFO (output) - Private volume info                 >>66132000
<<              MOUNTED (output) - True if a volume was mounted       >>66134000
<<GLOBALS:                                                            >>66136000
<<    SHOULD'MOUNT - Input (true if the volume should be mounted)     >>66138000
<<********************************************************************>>66140000
ARRAY DESIGNATOR;                                                       66142000
LOGICAL PVINFO;                                                         66144000
LOGICAL MOUNTED;                                                        66146000
INTEGER LEVEL;                                                          66148000
                                                                        66150000
BEGIN                                                                   66152000
MOUNTED := FALSE;                                                       66154000
PVINFO := 0;                                                            66156000
IF LEVEL < 2 AND NOT SHOULD'MOUNT THEN                                  66158000
  BEGIN << Check to see if we need to mount by searching the directory>>66160000
  DIREC'ERROR := DIRECFIND(%10, 0D, DESIGNATOR(8), DESIGNATOR(4),       66162000
                           DESIGNATOR, GROUP'ENTRY);                    66164000
  IF = THEN                                                             66166000
    BEGIN << We don't worry about an error here, since if the group is>>66168000
          << missing, we won't mount the disc and the same error will >>66170000
          << occur in the direcfindfile and be reported there.        >>66172000
    SHOULD'MOUNT := GROUP'ENTRY(GLINKAGE).(PVF) = PV;                   66174000
    END;                                                                66176000
  END;                                                                  66178000
                                                                        66180000
IF SHOULD'MOUNT THEN                                                    66182000
  BEGIN                                                                 66184000
  MOUNT(STAR, DESIGNATOR(4), DESIGNATOR(8), MOUNT'REQUEST,              66186000
                             -1, PVINFO);                               66188000
  IF <> THEN                                                            66190000
    TRY'MOUNTING := FALSE                                               66192000
  ELSE                                                                  66194000
    BEGIN                                                               66196000
    MOUNTED := TRUE;                                                    66198000
    TRY'MOUNTING := TRUE;                                               66200000
    END                                                                 66202000
  END                                                                   66204000
ELSE TRY'MOUNTING := TRUE;                                              66206000
END;                                                                    66208000
                                                                        66210000
$PAGE "FLABELINFO INTRINSIC - GET'DISC'ADDRESS SUBROUTINE"              66212000
LOGICAL SUBROUTINE GET'DISC'ADDRESS(ACTUAL'DESIG,DIREC'INDEX,SECTOR,    66214000
                              LDEV,ERROR,MOUNTED,LEVEL,GSEC,ASEC);      66216000
<< Gets disc address and ldev for the file specified by ACTUAL    >>    66218000
<< Returns true iff successful.                                   >>    66220000
<< PARAMETERS:                                                    >>    66222000
<<    ACTUAL'DESIG - Actual designator filename in the form       >>    66224000
<<                    FILE    GROUP   ACCOUNT   (8 chars/field)   >>    66226000
<<    DIREC'INDEX  - Group index pointer (directory pointer)      >>    66228000
<<    SECTOR - Output variable, Sector number of file label       >>    66230000
<<    LDEV - Output variable, Logical device number of file label >>    66232000
<<    ERROR - Output variable, file system error number.          >>    66234000
<<    MOUNTED - True iff a logical mount was done                 >>    66236000
<<    LEVEL - Level of default for the actual designator          >>    66238000
<<            0 = Fully specified                                 >>    66240000
<<            1 = Default logon group used                        >>    66242000
<<            2 = Default logon group and account used            >>    66244000
<<    GSEC - Group security, =-1 if default is used               >>    66246000
<<    ASEC - Account security, -1 if default is used              >>    66248000
<<  GLOBALS:                                                      >>    66250000
<<    FILE'INFO (modified) Used as a local variable               >>    66252000
<<    VTABX (modified) Used as a local variable                   >>    66254000
<<****************************************************************>>    66256000
ARRAY ACTUAL'DESIG;                                                     66258000
DOUBLE DIREC'INDEX, SECTOR;                                             66260000
LOGICAL LDEV, ERROR, MOUNTED, ASEC;                                     66262000
DOUBLE GSEC;                                                            66264000
INTEGER LEVEL;                                                          66266000
                                                                        66268000
BEGIN                                                                   66270000
IF TRY'MOUNTING(LEVEL,ACTUAL'DESIG,PVINFO,MOUNTED) THEN                 66272000
  BEGIN                                                                 66274000
  FILE'INFO(0) := -1;                                                   66276000
  MOVE FILE'INFO(1) := FILE'INFO(0),(3); << Initialize securities >>    66278000
  DIREC'ERROR := DIRECFINDFILE(LEVEL, DIREC'INDEX, ACTUAL'DESIG(8),     66280000
                            ACTUAL'DESIG(4), ACTUAL'DESIG, FILE'INFO);  66282000
  IF <> THEN                                                            66284000
    BEGIN                                                               66286000
    ERROR := UNDEFFILESD;                                               66288000
    GET'DISC'ADDRESS := FALSE;                                          66290000
    END                                                                 66292000
  ELSE                                                                  66294000
    BEGIN                                                               66296000
    VTABX := FILE'INFO(0)&LSR(8);  << Get volume table index >>         66298000
    FILE'INFO(0) := FILE'INFO(0) LAND %377;<< Clear out vtab >>         66300000
    SECTOR := D'FILE'INFO(0);       << Move in sector address >>        66302000
    GSEC := D'FILE'INFO(1);                                             66304000
    ASEC := FILE'INFO(4);                                               66306000
    LDEV := LUN(VTABX,MVTABX);                                          66308000
    GET'DISC'ADDRESS := TRUE;                                           66310000
    END                                                                 66312000
  END                                                                   66314000
ELSE                                                                    66316000
  BEGIN                                                                 66318000
  ERROR := MOUNTPROB;                                                   66320000
  GET'DISC'ADDRESS := FALSE;                                            66322000
  END;                                                                  66324000
END;                                                                    66326000
                                                                        66328000
$PAGE "FLABELINFO INTRINSIC - SET'GLOBAL'ACCESS"                        66330000
SUBROUTINE SET'GLOBAL'ACCESS;                                           66332000
<< Sets the global access variable depending on the securities of the >>66334000
<< file and the entrypoint to the procedure.                          >>66336000
<< GLOBALS:                                                           >>66338000
<<    GLOBAL'ACCESS - (initialized by this procedure)                 >>66340000
<<    ASEC - (unchanged) Account security (=-1 if home account)       >>66342000
<<    GSEC - (unchanged) Group security (=-1 if home group)           >>66344000
<<    FLAB - (unchanged) File label (contains the file security)      >>66346000
<<    PRIV - (unchanged) True if entered via priv mode                >>66348000
<<********************************************************************>>66350000
BEGIN                                                                   66352000
PXGLOBAL;                                                               66354000
<< Get user id from JIT >>                                              66356000
TOS := @USERID'L;                                                       66358000
TOS := PXG'JITDST;                                                      66360000
TOS := JITUN;                     << Jit username offset >>             66362000
TOS := 4;                                                               66364000
ASSEMBLE(MFDS 4);                                                       66366000
                                                                        66368000
<< Get default account and group security >>                            66370000
                                                                        66372000
IF LEVEL > 1 THEN                                                       66374000
  BEGIN                                                                 66376000
  TOS := @ASEC;                                                         66378000
  TOS := PXG'JITDST;                                                    66380000
  TOS := JITASEC;                                                       66382000
  TOS := 1;                                                             66384000
  ASSEMBLE(MFDS 4);                                                     66386000
  END;                                                                  66388000
                                                                        66390000
IF LEVEL > 0 THEN                                                       66392000
  BEGIN                                                                 66394000
  TOS := @GSEC;                                                         66396000
  TOS := PXG'JITDST;                                                    66398000
  TOS := JITGSEC;                                                       66400000
  TOS := 2;                                                             66402000
  ASSEMBLE(MFDS 4);                                                     66404000
  END;                                                                  66406000
                                                                        66408000
IF NOT LOGICAL(FLSECURE) THEN                                           66410000
  GLOBAL'SECURITY := ASEC LOR %76     << R, A, W, L, X BUT NO S>>       66412000
ELSE                                                                    66414000
  GLOBAL'SECURITY := ACCCHECK(0, NEW'ANAME, ASEC, NEW'GNAME, GSEC,      66416000
                              FLUSERID, FLSECMX);                       66418000
                                                                        66420000
GLOBAL'ACCESS := 0;   << Initialize >>                                  66421000
<< PRIV'MODE BIT >>                                                     66422000
GLOBAL'ACCESS.(15:1) := PRIV'CALL;                                      66424000
<< MANAGER CAPABILITY BIT >>                                            66426000
GLOBAL'ACCESS.(14:1) := (PXG'USERATTRIBUTES.(0:1) = 1) LOR              66428000
                        (PXG'USERATTRIBUTES.(1:1) = 1 LAND LEVEL > 0);  66430000
<< IS CREATOR BIT >>                                                    66432000
GLOBAL'ACCESS.(13:1) := (FLAB'B(INFO(4*ELEMENT'SIZE+OFFSET'OFFSET))     66434000
                            = USERID,(8));  << Compare userid from>>    66436000
                                            <<JIT to creator name >>    66438000
<< READ OR WRITE ACCESS >>                                              66440000
GLOBAL'ACCESS.(12:1) := INTEGER(GLOBAL'SECURITY.(10:3)) <> 0;           66442000
<< WRITE ACCESS >>                                                      66446000
GLOBAL'ACCESS.(11:1) := (INTEGER(GLOBAL'SECURITY.(11:2)) <> 0);         66448000
<< READ ACCESS >>                                                       66450000
GLOBAL'ACCESS.(10:1) := GLOBAL'SECURITY.(10:1);                         66452000
END;                                                                    66454000
                                                                        66456000
$PAGE "FLABELINFO INTRINSIC - CHECK'ITEM SUBROUTINE"                    66458000
LOGICAL SUBROUTINE CHECK'ITEM(ACCESS,ERROR);                            66460000
<< Checks to make sure the user has access to the particular item   >>  66462000
<< RETURNS: True if the user has access                             >>  66464000
<< PARAMETERS: ACCESS (input) - Access bit mask for the item        >>  66466000
<<             ERROR (output) - Error code for the item, 0 if no    >>  66468000
<<                              error, + is error, - if warning     >>  66470000
<<******************************************************************>>  66472000
VALUE ACCESS;                                                           66474000
LOGICAL ACCESS;                                                         66476000
INTEGER ERROR;                                                          66478000
                                                                        66480000
BEGIN                                                                   66482000
IF ACCESS = 0 OR ((GLOBAL'ACCESS LAND ACCESS) > 0) THEN                 66484000
  BEGIN                                                                 66486000
  CHECK'ITEM := TRUE;                                                   66488000
  ERROR := 0;                                                           66490000
  END                                                                   66492000
ELSE                                                                    66494000
  BEGIN                                                                 66496000
  CHECK'ITEM := FALSE;                                                  66498000
  ERROR := ACCVIOL;                                                     66500000
  END;                                                                  66502000
END;                                                                    66504000
                                                                        66506000
$PAGE "FLABELINFO INTRINSIC - GET'USERLABEL SUBROUTINE"                 66508000
SUBROUTINE GET'USERLABEL(RESULT,ERROR);                                 66510000
<< Reads in a user label from the file and stores it in result  >>      66512000
<< Any error is reported in error.                              >>      66514000
<< PARAMETERS:                                                  >>      66516000
<<             RESULT - Array to store the user label in (mod.) >>      66518000
<<             ERROR - Error number (0 if no error)             >>      66520000
<<**************************************************************>>      66522000
BYTE ARRAY RESULT;                                                      66526000
INTEGER ERROR;                                                          66528000
BEGIN                                                                   66530000
<< NOTE: grab MVTABX from prior MOUNT instead of FLAB >>       <<02289>>66531000
<< because FLAB's value is not kept current.          >>       <<02289>>66531100
IF FLLBLEOF < 1 THEN                                                    66532000
  ERROR := INVOP                                                        66534000
ELSE                                                                    66536000
  BEGIN                                                                 66538000
  IF FLEXTSIZE < 2 THEN                                                 66540000
    BEGIN                                                               66542000
    P1 := FLAB(FLEXTINDEX+2).(8:8) ;  << Remove ldev >>                 66544000
    P2 := FLAB(FLEXTINDEX+3);                                           66546000
    LDEV := LUN(FLAB(FLEXTINDEX+2).(0:8),MVTABX);              <<02289>>66548000
    END                                                                 66550000
  ELSE                                                                  66552000
    BEGIN                                                               66554000
    P1 := FLAB(FLEXTINDEX).(8:8) ;                                      66556000
    P2 := FLAB(FLEXTINDEX+1);                                           66558000
    IF P2 = %177777 THEN  << increment sector number >>                 66559000
       BEGIN                                                            66559100
       P2 := 0;                                                         66559200
       P1 := P1 + 1;                                                    66559300
       END                                                              66559400
    ELSE P2 := P2 + 1;                                                  66559500
    LDEV := LUN(FLAB(FLEXTINDEX).(0:8),MVTABX);                <<02289>>66560000
    END;                                                                66562000
  ATTIO'STATUS := ATTACHIO(LDEV,0,0,@USER'LABEL'BUF,0,                  66564000
                           128, P1, P2, BFLAGS);                        66565000
                                                                        66565100
   MOVE RESULT := B'USER'LABEL'BUF, (256);                              66565200
  IF ATTIO'STATUS'L.(8:8) <> 1 THEN                                     66566000
    ERROR := SYSTEM                                                     66568000
  ELSE                                                                  66570000
    ERROR := 0;                                                         66572000
  END;                                                                  66574000
END;                                                                    66576000
$PAGE "FLABELINFO INTRINSIC - FILL'SPECIAL'VALUE SUBROUTINE"            66576010
SUBROUTINE FILL'SPECIAL'VALUE(ITEM, RESULT, ERROR);                     66576020
<<*******************************************>>                         66576030
<< Reads in any special requested items      >>                         66576040
<< A special item is one which does not      >>                         66576050
<< directly reside in the file label         >>                         66576060
<< RETURNS: nothing                          >>                         66576070
<< PARAMETERS:                               >>                         66576080
<<             RESULT (output) returned value>>                         66576090
<<             ERROR (output) any error cond.>>                         66576100
<<             ITEM (input) item number      >>                         66576101
<<*******************************************>>                         66576110
VALUE ITEM;                                                             66576111
BYTE ARRAY RESULT;                                                      66576130
INTEGER ERROR, ITEM;                                                    66576140
                                                                        66576150
BEGIN                                                                   66576160
                                                                        66576161
ERROR := 0;                                                             66576162
                                                                        66576170
CASE ITEM - FIRST'SPECIAL'ITEM OF                                       66576180
                                                                        66576190
   BEGIN                                                                66576191
   BEGIN  << FILE LABEL >>                                              66576200
   GET'USERLABEL(RESULT, ERROR);                                        66576210
   END;                                                                 66576220
                                                                        66576230
   BEGIN  << SECURITY MASK >>                                           66576240
   TOS := @GLOBAL'ACCESS * 2;  << byte array address >>                 66576250
   MOVE RESULT := *,(2);  << this is to avoid type checking >>          66576251
   END;                                                                 66576260
                                                                        66576270
   END;  << CASE >>                                                     66576280
                                                                        66576290
END;  << FILL'SPECIAL'VALUE >>                                          66576300
                                                                        66578000
$PAGE "FLABELINFO INTRINSIC - FILE'VALUES SUBROUTINE"                   66580000
LOGICAL SUBROUTINE FILL'VALUES(ITEMS, VALUES, ERRORS);                  66582000
<<********************************************************************>>66584000
<< Fills in the values for the items in the item array                >>66586000
<< RETURNS: True iff successful                                       >>66588000
<< PARAMETERS:                                                        >>66590000
<<    ITEMS - (input) Vector containing item numbers                  >>66592000
<<    VALUES- (output) Vector to store results                        >>66594000
<<    ERRORS- (output) Vector containing error numbers                >>66598000
<< GLOBALS:                                                           >>66600000
<<    INDEX - (modified), used as a local variable                    >>66602000
<<    VALUE'PTR - (modified), used as a local varaible                >>66604000
<<    ITEM'NUMBER - (modified), used as a local variable              >>66606000
<<    INFO - (unchanged), global constant datastructure               >>66608000
<<    FLAB, B'FLAB (unchanged), file label                            >>66609000
<<********************************************************************>>66610000
ARRAY ITEMS, ERRORS;                                                    66612000
BYTE ARRAY VALUES;                                                      66614000
                                                                        66616000
BEGIN                                                                   66618000
SET'GLOBAL'ACCESS;                                                      66620000
FILL'VALUES := TRUE;                                                    66622000
INDEX := 0;                                                             66624000
VALUE'PTR := 0;                                                         66626000
WHILE ITEMS(INDEX) <> 0 DO                                              66628000
  BEGIN                                                                 66630000
  ITEM'NUMBER := ITEMS(INDEX);                                          66632000
  IF (ITEM'NUMBER < 0) OR (ITEM'NUMBER > MAX'ITEM) THEN        <<*1606>>66632100
     BEGIN                                                     <<*1606>>66632200
     ERRORS(INDEX) := ILLPARM;                                 <<*1606>>66632300
     FILL'VALUES := FALSE;                                     <<*1606>>66632400
     END                                                       <<*1606>>66632500
  ELSE                                                         <<*1606>>66632600
     BEGIN                                                     <<*1606>>66632700
     IF CHECK'ITEM(INFO(ITEM'NUMBER*ELEMENT'SIZE + ACC'OFFSET),<<*1606>>66634000
                               ERRORS(INDEX)) THEN             <<*1606>>66636000
       BEGIN                                                   <<*1606>>66638000
       IF ITEM'NUMBER >= FIRST'SPECIAL'ITEM THEN               <<*1606>>66639000
          BEGIN  << special handling instructions >>           <<*1606>>66640000
          FILL'SPECIAL'VALUE(ITEM'NUMBER,                      <<*1606>>66641000
                             VALUES(VALUE'PTR), ERRORS(INDEX));<<*1606>>66642000
          IF ERRORS(INDEX) <> 0 THEN FILL'VALUES := FALSE;     <<*1606>>66643000
          END                                                  <<*1606>>66643100
       ELSE BEGIN                                              <<02055>>66644000
         MOVE VALUES(VALUE'PTR) :=                             <<*1606>>66646000
         FLAB'B(INFO(ITEM'NUMBER*ELEMENT'SIZE+OFFSET'OFFSET)), <<*1606>>66648000
               (INFO(ITEM'NUMBER*ELEMENT'SIZE+SIZE'OFFSET));   <<*1606>>66650000
         << If bytesize, need to expand it into a word >>      <<02055>>66650200
         IF INFO(ITEM'NUMBER*ELEMENT'SIZE+SIZE'OFFSET)         <<02055>>66650300
           = BYTESIZE THEN BEGIN                               <<02055>>66650400
           VALUES(VALUE'PTR+1):=VALUES(VALUE'PTR);             <<02055>>66650500
           VALUES(VALUE'PTR):=0;  <<right justify>>            <<02055>>66650600
           END;                                                <<02055>>66650700
         END;                                                  <<02055>>66651000
       END                                                     <<*1606>>66652000
     ELSE FILL'VALUES := FALSE;                                <<*1606>>66653000
     VALUE'PTR := VALUE'PTR+INFO(ITEM'NUMBER*ELEMENT'SIZE+     <<*1606>>66654000
                  SIZE'OFFSET);                                <<*1606>>66655000
     << If bytesize, bump ptr again to keep on word boundary >><<02055>>66655200
     IF INFO(ITEM'NUMBER*ELEMENT'SIZE+SIZE'OFFSET) = BYTESIZE  <<02055>>66655300
       THEN VALUE'PTR:=VALUE'PTR+1;                            <<02055>>66655400
     END;                                                      <<*1606>>66656000
  INDEX := INDEX + 1;                                          <<*1606>>66657000
  END;                                                                  66658000
END;                                                                    66660000
$PAGE "FLABELINFO INTRINSIC - ENTRY POINT"                              66661000
                                                                        66662000
<<*********************************>>                                   66664000
<<***** Entry  *** Point **********>>                                   66666000
<<*********************************>>                                   66668000
                                                                        66670000
                                                                        66672000
PRIV'CALL := FALSE;                                                     66674000
                                                                        66676000
IF PRIV'CALL THEN                                                       66678000
  BEGIN                                                                 66680000
P'FLABELINFO:                                                           66682000
  PRIV'CALL := TRUE;                                                    66684000
  END;                                                                  66686000
                                                                        66688000
ERRORON;                                                                66689000
                                                                        66690000
CHECKDB;                                                                66692000
IF <> THEN                                                              66694000
  BEGIN                                                                 66696000
  CONDCODE := CCL;                                             <<09906>>66697000
  ERROREXIT( INTRINSIC'PARAMETER, [8/1,8/2], 0);                        66698000
  RETURN;                     << Must be at stack >>                    66700000
  END;                                                                  66702000
                                                                        66704000
IF NOT FBNDCHK(@MERROR,1,UBND) THEN                                     66706000
  BEGIN                                                                 66708000
  CONDCODE := CCL;                                             <<09906>>66709000
  ERROREXIT( INTRINSIC'PARAMETER, [8/1, 8/2], 0);                       66710000
  RETURN;                                                               66712000
  END;                                                                  66714000
                                                                        66716000
IF MODE > 2 OR MODE < 0 THEN                                            66716100
   BEGIN                                                                66716200
   CONDCODE := CCL;                                            <<09906>>66716300
   MERROR := ILLPARM;                                          <<09979>>66716400
   RETURN;                                                              66716500
   END;                                                                 66716600
                                                                        66716700
CRIT := SETCRITICAL;                                                    66717000
MERROR := 0;                  << No errors yet!   >>                    66720000
IF NOT BOUND'CHECK THEN                                                 66722000
  MERROR := BNDVIOL           << Bounds violation >>                    66724000
ELSE                                                                    66726000
  BEGIN                                                                 66728000
  IF NOT RESOLVE'NAME(FNAME,MODE,NEWNAME,DIREC'INDEX,LEVEL,LOCKWORD,    66730000
                      SHOULD'MOUNT) THEN                                66732000
    MERROR := INVFREF        << Invalid file reference >>               66734000
  ELSE                                                                  66736000
    BEGIN  << Resolved name >>                                          66738000
    A := GETSIR(FISIR); << make sure file don't go away >>              66739000
    IF GET'DISC'ADDRESS(NEWNAME,DIREC'INDEX,DISC'ADDR,LDEV,MERROR,      66740000
                          MOUNTED,LEVEL, GSEC, ASEC) THEN               66742000
      BEGIN  << Got disc address >>                                     66744000
      IF FLABIO (LDEV, DISC'ADDR, READ, FLAB) > 0 THEN                  66746000
        MERROR := TRANSERR  << Cant think of a better error! >>         66748000
      ELSE                                                              66750000
        IF NOT FILL'VALUES(ITEMS,VALUES,ERRORS) THEN                    66752000
          MERROR := -1;                                                 66754000
      IF MOUNTED THEN                                                   66756000
        BEGIN                                                  <<09906>>66757000
        DISMOUNT(STAR,NEW'GNAME,NEW'ANAME,TWO,PVINFO);                  66758000
        IF <> THEN                                             <<09906>>66759000
           MERROR := DISMOUNTPROB;                             <<09906>>66759100
        END;                                                   <<09906>>66759200
      END;                                                              66760000
    RELSIR(FISIR,A);                                                    66761000
    END;                                                                66762000
  END;                                                                  66764000
                                                               <<09906>>66764100
IF MERROR = 0 THEN                                             <<09906>>66764200
   CONDCODE := CCE                                             <<09906>>66764300
ELSE     << some kind of error occurred >>                     <<09906>>66764400
   CONDCODE := CCL;                                            <<09906>>66764500
RESETCRITICAL(CRIT);                                                    66765000
ERROREXIT(INTRINSIC'PARAMETER, 0, 0);                                   66765100
END;                                                                    66766000
$PAGE "RFA UTILITY PROCEDURES"                                          66768000
$CONTROL SEGMENT = FILESYS8                                             66770000
                                                                        66772000
COMMENT                                                                 66775000
                    Maintenance History                                 66780000
                                                                        66785000
To help facilitate the CPE engineers each fix to the RFA portion        66790000
of this segment must be commented by the engineer implementing a        66795000
fix.  Everyone is strongly urged to follow this rule for posterity.     66800000
The fix submittal number for the original RFA code is:         <<09834>>66805000
                                                                        66810000
 Date      Engineer       Comments                             Fix #    66815000
+-------+ +------------+ +-----------------------------------+ +-------+66820000
02/25/85  John Hahn      Official Submittal of this segment      09834  66824000
03/20/85  Liz  Wei       Fixes DSCHKPLABEL                       09919  66825000
04/30/85  Liz  Wei       Initialize a variable to FALSE          09980  66825001
05/20/85  John Hahn      This fixes three things               <<01183>>66825002
                         1) DSLDEV returned for FGETINFO and   <<01183>>66825003
                         and FFILEINFO are checked and env num <<01183>>66825004
                         is returned in the NS/3000 RFA case   <<01183>>66825005
                         2) we resetcritical for fread's, more <<01183>>66825006
                         details in Notes 2 of RFA'CALLS       <<01183>>66825007
                         3) make Fdevicontrol's target buffer  <<01183>>66825008
                         read data from remote as well as write<<01183>>66825009
                         data to remote                        <<01183>>66825010
                         and some documentation that was left  <<01183>>66825011
                         out initially.                        <<01183>>66825012
06/11/85   John Hahn      1) comments describing the calling   <<01181>>66825015
                         sequence to FREADDIR and FREADBACK-   <<01181>>66825016
                         WARD has the CRIT parm added.         <<01181>>66825017
                          2) What used to be hard coded bit    <<01181>>66825018
                         fields and array offsets to FPARMS,   <<01181>>66825019
                         (the RFA request message), have been  <<01181>>66825020
                         put into DEFINE declarations in RFA'  <<01181>>66825021
                         FOPEN.                                <<01181>>66825022
                          3) There is an old DS/3000 feature   <<01181>>66825023
                         which allows the remote session to    <<01181>>66825024
                         do rev RFA by explicitly specifying   <<01181>>66825025
                         the slave DSDEVICE class/ldev instead <<01181>>66825026
                         of the "DEV=#" deal. NS/3000 unfort-  <<01181>>66825027
                         unately must support this "feature".  <<01181>>66825028
                         User's may specify the local node     <<01181>>66825029
                         name in the DEV parameter (note that  <<01181>>66825030
                         it must fit into the device class     <<01181>>66825031
                         syntax restriction of 8 alphanumeric  <<01181>>66825032
                         chars). So we need to exchange two    <<01181>>66825033
                         pieces of information with RA'SETUP'- <<01181>>66825034
                         ENV procedure. i) we must tell it     <<01181>>66825035
                         if the node specification was in the  <<01181>>66825036
                         device parameter (local node name in  <<01181>>66825037
                         file designator is not allowed, only  <<01181>>66825038
                         "$BACK" for rev RFA), ii) it will     <<01181>>66825039
                         tell us if the node specification is  <<01181>>66825040
                         indeed the local node name associated <<01181>>66825041
                         with "$BACK" environment.             <<01181>>66825042
                          4) RFA request message has another   <<01181>>66825043
                         flag to aid in detecting recursive    <<01181>>66825044
                         fopen loop. If rev RFA a bit (5:1)    <<01181>>66825045
                         will be set in the flags area of the  <<01181>>66825046
                         message header.                       <<01181>>66825047
          11/12/85 John Hahn       Fix will allow the pending disp-     66825100
                                   osition specified at FOPEN time      66825101
                                   in :FILE command (as SAVE, TEMP      66825102
                                   .. etc) to take effect at FCLOSE     66825103
                                   time. The PXFL include file is       66825104
                                   modified for RFA AFT definition.     66825105
                                   FOPEN to RFA'FOPEN calling seq.      66825106
                                   is modified along with procedures    66825107
                                   RFA'FOPEN and RFA'FCLOSE.            66825108
01/06/85   John Hahn      RFA'CIPIN added for a new and better <<01767>>66825110
                          way to get the CI pin #. Otherwise   <<01767>>66825111
                          when NS and/or DS is in use the old  <<01767>>66825112
                          old way of traveling up the process  <<01767>>66825113
                          tree will cause DSSERVER's to go     <<01767>>66825114
                          into an infinite loop.               <<01767>>66825115
                          Also OPTION PRIVILEGED, UNCALLABLE   <<01767>>66825116
                          added to all the RFA interface pro-  <<01767>>66825117
                          cedures that didn't have one.        <<01767>>66825118
                                                                        66830000
; << COMMENT END >>                                                     66835000
                                                                        66840000
$PAGE                                                                   66845000
INTEGER PROCEDURE MAX (A, B);                                           66850000
VALUE A,B;                                                              66855000
INTEGER A,B;                                                            66860000
OPTION INTERNAL, UNCALLABLE;                                            66865000
                                                                        66870000
BEGIN              << of max >>                                         66875000
   MAX := IF A > B THEN                                                 66880000
             A                                                          66885000
          ELSE                                                          66890000
             B;                                                         66895000
END;               << of max >>                                         66900000
$PAGE "-- RFA'CALLS "                                                   66905000
DOUBLE PROCEDURE  RFA'CALLS (RFA'AFTX,                                  66910000
                             P1, P2, P3, P4, P5, P6, P7,                66915000
                             P8, P9, P10, P11, P12, P13, P14);          66920000
VALUE                                                                   66925000
   RFA'AFTX,                                                            66930000
   P1, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, P13, P14;         66935000
                                                                        66940000
INTEGER                                                                 66945000
   RFA'AFTX;                                                            66950000
                                                                        66955000
LOGICAL                                                                 66960000
   P1, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, P13, P14;         66965000
                                                                        66970000
OPTION                                                                  66975000
   UNCALLABLE, PRIVILEGED, VARIABLE;                                    66980000
                                                                        66985000
$EDIT VOID=67165000                                            <<01183>>66985100
COMMENT                                                        <<01183>>66986000
                                                               <<01183>>66987000
*************************************************************  <<01183>>66988000
Function: This is the procedure which will handle most of      <<01183>>66989000
          NS/3000 RFA request cases for the filesystem. The    <<01183>>66990000
          only exceptions are, FOPEN, FCHECK, FGETINFO and     <<01183>>66991000
          FFILEINFO. These intrinsics have their own pro-      <<01183>>66992000
          cedures to handle the RFA traps from the intrinsic   <<01183>>66993000
          procedures.                                          <<01183>>66994000
          Each time a filesystem intrinsic detects that the    <<01183>>66995000
          filenum aft is a NS/3000 RFA case it will call       <<01183>>66996000
          the proper entry point in this procedure. Then       <<01183>>66997000
          few preliminary checks will be done (nowait i/o,     <<01183>>66998000
          irrecoverable datacomm error, user bounds check)     <<01183>>66999000
          The RFA message is then built and the procedure      <<01183>>67000000
          RFA'HANDLER is PCAL'ed (NS is a optional subsystem)  <<01183>>67001000
          to send the request to the remote system.            <<01183>>67002000
                                                               <<01183>>67003000
DB settings: Split Stack calls allowed                         <<01183>>67004000
             Same setting on Entry and Exit                    <<01183>>67005000
                                                               <<01183>>67006000
Parameters: RFA'AFTX - Filenum (AFT entry) for the remote      <<01183>>67007000
                       file                                    <<01183>>67008000
            P1 ~ P14 - Parameters for the intrinsic request    <<01183>>67009000
                       since some are by reference and some    <<01183>>67009100
                       by value this procedure will accept:    <<01183>>67009200
                       by Value parms - passed as is           <<01183>>67010000
                       by Ref parms - DB-rel address           <<01183>>67011000
                       as P1 ~ P14 value parameters to this    <<01183>>67012000
                       procedure.                              <<01183>>67013000
                                                               <<01183>>67014000
Return Value: Double word with tcount on top word and          <<01183>>67015000
              condition code on the bottom word                <<01183>>67016000
                                                               <<01183>>67017000
Notes:                                                         <<01183>>67018000
                                                               <<01183>>67019000
1) the MESSAGE array is allocated Q-direct because of          <<01183>>67020000
   split stack calls and its DB-rel address is passed to       <<01183>>67021000
   rfa'handler.                                                <<01183>>67022000
                                                               <<01183>>67023000
2) for fread-type requests where the user may be waiting       <<01183>>67024000
   for a read that may never complete (terminal reads,         <<01183>>67025000
   read from empty message file) we do a resetcritical         <<01183>>67026000
   with the crit flag passed from filesystem intrinsic         <<01183>>67027000
   so the user's may be able to :BREAK and :ABORT their        <<01183>>67028000
   programs. This is, of cource, provided that the             <<01183>>67029000
   caller of the fread-type intrinsic wasn't setcritical       <<01183>>67030000
   to begin with and only the intrinsic had setcritical.       <<01183>>67031000
                                                               <<01183>>67032000
*************************************************************  <<01183>>67164000
END OF COMMENT;                                                <<01183>>67165000
                                                                        67170000
BEGIN                   << of RFA'CALLS                     >>          67175000
                                                                        67180000
EQUATE                                                                  67185000
   MAX'MESSAGE'LEN = 150;                                               67190000
                                                                        67195000
LOGICAL                                                                 67200000
   PMASK = Q-4;                                                         67205000
DEFINE                                                                  67210000
   PMASK'AFTX   = PMASK.(15:1) #;                                       67215000
                                                                        67220000
INTEGER POINTER                                                         67225000
   USER'DATA'PTR;                                                       67230000
                                                                        67235000
ENTRY                                                                   67240000
   RFA'FCLOSE,                                                          67245000
                                                                        67250000
   RFA'FREAD,                                                           67255000
   RFA'FREADDIR,                                                        67260000
   RFA'FREADBACKWARD,                                                   67265000
   RFA'FREADBYKEY,                                                      67270000
   RFA'FREADC,                                                          67275000
                                                                        67280000
   RFA'FWRITE,                                                          67285000
   RFA'FWRITEDIR,                                                       67290000
   RFA'FUPDATE,                                                         67295000
                                                                        67300000
   RFA'FCONTROL,                                                        67305000
   RFA'FDELETE,                                                         67310000
   RFA'FDEVICECONTROL,                                                  67315000
   RFA'FLOCK,                                                           67320000
   RFA'FPOINT,                                                          67325000
   RFA'FREADLABEL,                                                      67330000
   RFA'FREADSEEK,                                                       67335000
   RFA'FRELATE,                                                         67340000
   RFA'FRENAME,                                                         67345000
   RFA'FSETMODE,                                                        67350000
   RFA'FSPACE,                                                          67355000
   RFA'FUNLOCK,                                                         67360000
   RFA'FWRITELABEL,                                                     67365000
   RFA'FFINDBYKEY,                                                      67370000
   RFA'FFINDN,                                                          67375000
   RFA'FGETKEYINFO,                                                     67380000
   RFA'FREMOVE,                                                         67385000
   RFA'KSPACE,                                                          67390000
   RFA'CALLS'ERR;                                                       67395000
                                                                        67400000
INTEGER                                                                 67405000
   TCOUNT     = RFA'CALLS,                                              67410000
   ERROR'CODE = RFA'CALLS,                                              67415000
   RSTATUS    = RFA'CALLS+1;                                            67420000
                                                                        67425000
ARRAY                                                                   67430000
   AQ'P1(*)   = P1;                                                     67435000
                                                                        67440000
LOGICAL                                                                 67445000
   FLAGS:=0,                                                            67450000
   DLVAL,                                                               67455000
   QVAL,                                                                67460000
   QRELAFTX,                                                            67465000
   RFA'DURING'NW'IO := FALSE;                                  <<09980>>67470000
                                                                        67475000
INTEGER                                                                 67480000
   I,                                                                   67485000
   RFA'STATUS,                                                          67490000
   RETURNADDR,                                                          67495000
   SAVEDST;                                                             67500000
                                                                        67505000
BYTE POINTER                                                            67510000
   BPTR1,                                                               67515000
   BPTR2,                                                               67520000
   BPTR3;                                                               67525000
                                                                        67530000
POINTER                                                                 67535000
   PTR1,                                                                67540000
   PTR2;                                                                67545000
                                                                        67550000
<< DS Plabels >>                                                        67555000
EQUATE                                                                  67560000
   RFA'HANDLER'PLX  = 1;                                                67565000
                                                                        67570000
INTEGER                                                                 67575000
   PLAB'RFA;                                                            67580000
                                                                        67585000
DEFINE                                                                  67590000
   MUST'FCLOSE     = FLAGS.(0:1) #;                                     67595000
<<                                                                      67600000
   array for fopen parms to be passed to RFA'HANDLER                    67605000
                             +------------------------+                 67610000
             MESSAGE(0)      | mesage len    +words   |                 67615000
                             | protocol   /req type   |                 67620000
             FPARMS(0)       | rfa flags  /# fxd parms|                 67625000
             FPARMS(1)       | 1st fixed parm         |                 67630000
                             |                        |                 67635000
                             |                        |                 67640000
             VPARMBPTRS(0)   | last fixed parm        |                 67645000
             VPARMBPTRS(1)   | 1st variable parm ptr  |                 67650000
                             |                        |                 67655000
                             |                        |                 67660000
                             | last variable parm ptr |                 67665000
      BMESSAGE(VPARMBPTRS(0))| 1st variable parm      |                 67670000
      BMESSAGE(VPARMBPTRS(1))| 2nd variable parm      |                 67675000
                             |                        |                 67680000
                             |                        |                 67685000
                             |                        |                 67690000
                             +------------------------+                 67695000
>>                                                                      67700000
POINTER                                                                 67705000
   MSGSTACKADDR, << for split stack calls >>                            67710000
   VPARMBPTRS;   << will point to messege rel byte offsets >>           67715000
INTEGER ARRAY                                                           67720000
   MESSAGE(0:MAX'MESSAGE'LEN-1) = Q;                                    67725000
DOUBLE ARRAY                                                            67730000
   DMESSAGE(*)     = MESSAGE;                                           67735000
BYTE ARRAY                                                              67740000
   BMESSAGE(*)     = MESSAGE;                                           67745000
INTEGER ARRAY                                                           67750000
   FPARMS(*)       = MESSAGE(RFA'FPARMS0);                              67755000
DEFINE                                                                  67760000
   MESSAGE'LEN     = MESSAGE(0) #,                                      67765000
   SET'MESSAGE'PID = MESSAGE(1).(0:8) := RFA'MSG'PID# ;                 67770000
                                                                        67775000
<< ===================== Subroutines ====================== >>          67780000
                                                                        67785000
LOGICAL SUBROUTINE CHECK'IF'ERROR;                                      67790000
<< **********************                                               67795000
   Function: will check if ERROR'CODE is <> 0, if so                    67800000
   error had just occured, so set proper condition code                 67805000
   return TRUE                                                          67810000
   ********************** >>                                            67815000
BEGIN                   << OF CHECK'IF'ERROR                >>          67820000
   CHECK'IF'ERROR := FALSE;                                             67825000
   IF ERROR'CODE <> 0 THEN                                              67830000
   BEGIN                                                                67835000
      IF MUST'FCLOSE THEN                                               67840000
      BEGIN                                                             67845000
         SETAFTACCESS;                                                  67850000
         RELEASE'RFA'AFT;                                               67855000
         STATUS.CC := CCE;                                              67860000
      END                                                               67865000
      ELSE                                                              67870000
         STATUS.CC := CCL;                                              67875000
      CHECK'IF'ERROR := TRUE;                                           67880000
   END;                                                                 67885000
END;                    << OF CHECK'IF'ERROR                >>          67890000
$PAGE                                                                   67895000
<<                                                                      67900000
   The parameters for the subroutine are identical to the               67905000
   one's for DSCHECK and RFA'HANDLER ( ... ).                           67910000
   Therefore we save the return address on TOS at                       67915000
   beginning of this subroutine then the PCAL is made.                  67920000
   All this is done to make the stacking of the parms                   67925000
   a little easier to maintain.                                         67930000
   NOTE:                                                                67935000
   when it comes time to exit from the subroutine there                 67940000
   will be an attempt to execute SXIT N where N is the                  67945000
   number of parms to this subroutine. the problem here                 67950000
   is that these parms were used as parms to the procedure              67955000
   we just called, and which were deleted from stack along              67960000
   with its stack marker. so before the subroutine gets                 67965000
   the chance to do SXIT N we explicitly ask it to do                   67970000
   RETURN 0 so that just the return address is taken off, yes!          67975000
   its kludgey.                                                         67980000
>>                                                                      67985000
INTEGER SUBROUTINE PCAL'DSCHECK (S'RFA'AFTX);                           67990000
VALUE S'RFA'AFTX;                                                       67995000
INTEGER S'RFA'AFTX;                                                     68000000
<< **********************                                               68005000
   Function: call dscheck with the AFTX for this file                   68010000
   it will attempt to map the error codes in word 2,3 to                68015000
   an exiting DS/file system error number                               68020000
   ********************** >>                                            68025000
BEGIN                                                                   68030000
   RETURNADDR := TOS;                                                   68035000
   TOS := DSCHKPLABEL;   << old dscheck plab, Sysdb (%335) >>  <<09919>>68040000
   ASSEMBLE (PCAL 0);                                                   68045000
   << the error number is at tos and dscheck did an EXIT 1 >>           68050000
   TOS := RETURNADDR;                                                   68055000
   RETURN 0;                                                            68060000
END;                                                                    68065000
DOUBLE SUBROUTINE PCAL'RFA'HANDLER (S'REQ,                              68070000
                                    S'AFTX,                             68075000
                                    S'MESSAGE,                          68080000
                                    S'MESSAGE'LEN,                      68085000
                                    S'OUTBUF,                           68090000
                                    S'OUTBUF'LEN,                       68095000
                                    S'INBUF,                            68100000
                                    S'INBUF'LEN);                       68105000
VALUE                                                                   68110000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             68115000
INTEGER                                                                 68120000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             68125000
BYTE ARRAY                                                              68130000
   S'INBUF, S'OUTBUF;                                                   68135000
INTEGER ARRAY                                                           68140000
   S'MESSAGE;                                                           68145000
                                                                        68150000
<< **********************                                               68155000
   Function: to call rfa'handler                                        68160000
   ********************** >>                                            68165000
BEGIN                    << OF PCAL'RFA'HANDLER             >>          68170000
   RETURNADDR := TOS;                                                   68175000
                                                                        68180000
   TOS := PLAB'RFA;                                                     68185000
   ASSEMBLE (PCAL 0); << will have one word return >>                   68190000
                                                                        68195000
   << now there is a double word on TOS which is the funct- >>          68200000
   << ional return from rfa'handler this in turn will become>>          68205000
   << the functional return from this subroutine            >>          68210000
                                                                        68215000
   TOS := RETURNADDR;                                                   68220000
   RETURN 0;                                                            68225000
END;                     << OF PCAL'RFA'HANDLER             >>          68230000
SUBROUTINE INITIALIZE;                                                  68235000
<< **********************                                               68240000
   Function: perform initialization duities                             68245000
   ********************** >>                                            68250000
BEGIN                   << OF INITIALIZE                    >>          68255000
                                                                        68260000
   WHERES'DB;                                                           68265000
   IF = THEN                                                            68270000
      @MSGSTACKADDR := @MESSAGE                                         68275000
   ELSE BEGIN           << else split stack call >>                     68280000
      SAVEDST := EXCHANGEDB (0);                                        68285000
      @MSGSTACKADDR := @MESSAGE;                                        68290000
      EXCHANGEDB (SAVEDST);                                             68295000
   END;                 << else split stack call >>                     68300000
   << misc. variables >>                                                68305000
   RFA'CALLS := 0D;                                                     68310000
   <<--- clear the header part of message array --->>                   68315000
   X := 0;                                                              68320000
   DO                    << we do it this way because of    >>          68325000
      MESSAGE(X) := 0    << split stack considerations      >>          68330000
   UNTIL (X:=X+1) > RFA'HEAD;                                           68335000
   SET'MESSAGE'PID;                                                     68340000
                                                                        68345000
   <<--- AFT pointer --->>                                              68350000
   SETAFTACCESS;                                                        68355000
   IF RFA'AFT'FAILURE THEN                                              68360000
   BEGIN                                                                68365000
      ERROR'CODE := PCAL'DSCHECK (RFA'AFTX);                            68370000
      RETURN;                                                           68375000
   END;                                                                 68380000
   IF RFA'AFT'IOQX <> 0 THEN                                            68385000
      IF NOT RFA'DURING'NW'IO THEN                                      68390000
      BEGIN        << RFA is not allowed for this intrinsic >>          68395000
         << post this error to remote ACB >>                            68400000
         RFA'CALLS'ERR (RFA'AFTX, IOPENDING);                           68405000
         ERROR'CODE := IOPENDING;                                       68410000
         RETURN;                                                        68415000
      END;         << RFA is not allowed for this intrinsic >>          68420000
                                                                        68425000
   << PLABELS >>                                                        68430000
   PLAB'RFA := AS'DSPLABEL (RFA'HANDLER'PLX);                           68435000
   IF PLAB'RFA = 0 THEN                                                 68440000
   BEGIN                                                                68445000
      ERROR'CODE := UNIMPL;                                             68450000
      RETURN;                                                           68455000
   END;                                                                 68460000
END;                    << OF INITIALIZE                    >>          68465000
$PAGE "RFA'CALLS -- FCLOSE "                                            68470000
<< -------------------------------------------------------- >>          68475000
<< FCLOSE                                                   >>          68480000
<<    CALLING SEQUENCE:                                     >>          68485000
<<    DOUBLE PROCEDURE  RFA'FCLOSE (                        >>          68490000
<<                                  AFTX,                   >>          68495000
<<                                  DISPOSITION,            >>          68500000
<<                                  SECURITYCODE,           >>          68505000
<<                                  KFCLOSEFLAG);           >>          68510000
<<    FUNCTIONAL RETURN: none                               >>          68515000
<<                                                          >>          68520000
<<    ALGORITHM:                                            >>          68525000
<<       get newdsplabels                                   >>          68530000
<<       get remotefileid from AFT                          >>          68535000
<<       build message header and call RFA'HANDLER          >>          68540000
<<       if = and lastfile on then disconnect               >>          68545000
<< -------------------------------------------------------- >>          68550000
<< FCLOSE message header format                             >>          68555000
<<                       Req messege      Reply messege     >>          68560000
<<    MESSAGE'LEN      =                                    >>          68565000
<<    MESSAGE(1).(8:8) = RFA'CLO          RFA'CLO           >>          68570000
<<                                                          >>          68575000
<<    FPARMS(0).(8:8)  =  3                1                >>          68580000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          68585000
<<    FPARMS(2)        = disposition                        >>          68590000
<<    FPARMS(3)        = security code                      >>          68595000
<<                                                          >>          68600000
<< -------------------------------------------------------- >>          68605000
RFA'FCLOSE:                                                             68610000
IF P1 = -1 THEN                                                         68615000
   RFA'DURING'NW'IO := TRUE;                                            68620000
INITIALIZE;                                                             68625000
IF CHECK'IF'ERROR THEN RETURN;                                          68630000
                                                                        68635000
MESSAGE(1).REQ := RFA'CLO;                                              68640000
IF P3 THEN           << if KFCLOSE flag ON >>                           68645000
   FPARMS.(3:1) := 1;                                                   68650000
FPARMS(0).(8:8) := 3;                                                   68655000
<< ----------------------------------------------------- >>    <<11610>>68655009
<< If the user had specified the file disposition in the >>    <<11610>>68655010
<< file equation at FOPEN time (SAVE, DEL ..etc), it's   >>    <<11610>>68655020
<< stored in the RFA AFT. The condition for using the    >>    <<11610>>68655030
<< PDISP (pending dispostion) is:                        >>    <<11610>>68655040
<<    PDISP is <> 0                                      >>    <<11610>>68655050
<< ----------------------------------------------------- >>    <<11610>>68655070
SETAFTACCESS;                                                  <<11610>>68655080
I := RFA'AFT'PDISP;    << using I as scratch >>                <<11610>>68655090
IF I <> 0 THEN                                                 <<11610>>68655100
   P1 := I;            << use pending disposition >>           <<11610>>68655110
FPARMS(2) := P1;     << disposition >>                                  68660000
FPARMS(3) := P2;     << sec code >>                                     68665000
MESSAGE'LEN := ((@FPARMS(3) - @MESSAGE)+1)&LSL(1);                      68670000
                                                                        68675000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'CLO,                                 68680000
                               RFA'AFTX,                                68685000
                               MSGSTACKADDR,                            68690000
                               MESSAGE'LEN,                             68695000
                               A'DUMMY, 0,                              68700000
                               A'DUMMY, 0);                             68705000
IF RSTATUS = CCE THEN                                                   68710000
BEGIN                                                                   68715000
   SETAFTACCESS;                                                        68720000
   RELEASE'RFA'AFT;                                                     68725000
END;                                                                    68730000
STATUS.CC := CCE;                                                       68735000
RETURN;                                                                 68740000
$PAGE "RFA'CALLS -- FREAD "                                             68745000
<< -------------------------------------------------------- >>          68750000
<< FREAD                                                    >>          68755000
<<    CALLING SEQUENCE:                                     >>          68760000
<<    DOUBLE PROCEDURE  RFA'FREAD (                         >>          68765000
<<                                 AFTX,                 LV >>          68770000
<<                                 TARGETADDR,           LV >>          68775000
<<                                 TCOUNT,               LV >> <<01183>>68780000
<<                                 CRIT);                LV >> <<01183>>68781000
<<    FUNCTIONAL RETURN: DATALENGTH                         >>          68785000
<<                                                          >>          68790000
<<    ALGORITHM:                                            >>          68795000
<<       get newdsplabel                                    >>          68800000
<<       build message and call RFA'HANDLER                 >>          68805000
<<       set RFA'FREAD to DATALENGTH                        >>          68810000
<< -------------------------------------------------------- >>          68815000
<< FREAD  messege header format:                            >>          68820000
<<                       Req messege      Reply messege     >>          68825000
<<    MESSAGE'LEN      =                                    >>          68830000
<<    MESSAGE(0).(8:8) = RFA'REA          RFA'REA           >>          68835000
<<                                                          >>          68840000
<<    FPARMS(0).(8:8)  =  2                2                >>          68845000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          68850000
<<    FPARMS(2)        = tcount           datalength        >>          68855000
<< -------------------------------------------------------- >>          68860000
RFA'FREAD:                                                              68865000
                                                                        68870000
INITIALIZE;                                                             68875000
IF CHECK'IF'ERROR THEN RETURN;                                          68880000
                                                                        68885000
MESSAGE(1).REQ := RFA'REA;                                              68890000
FPARMS(0).(8:8) := 2;                                                   68895000
FPARMS(2) := P2;   << TCOUNT >>                                         68900000
MESSAGE'LEN := ((@FPARMS(2)-@MESSAGE)+1)&LSL(1);                        68905000
                                                                        68910000
@PTR1 := P1;  << P1 == @TARGET >>                                       68915000
RESETCRITICAL (P3);   << So user may abort if needed >>        <<01183>>68919000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'REA,                                 68920000
                               RFA'AFTX,                                68925000
                               MSGSTACKADDR,                            68930000
                               MESSAGE'LEN,                             68935000
                               A'DUMMY, 0,                              68940000
                               PTR1,       << IN TARGET >>              68945000
                               P2);        << IN TCOUNT >>              68950000
SETCRITICAL;                                                   <<01183>>68951000
SETAFTACCESS;                                                           68955000
IF RFA'AFT'IOQX <> 0 THEN                                               68960000
   TCOUNT := 0                                                          68965000
ELSE                                                                    68970000
   TCOUNT := FPARMS(2);                                                 68975000
STATUS.CC := CCE;                                                       68980000
RETURN;                                                                 68985000
$PAGE "RFA'CALLS -- FREADDIR "                                          68990000
<< -------------------------------------------------------- >>          68995000
<< FREADDIR                                                 >>          69000000
<<    CALLING SEQUENCE:                                     >>          69005000
<<    DOUBLE PROCEDURE  RFA'FREADDIR (                      >>          69010000
<<                                    AFTX,              LV >>          69015000
<<                                    TARGETADDR,        LV >>          69020000
<<                                    TCOUNT,            LV >>          69025000
<<                                    RECNUM0,           LV >>          69030000
<<                                    RECNUM1,           LV >> <<01181>>69035000
<<                                    CRIT);             LV >> <<01181>>69036000
<<    FUNCTIONAL RETURN: DATALENGTH                         >>          69040000
<<                                                          >>          69045000
<<    ALGORITHM:                                            >>          69050000
<<       same as FREAD                                      >>          69055000
<< -------------------------------------------------------- >>          69060000
<< FREAD  messege header format:                            >>          69065000
<<                       Req messege      Reply messege     >>          69070000
<<    MESSAGE'LEN      =                                    >>          69075000
<<    MESSAGE(0).(8:8) = RFA'RDI          RFA'RDI           >>          69080000
<<                                                          >>          69085000
<<    FPARMS(0).(8:8)  =  4                2                >>          69090000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          69095000
<<    FPARMS(2)        = tcount           datalength        >>          69100000
<<    FPARMS(3)        = recnum                             >>          69105000
<<    FPARMS(4)        = recnum                             >>          69110000
<< -------------------------------------------------------- >>          69115000
RFA'FREADDIR:                                                           69120000
                                                                        69125000
INITIALIZE;                                                             69130000
IF CHECK'IF'ERROR THEN RETURN;                                          69135000
                                                                        69140000
MESSAGE(1).REQ := RFA'RDI;                                              69145000
FPARMS(0).(8:8) := 4;                                                   69150000
FPARMS(2) := P2;   << tcount >>                                         69155000
FPARMS(3) := P3;   << recnum0 >>                                        69160000
FPARMS(4) := P4;   << recnum1 >>                                        69165000
MESSAGE'LEN := ((@FPARMS(4)-@MESSAGE)+1)&LSL(1);                        69170000
                                                                        69175000
@PTR1 := P1;  << P1 == @TARGET >>                                       69180000
RESETCRITICAL (P5);  << So user may abort if needed >>         <<01183>>69184000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'RDI,                                 69185000
                               RFA'AFTX,                                69190000
                               MSGSTACKADDR,                            69195000
                               MESSAGE'LEN,                             69200000
                               A'DUMMY, 0,                              69205000
                               PTR1,       << IN TARGET >>              69210000
                               P2);        << IN TCOUNT >>              69215000
SETCRITICAL;                                                   <<01183>>69216000
STATUS.CC := CCE;                                                       69220000
RETURN;                                                                 69225000
$PAGE "RFA'CALLS -- FREADBACKWARD "                                     69230000
<< -------------------------------------------------------- >>          69235000
<< FREADBACKWARD                                            >>          69240000
<<    CALLING SEQUENCE:                                     >>          69245000
<<    DOUBLE PROCEDURE RFA'FREADBACKWARD (                  >>          69250000
<<                                        AFTX,          LV >>          69255000
<<                                        TARGETADDR,    LV >>          69260000
<<                                        TCOUNT,        LV >> <<01181>>69265000
<<                                        CRIT);         LV >> <<01181>>69266000
<<    FUNCTIONAL RETURN: DATALENGTH                         >>          69270000
<<                                                          >>          69275000
<<    ALGORITHM:                                            >>          69280000
<<       same as FREAD                                      >>          69285000
<< -------------------------------------------------------- >>          69290000
<< FREAD  messege header format:                            >>          69295000
<<                       Req messege      Reply messege     >>          69300000
<<    MESSAGE'LEN      =                                    >>          69305000
<<    MESSAGE(0).(8:8) = RFA'RBK          RFA'RBK           >>          69310000
<<                                                          >>          69315000
<<    FPARMS(0).(8:8)  =  2                2                >>          69320000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          69325000
<<    FPARMS(2)        = tcount           datalength        >>          69330000
<< -------------------------------------------------------- >>          69335000
RFA'FREADBACKWARD:                                                      69340000
                                                                        69345000
INITIALIZE;                                                             69350000
IF CHECK'IF'ERROR THEN RETURN;                                          69355000
                                                                        69360000
MESSAGE(1).REQ := RFA'RBK;                                              69365000
FPARMS(0).(8:8) := 2;                                                   69370000
FPARMS(2) := P2;   << tcount >>                                         69375000
MESSAGE'LEN := ((@FPARMS(4)-@MESSAGE)+1)&LSL(1);                        69380000
                                                                        69385000
@PTR1 := P1;  << P1 == @TARGET >>                                       69390000
RESETCRITICAL (P3);  << So user can abort >>                   <<01183>>69391000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'RBK,                                 69395000
                               RFA'AFTX,                                69400000
                               MSGSTACKADDR,                            69405000
                               MESSAGE'LEN,                             69410000
                               A'DUMMY, 0,                              69415000
                               PTR1,       << IN TARGET >>              69420000
                               P2);        << IN TCOUNT >>              69425000
SETCRITICAL;                                                   <<01183>>69426000
SETAFTACCESS;                                                           69430000
IF RFA'AFT'IOQX <> 0 THEN                                               69435000
   TCOUNT := 0                                                          69440000
ELSE                                                                    69445000
   TCOUNT := FPARMS(2);                                                 69450000
STATUS.CC := CCE;                                                       69455000
RETURN;                                                                 69460000
$PAGE "RFA'CALLS -- FREADBYKEY "                                        69465000
<< -------------------------------------------------------- >>          69470000
<< FREADBYKEY:                                              >>          69475000
<<    CALLING SEQUENCE:                                     >>          69480000
<<    DOUBLE PROCEDURE RFA'FREADBYKEY    (                  >>          69485000
<<                                        AFTX,             >>          69490000
<<                                        @TARGET,          >>          69495000
<<                                        TCOUNT,           >>          69500000
<<                                        KEYLOCATION,      >>          69505000
<<                                        @KEYBPTR);        >>          69510000
<<    FUNCTIONAL RETURN: DATALENGTH                         >>          69515000
<<                                                          >>          69520000
<<    ALGORITHM:                                            >>          69525000
<<       same as FREAD                                      >>          69530000
<<    NOTE: the 128 wd key is sent as data                  >>          69535000
<< -------------------------------------------------------- >>          69540000
<< FREAD  messege header format:                            >>          69545000
<<                       Req messege      Reply messege     >>          69550000
<<    MESSAGE'LEN      =                                    >>          69555000
<<    MESSAGE(0).(8:8) = RFA'RBK          RFA'RBK           >>          69560000
<<                                                          >>          69565000
<<    FPARMS(0).(8:8)  =  3                2                >>          69570000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          69575000
<<    FPARMS(2)        = tcount           datalength        >>          69580000
<<    FPARMS(3)        = keylocation                        >>          69585000
<< -------------------------------------------------------- >>          69590000
RFA'FREADBYKEY:                                                         69595000
                                                                        69600000
INITIALIZE;                                                             69605000
IF CHECK'IF'ERROR THEN RETURN;                                          69610000
                                                                        69615000
MESSAGE(1).REQ := RFA'RKY;                                              69620000
FPARMS(0).(8:8) := 3;                                                   69625000
FPARMS(2) := P2;   << tcount >>                                         69630000
FPARMS(3) := P3;   << keylocation >>                                    69635000
                                                                        69640000
MESSAGE'LEN := ((@FPARMS(3)-@MESSAGE)+1)&LSL(1);                        69645000
                                                                        69650000
<< set out byte ptr to the key byte addr passed to us >>                69655000
@BPTR1 := P4;                                                           69660000
@PTR1 := P1;  << P1 == @TARGET >>                                       69665000
                                                                        69670000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'RKY,                                 69675000
                               RFA'AFTX,                                69680000
                               MSGSTACKADDR,                            69685000
                               MESSAGE'LEN,                             69690000
                               BPTR1,      << out target>>              69695000
                               MAXKSAMKEYLEN, << out len>>              69700000
                               PTR1,       << in target >>              69705000
                               P2);        << in tcount >>              69710000
TCOUNT := FPARMS(2);                                                    69715000
STATUS.CC := CCE;                                                       69720000
RETURN;                                                                 69725000
                                                                        69730000
$PAGE "RFA'CALLS -- FREADC       "                                      69735000
<< -------------------------------------------------------- >>          69740000
<< FREADC                                                   >>          69745000
<<    CALLING SEQUENCE:                                     >>          69750000
<<    DOUBLE PROCEDURE  RFA'FREADC (                        >>          69755000
<<                                  AFTX,                   >>          69760000
<<                                  @TARGET,                >>          69765000
<<                                  TCOUNT);                >>          69770000
<<    FUNCTIONAL RETURN: DATALENGTH                         >>          69775000
<<                                                          >>          69780000
<<    ALGORITHM:                                            >>          69785000
<<       same as RFA'FREAD                                  >>          69790000
<< -------------------------------------------------------- >>          69795000
<< messege header format:                                   >>          69800000
<<                       Req messege      Reply messege     >>          69805000
<<    MESSAGE'LEN      =                                    >>          69810000
<<    MESSAGE(0).(8:8) = RFA'RDC          RFA'RDC           >>          69815000
<<                                                          >>          69820000
<<    FPARMS(0).(8:8)  =  2                2                >>          69825000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          69830000
<<    FPARMS(2)        = tcount           datalength        >>          69835000
<< -------------------------------------------------------- >>          69840000
RFA'FREADC:                                                             69845000
                                                                        69850000
INITIALIZE;                                                             69855000
IF CHECK'IF'ERROR THEN RETURN;                                          69860000
                                                                        69865000
MESSAGE(1).REQ := RFA'RDC;                                              69870000
FPARMS(0).(8:8) := 2;                                                   69875000
FPARMS(2) := P2;   << tcount >>                                         69880000
MESSAGE'LEN := ((@FPARMS(2)-@MESSAGE)+1)&LSL(1);                        69885000
                                                                        69890000
@PTR1 := P1;  << P1 == @TARGET >>                                       69895000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'RDC,                                 69900000
                               RFA'AFTX,                                69905000
                               MSGSTACKADDR,                            69910000
                               MESSAGE'LEN,                             69915000
                               A'DUMMY, 0,                              69920000
                               PTR1,       << in target >>              69925000
                               P2);        << in tcount >>              69930000
TCOUNT := FPARMS(2);                                                    69935000
STATUS.CC := CCE;                                                       69940000
RETURN;                                                                 69945000
$PAGE "RFA'CALLS -- FWRITE       "                                      69950000
<< -------------------------------------------------------- >>          69955000
<< FWRITE                                                   >>          69960000
<<    CALLING SEQUENCE:                                     >>          69965000
<<    DOUBLE PROCEDURE  RFA'FWRITE (                        >>          69970000
<<                                  AFTX,                   >>          69975000
<<                                  TARGETADDR,             >>          69980000
<<                                  TCOUNT,                 >>          69985000
<<                                  CONTROL);               >>          69990000
<<    FUNCTIONAL RETURN: none                               >>          69995000
<<                                                          >>          70000000
<<    ALGORITHM:                                            >>          70005000
<<       get dsplabels                                      >>          70010000
<<       build message,call RFA'HANDLER                     >>          70015000
<<       set return variables                               >>          70020000
<< -------------------------------------------------------- >>          70025000
<< FWRITE messege header format:                            >>          70030000
<<                       Req messege      Reply messege     >>          70035000
<<    MESSAGE'LEN                                           >>          70040000
<<    MESSAGE(1).(8:8) = RFA'WRI          RFA'WRI           >>          70045000
<<                                                          >>          70050000
<<    FPARMS(0).(8:8)  =  4                1                >>          70055000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          70060000
<<    FPARMS(2)        = Tcount           ------------------>>          70065000
<<    FPARMS(3)        = control                            >>          70070000
<<    FPARMS(4)        = rfablock                           >>          70075000
<< -------------------------------------------------------- >>          70080000
RFA'FWRITE:                                                             70085000
                                                                        70090000
INITIALIZE;                                                             70095000
IF CHECK'IF'ERROR THEN RETURN;                                          70100000
                                                                        70105000
MESSAGE(1).REQ := RFA'WRI;                                              70110000
FPARMS(0).(8:8) := 4;                                                   70115000
FPARMS(2) := P2;   << TCOUNT >>                                         70120000
FPARMS(3) := P3;   << CONTROL >>                                        70125000
FPARMS(4) := 1;   << future enhancement for rfablock>1 >>               70130000
MESSAGE'LEN := ((@FPARMS(4)-@MESSAGE)+1)&LSL(1);                        70135000
                                                                        70140000
@PTR1 := P1; << P1 == @TARGET >>                                        70145000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'WRI,                                 70150000
                               RFA'AFTX,                                70155000
                               MSGSTACKADDR,                            70160000
                               MESSAGE'LEN,                             70165000
                               PTR1,      << out target >>              70170000
                               P2,        << out tcount >>              70175000
                               A'DUMMY, 0);                             70180000
STATUS.CC := CCE;                                                       70185000
RETURN;                                                                 70190000
$PAGE "RFA'CALLS -- FWRITEDIR    "                                      70195000
<< -------------------------------------------------------- >>          70200000
<< FWRITEDIR                                                >>          70205000
<<    CALLING SEQUENCE:                                     >>          70210000
<<    DOUBLE PROCEDURE  RFA'FWRITEDIR (                     >>          70215000
<<                                     AFTX,                >>          70220000
<<                                     TARGETADDR,          >>          70225000
<<                                     TCOUNT,              >>          70230000
<<                                     RECNUM0,             >>          70235000
<<                                     RECNUM1);            >>          70240000
<<    FUNCTIONAL RETURN: none                               >>          70245000
<<                                                          >>          70250000
<<    ALGORITHM:                                            >>          70255000
<<       same as fwrite                                     >>          70260000
<< -------------------------------------------------------- >>          70265000
<< FWRITE messege header format:                            >>          70270000
<<                       Req messege      Reply messege     >>          70275000
<<    MESSAGE'LEN                                           >>          70280000
<<    MESSAGE(1).(8:8) = RFA'WDI          RFA'WDI           >>          70285000
<<                                                          >>          70290000
<<    FPARMS(0).(8:8)  =  4                1                >>          70295000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          70300000
<<    FPARMS(2)        = Tcount           ------------------>>          70305000
<<    FPARMS(3)        = recnum0                            >>          70310000
<<    FPARMS(4)        = recnum1                            >>          70315000
<< -------------------------------------------------------- >>          70320000
RFA'FWRITEDIR:                                                          70325000
                                                                        70330000
INITIALIZE;                                                             70335000
IF CHECK'IF'ERROR THEN RETURN;                                          70340000
                                                                        70345000
MESSAGE(1).REQ := RFA'WDI;                                              70350000
FPARMS(0).(8:8) := 4;                                                   70355000
FPARMS(2) := P2;   << TCOUNT >>                                         70360000
FPARMS(3) := P3;   << CONTROL >>                                        70365000
FPARMS(4) := P4;                                                        70370000
MESSAGE'LEN := ((@FPARMS(4)-@MESSAGE)+1)&LSL(1);                        70375000
                                                                        70380000
@PTR1 := P1; << P1 == @TARGET >>                                        70385000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'WDI,                                 70390000
                               RFA'AFTX,                                70395000
                               MSGSTACKADDR,                            70400000
                               MESSAGE'LEN,                             70405000
                               PTR1,      << out target >>              70410000
                               P2,        << out tcount >>              70415000
                               A'DUMMY, 0);                             70420000
STATUS.CC := CCE;                                                       70425000
RETURN;                                                                 70430000
$PAGE "RFA'CALLS -- FUPDATE      "                                      70435000
<< -------------------------------------------------------- >>          70440000
<< FUPDATE                                                  >>          70445000
<<    CALLING SEQUENCE:                                     >>          70450000
<<    DOUBLE PROCEDURE  RFA'FUPDATE (                       >>          70455000
<<                                  AFTX,                   >>          70460000
<<                                  TARGETADDR,             >>          70465000
<<                                  TCOUNT);                >>          70470000
<<    FUNCTIONAL RETURN: none                               >>          70475000
<<                                                          >>          70480000
<<    ALGORITHM:                                            >>          70485000
<<       same as FWRITE                                     >>          70490000
<< -------------------------------------------------------- >>          70495000
<< FUPDATE messege header format:                           >>          70500000
<<                       Req messege      Reply messege     >>          70505000
<<    MESSAGE'LEN                                           >>          70510000
<<    MESSAGE(1).(8:8) = RFA'UPD          RFA'UPD           >>          70515000
<<                                                          >>          70520000
<<    FPARMS(0).(8:8)  =  2                1                >>          70525000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          70530000
<<    FPARMS(2)        = Tcount           ------------------>>          70535000
<< -------------------------------------------------------- >>          70540000
RFA'FUPDATE:                                                            70545000
                                                                        70550000
INITIALIZE;                                                             70555000
IF CHECK'IF'ERROR THEN RETURN;                                          70560000
                                                                        70565000
MESSAGE(1).REQ := RFA'UPD;                                              70570000
FPARMS(0).(8:8) := 2;                                                   70575000
FPARMS(2) := P2;   << tcount >>                                         70580000
MESSAGE'LEN := ((@FPARMS(2)-@MESSAGE)+1)&LSL(1);                        70585000
                                                                        70590000
@PTR1 := P1; << P1 == @TARGET >>                                        70595000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'UPD,                                 70600000
                               RFA'AFTX,                                70605000
                               MSGSTACKADDR,                            70610000
                               MESSAGE'LEN,                             70615000
                               PTR1,      << OUT TARGET >>              70620000
                               P2,        << OUT TCOUNT >>              70625000
                               A'DUMMY, 0);                             70630000
STATUS.CC := CCE;                                                       70635000
RETURN;                                                                 70640000
$PAGE "RFA'CALLS -- FCONTROL     "                                      70645000
<< -------------------------------------------------------- >>          70650000
<< FCONTROL                                                 >>          70655000
<<    CALLING SEQUENCE:                                     >>          70660000
<<    DOUBLE PROCEDURE  RFA'FCONTROL (                      >>          70665000
<<                                    AFTX,                 >>          70670000
<<                                    CONTROLCODE,          >>          70675000
<<                                    PARAM);               >>          70680000
<<    FUNCTIONAL RETURN: none                               >>          70685000
<<                                                          >>          70690000
<<    ALGORITHM:                                            >>          70695000
<<       get dsplabels                                      >>          70700000
<<       build message header and call RFA'HANDLER          >>          70705000
<< -------------------------------------------------------- >>          70710000
<< FCONTROL message header format                           >>          70715000
<<                       Req messege      Reply messege     >>          70720000
<<    MESSAGE'LEN      =                                    >>          70725000
<<    MESSAGE(1).(8:8) = RFA'CON          RFA'CON           >>          70730000
<<                                                          >>          70735000
<<    FPARMS(0).(8:8)  =  2                1                >>          70740000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          70745000
<<    FPARMS(2)        = control  code      not used        >>          70750000
<<    FPARMS(3)        = control  parm    control parm      >>          70755000
<< -------------------------------------------------------- >>          70760000
RFA'FCONTROL:                                                           70765000
                                                                        70770000
IF P1 = FCONTROL'ABORTIO THEN                                           70775000
BEGIN                                                                   70780000
   RFA'DURING'NW'IO := TRUE;                                            70785000
   IF RFA'AFT'IOQX = 0 THEN                                             70790000
   BEGIN                                                                70795000
      << post local err to remote ACB >>                                70800000
      RFA'CALLS'ERR (RFA'AFTX, NOIOPENDING2);                           70805000
      ERROR'CODE := NOIOPENDING2;                                       70810000
      RSTATUS.CC := CCL;                                                70815000
      STATUS.CC := CCE;                                                 70820000
      RETURN;                                                           70825000
   END;                                                                 70830000
END;                                                                    70835000
                                                                        70840000
INITIALIZE;                                                             70845000
IF CHECK'IF'ERROR THEN RETURN;                                          70850000
                                                                        70855000
MESSAGE(1).REQ := RFA'CON;                                              70860000
FPARMS(0).(8:8) := 2;                                                   70865000
FPARMS(2) := P1;     << control code >>                                 70870000
FPARMS(3) := P2;     << control parm >>                                 70875000
MESSAGE'LEN := ((@FPARMS(3) - @MESSAGE)+1)&LSL(1);                      70880000
                                                                        70885000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'CON,                                 70890000
                               RFA'AFTX,                                70895000
                               MSGSTACKADDR,                            70900000
                               MESSAGE'LEN,                             70905000
                               A'DUMMY, 0,                              70910000
                               A'DUMMY, 0);                             70915000
<< return fcontrol parm through errorcode/tcount >>                     70920000
ERROR'CODE := FPARMS(3); << control parm >>                             70925000
STATUS.CC := CCE;                                                       70930000
RETURN;                                                                 70935000
$PAGE "RFA'CALLS -- FDELETE      "                                      70940000
<< -------------------------------------------------------- >>          70945000
<< FDELETE                                                  >>          70950000
<<    CALLING SEQUENCE:                                     >>          70955000
<<    DOUBLE PROCEDURE  RFA'FDELETE  (                      >>          70960000
<<                                    AFTX,                 >>          70965000
<<                                    RECNUM0,              >>          70970000
<<                                    RECNUM1,              >>          70975000
<<                                    PARMMASK);            >>          70980000
<<    FUNCTIONAL RETURN: none                               >>          70985000
<<                                                          >>          70990000
<<    ALGORITHM:                                            >>          70995000
<<       same as FCONTROL                                   >>          71000000
<< -------------------------------------------------------- >>          71005000
<< FDELETE  message header format                           >>          71010000
<<                       Req messege      Reply messege     >>          71015000
<<    MESSAGE'LEN      =                                    >>          71020000
<<    MESSAGE(1).(8:8) = RFA'DEL          RFA'DEL           >>          71025000
<<                                                          >>          71030000
<<    FPARMS(0).(8:8)  =  4                1                >>          71035000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          71040000
<<    FPARMS(2)        = recnum0                            >>          71045000
<<    FPARMS(3)        = recnum1                            >>          71050000
<<    FPARMS(4)        = Parmmask                           >>          71055000
<< -------------------------------------------------------- >>          71060000
RFA'FDELETE:                                                            71065000
                                                                        71070000
INITIALIZE;                                                             71075000
IF CHECK'IF'ERROR THEN RETURN;                                          71080000
                                                                        71085000
MESSAGE(1).REQ := RFA'DEL;                                              71090000
FPARMS(0).(8:8) := 3;                                                   71095000
FPARMS(2) := P1;                                                        71100000
FPARMS(3) := P2;                                                        71105000
FPARMS(4) := P3;                                                        71110000
MESSAGE'LEN := ((@FPARMS(4) - @MESSAGE)+1)&LSL(1);                      71115000
                                                                        71120000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'DEL,                                 71125000
                               RFA'AFTX,                                71130000
                               MSGSTACKADDR,                            71135000
                               MESSAGE'LEN,                             71140000
                               A'DUMMY, 0,                              71145000
                               A'DUMMY, 0);                             71150000
STATUS.CC := CCE;                                                       71155000
RETURN;                                                                 71160000
$PAGE "RFA'CALLS -- FDEVICECONTROL "                                    71165000
<< -------------------------------------------------------- >>          71170000
<< FDEVICECONTROL:                                          >>          71175000
<<    CALLING SEQUENCE:                                     >>          71180000
<<    DOUBLE PROCEDURE  RFA'FDEVICECONTROL (                >>          71185000
<<                                          AFTX,           >>          71190000
<<                                          TARGET,         >>          71195000
<<                                          TCOUNT,         >>          71200000
<<                                          CONTROLCODE,    >>          71205000
<<                                          PARM1,          >>          71210000
<<                                          PARM2);         >>          71215000
<<                                                          >>          71220000
<<    FUNCTIONAL RETURN: ERRNUM                             >>          71225000
<<                                                          >>          71230000
<<    NOTES: RFA with Nowait IO pending allowed             >>          71235000
<<           The Target and tcount may mean either a Write  >> <<01183>>71236000
<<           or a Read data operation. So we have to take   >> <<01183>>71237000
<<           care of either cases.                          >> <<01183>>71238000
<<                                                          >>          71240000
<< -------------------------------------------------------- >>          71245000
<<    messege header format:                                >>          71250000
<<                       Req messege      Reply messege     >>          71255000
<<    MESSAGE'LEN      =                                    >>          71260000
<<    MESSAGE(1).(8:8) = RFA'DEV          RFA'DEV           >>          71265000
<<                                                          >>          71270000
<<    FPARMS(0).(8:8)  =  5                2                >>          71275000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          71280000
<<    FPARMS(2)        = Tcount           errnum            >>          71285000
<<    FPARMS(3)        = controlcode      ------------------>>          71290000
<<    FPARMS(4)        = controlparamter1                   >>          71295000
<<    FPARMS(5)        = controlparamter2                   >>          71300000
<< -------------------------------------------------------- >>          71305000
RFA'FDEVICECONTROL:                                                     71310000
                                                                        71315000
RFA'DURING'NW'IO := TRUE;                                               71320000
INITIALIZE;                                                             71325000
IF CHECK'IF'ERROR THEN RETURN;                                          71330000
                                                                        71335000
MESSAGE(1).REQ := RFA'DEV;                                              71340000
FPARMS(0).(8:8) := 5;                                                   71345000
FPARMS(2) := P2;   << tcount >>                                         71350000
FPARMS(3) := P3;   << control code >>                                   71355000
FPARMS(4) := P4;   << parm1 >>                                          71360000
FPARMS(5) := P5;   << parm2 >>                                          71365000
MESSAGE'LEN := ((@FPARMS(5)-@MESSAGE)+1)&LSL(1);                        71370000
                                                                        71375000
@PTR1 := P1; << P1 == @TARGET >>                                        71380000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'DEV,                                 71385000
                               RFA'AFTX,                                71390000
                               MSGSTACKADDR,                            71395000
                               MESSAGE'LEN,                             71400000
                               PTR1,      << out target >>              71405000
                               P2,        << out tcount >>              71410000
                               PTR1,      << in target >>      <<01183>>71415000
                               P2);       << in tcount >>      <<01183>>71416000
ERROR'CODE := FPARMS(2); << possible errnum from remote >>              71420000
STATUS.CC := CCE;                                                       71425000
RETURN;                                                                 71430000
$PAGE "RFA'CALLS -- FLOCK        "                                      71435000
<< -------------------------------------------------------- >>          71440000
<< FLOCK                                                    >>          71445000
<<    CALLING SEQUENCE:                                     >>          71450000
<<    DOUBLE PROCEDURE  RFA'FLOCK    (                      >>          71455000
<<                                    AFTX,                 >>          71460000
<<                                    LOCKCOND);            >>          71465000
<<    FUNCTIONAL RETURN: none                               >>          71470000
<<                                                          >>          71475000
<<    NOTES: RFA with Nowait IO pending allowed             >>          71480000
<<                                                          >>          71485000
<< -------------------------------------------------------- >>          71490000
<< FLCOK    message header format                           >>          71495000
<<                       Req messege      Reply messege     >>          71500000
<<    MESSAGE'LEN      =                                    >>          71505000
<<    MESSAGE(1).(8:8) = RFA'LOK          RFA'LOK           >>          71510000
<<                                                          >>          71515000
<<    FPARMS(0).(8:8)  =  2                1                >>          71520000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          71525000
<<    FPARMS(2)        = Lockcondition                      >>          71530000
<< -------------------------------------------------------- >>          71535000
RFA'FLOCK:                                                              71540000
                                                                        71545000
RFA'DURING'NW'IO := TRUE;                                               71550000
INITIALIZE;                                                             71555000
IF CHECK'IF'ERROR THEN RETURN;                                          71560000
                                                                        71565000
MESSAGE(1).REQ := RFA'LOK;                                              71570000
FPARMS(0).(8:8) := 2;                                                   71575000
FPARMS(2) := P1;                                                        71580000
MESSAGE'LEN := ((@FPARMS(2) - @MESSAGE)+1)&LSL(1);                      71585000
                                                                        71590000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'LOK,                                 71595000
                               RFA'AFTX,                                71600000
                               MSGSTACKADDR,                            71605000
                               MESSAGE'LEN,                             71610000
                               A'DUMMY, 0,                              71615000
                               A'DUMMY, 0);                             71620000
STATUS.CC := CCE;                                                       71625000
RETURN;                                                                 71630000
$PAGE "RFA'CALLS -- FPOINT       "                                      71635000
<< -------------------------------------------------------- >>          71640000
<< FPOINT                                                   >>          71645000
<<    CALLING SEQUENCE:                                     >>          71650000
<<    DOUBLE PROCEDURE  RFA'FPOINT   (                      >>          71655000
<<                                    AFTX,                 >>          71660000
<<                                    RECNUM0,              >>          71665000
<<                                    RECNUM1);             >>          71670000
<<    FUNCTIONAL RETURN: none                               >>          71675000
<<                                                          >>          71680000
<<    ALGORITHM:                                            >>          71685000
<<       same as FCONTROL                                   >>          71690000
<< -------------------------------------------------------- >>          71695000
<< FLCOK    message header format                           >>          71700000
<<                       Req messege      Reply messege     >>          71705000
<<    MESSAGE'LEN      =                                    >>          71710000
<<    MESSAGE(1).(8:8) = RFA'POI          RFA'POI           >>          71715000
<<                                                          >>          71720000
<<    FPARMS(0).(8:8)  =  3                1                >>          71725000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          71730000
<<    FPARMS(2)        = recnum0                            >>          71735000
<<    FPARMS(3)        = recnum1                            >>          71740000
<< -------------------------------------------------------- >>          71745000
RFA'FPOINT:                                                             71750000
                                                                        71755000
INITIALIZE;                                                             71760000
IF CHECK'IF'ERROR THEN RETURN;                                          71765000
                                                                        71770000
MESSAGE(1).REQ := RFA'POI;                                              71775000
FPARMS(0).(8:8) := 3;                                                   71780000
FPARMS(2) := P1;                                                        71785000
FPARMS(3) := P2;                                                        71790000
MESSAGE'LEN := ((@FPARMS(3) - @MESSAGE)+1)&LSL(1);                      71795000
                                                                        71800000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'POI,                                 71805000
                               RFA'AFTX,                                71810000
                               MSGSTACKADDR,                            71815000
                               MESSAGE'LEN,                             71820000
                               A'DUMMY, 0,                              71825000
                               A'DUMMY, 0);                             71830000
STATUS.CC := CCE;                                                       71835000
RETURN;                                                                 71840000
$PAGE "RFA'CALLS -- FREADLABEL   "                                      71845000
<< -------------------------------------------------------- >>          71850000
<< FREADLABEL:                                              >>          71855000
<<    CALLING SEQUENCE:                                     >>          71860000
<<    DOUBLE PROCEDURE  RFA'FREADLABEL (                    >>          71865000
<<                                      AFTX,               >>          71870000
<<                                      TARGET,             >>          71875000
<<                                      TCOUNT,             >>          71880000
<<                                      LABELID,            >>          71885000
<<                                      PMASK);             >>          71890000
<<    FUNCTIONAL RETURN: none                               >>          71895000
<<                                                          >>          71900000
<<    ALGORITHM:                                            >>          71905000
<<       same as FREAD                                      >>          71910000
<< -------------------------------------------------------- >>          71915000
<<    messege header format:                                >>          71920000
<<                       Req messege      Reply messege     >>          71925000
<<    MESSAGE'LEN      =                                    >>          71930000
<<    MESSAGE(1).(8:8) = RFA'RLB          RFA'RLB           >>          71935000
<<                                                          >>          71940000
<<    FPARMS(0).(8:8)  =  4                1                >>          71945000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          71950000
<<    FPARMS(2)        = Tcount                             >>          71955000
<<    FPARMS(3)        = labelID                            >>          71960000
<<    FPARMS(4)        = parametermask                      >>          71965000
<< -------------------------------------------------------- >>          71970000
RFA'FREADLABEL:                                                         71975000
                                                                        71980000
INITIALIZE;                                                             71985000
IF CHECK'IF'ERROR THEN RETURN;                                          71990000
                                                                        71995000
MESSAGE(1).REQ := RFA'RLB;                                              72000000
FPARMS(0).(8:8) := 4;                                                   72005000
FPARMS(2) := P2;   << TCOUNT >>                                         72010000
FPARMS(3) := P3;   << LABEL ID >>                                       72015000
FPARMS(4) := P4;   << PMASK >>                                          72020000
MESSAGE'LEN := ((@FPARMS(4)-@MESSAGE)+1)&LSL(1);                        72025000
                                                                        72030000
@PTR1 := P1;  << P1 == @TARGET >>                                       72035000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'RLB,                                 72040000
                               RFA'AFTX,                                72045000
                               MSGSTACKADDR,                            72050000
                               MESSAGE'LEN,                             72055000
                               A'DUMMY, 0,                              72060000
                               PTR1,       << in target >>              72065000
                               P2);        << in tcount >>              72070000
STATUS.CC := CCE;                                                       72075000
RETURN;                                                                 72080000
                                                                        72085000
$PAGE "RFA'CALLS -- FREADSEEK    "                                      72090000
<< -------------------------------------------------------- >>          72095000
<< FREADSEEK                                                >>          72100000
<<    CALLING SEQUENCE:                                     >>          72105000
<<    DOUBLE PROCEDURE RFA'READSEEK  (                      >>          72110000
<<                                    AFTX,                 >>          72115000
<<                                    RECNUM0,              >>          72120000
<<                                    RECNUM1);             >>          72125000
<<    FUNCTIONAL RETURN: none                               >>          72130000
<<                                                          >>          72135000
<<    ALGORITHM:                                            >>          72140000
<<       same as FCONTROL                                   >>          72145000
<< -------------------------------------------------------- >>          72150000
<< message header format                                    >>          72155000
<<                       Req message      Reply message     >>          72160000
<<    MESSAGE'LEN      =                                    >>          72165000
<<    MESSAGE(1).(8:8) = RFA'RSK          RFA'RSK           >>          72170000
<<                                                          >>          72175000
<<    FPARMS(0).(8:8)  =  3                1                >>          72180000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          72185000
<<    FPARMS(2)        = recnum0                            >>          72190000
<<    FPARMS(3)        = recnum1                            >>          72195000
<< -------------------------------------------------------- >>          72200000
RFA'FREADSEEK:                                                          72205000
                                                                        72210000
INITIALIZE;                                                             72215000
IF CHECK'IF'ERROR THEN RETURN;                                          72220000
                                                                        72225000
MESSAGE(1).REQ := RFA'RSK;                                              72230000
FPARMS(0).(8:8) := 3;                                                   72235000
FPARMS(2) := P1;                                                        72240000
FPARMS(3) := P2;                                                        72245000
MESSAGE'LEN := ((@FPARMS(3) - @MESSAGE)+1)&LSL(1);                      72250000
                                                                        72255000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'RSK,                                 72260000
                               RFA'AFTX,                                72265000
                               MSGSTACKADDR,                            72270000
                               MESSAGE'LEN,                             72275000
                               A'DUMMY, 0,                              72280000
                               A'DUMMY, 0);                             72285000
STATUS.CC := CCE;                                                       72290000
RETURN;                                                                 72295000
$PAGE "RFA'CALLS -- FRELATE      "                                      72300000
<< -------------------------------------------------------- >>          72305000
<< FRELATE                                                  >>          72310000
<<    CALLING SEQUENCE:                                     >>          72315000
<<    DOUBLE PROCEDURE RFA'FRELATE   (                      >>          72320000
<<                                    AFTX,   ( infileid )  >>          72325000
<<                                    OUTFILEID);           >>          72330000
<<    FUNCTIONAL RETURN: none                               >>          72335000
<<                                                          >>          72340000
<<    ALGORITHM:                                            >>          72345000
<<       same as FCONTROL                                   >>          72350000
<< -------------------------------------------------------- >>          72355000
<< message header format                                    >>          72360000
<<                       Req message      Reply message     >>          72365000
<<    MESSAGE'LEN      =                                    >>          72370000
<<    MESSAGE(1).(8:8) = RFA'REL          RFA'REL           >>          72375000
<<                                                          >>          72380000
<<    FPARMS(0).(8:8)  =  2                1                >>          72385000
<<    FPARMS(1)        = InfileID         status/localfileid>>          72390000
<<    FPARMS(2)        = OutfileID                          >>          72395000
<< -------------------------------------------------------- >>          72400000
RFA'FRELATE:                                                            72405000
                                                                        72410000
INITIALIZE;                                                             72415000
IF CHECK'IF'ERROR THEN RETURN;                                          72420000
                                                                        72425000
MESSAGE(1).REQ := RFA'REL;                                              72430000
FPARMS(0).(8:8) := 2;                                                   72435000
                                                                        72440000
<< RFA'HANDLER will figure out the remote file id's from    >>          72445000
<< its lfcb entries. NOTE both MUST be RFA fopen'ed, or else>>          72450000
FPARMS(2) := P1;                                                        72455000
MESSAGE'LEN := ((@FPARMS(2) - @MESSAGE)+1)&LSL(1);                      72460000
                                                                        72465000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'REL,                                 72470000
                               RFA'AFTX,                                72475000
                               MSGSTACKADDR,                            72480000
                               MESSAGE'LEN,                             72485000
                               A'DUMMY, 0,                              72490000
                               A'DUMMY, 0);                             72495000
STATUS.CC := CCE;                                                       72500000
RETURN;                                                                 72505000
$PAGE "RFA'CALLS -- FRENAME      "                                      72510000
<< -------------------------------------------------------- >>          72515000
<< FRENAME                                                  >>          72520000
<<    CALLING SEQUENCE:                                     >>          72525000
<<    DOUBLE PROCEDURE RFA'FREANME   (                      >>          72530000
<<                                    AFTX,                 >>          72535000
<<                                    @NEWNAME);            >>          72540000
<<    FUNCTIONAL RETURN: none                               >>          72545000
<<                                                          >>          72550000
<<    NOTES: RFA while nowait IO pending allowed            >>          72555000
<<                                                          >>          72560000
<< -------------------------------------------------------- >>          72565000
<< message header format                                    >>          72570000
<<                       Req message      Reply message     >>          72575000
<<    MESSAGE'LEN      =                                    >>          72580000
<<    MESSAGE(1).(8:8) = RFA'REN          RFA'REN           >>          72585000
<<                                                          >>          72590000
<<    FPARMS(0).(8:8)  =  1                1                >>          72595000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          72600000
<<    FPARMS(2)        = Newnameptr                         >>          72605000
<<    FPARMS(3)        = End of Parm Ptr                    >>          72610000
<< -------------------------------------------------------- >>          72615000
RFA'FRENAME:                                                            72620000
                                                                        72625000
RFA'DURING'NW'IO := TRUE;                                               72630000
INITIALIZE;                                                             72635000
IF CHECK'IF'ERROR THEN RETURN;                                          72640000
                                                                        72645000
MESSAGE(1).REQ := RFA'REN;                                              72650000
FPARMS(0).(8:8) := 1;                                                   72655000
                                                                        72660000
<< compute byte offset of FPARM(4) relative to MESSAGE array>>          72665000
FPARMS(2) := (@FPARMS(4) - @MESSAGE)&LSL(1);                            72670000
@BPTR1 := P1;                                                           72675000
                                                                        72680000
<< move in new file reference F/L.G.A >>                                72685000
MOVE BMESSAGE( FPARMS(2) ) := BPTR1,(MAXFGALEN);                        72690000
FPARMS(3) := ((FPARMS(2) + MAXFGALEN)/2)&LSL(1);                        72695000
MESSAGE'LEN := FPARMS(3);                                               72700000
                                                                        72705000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'REN,                                 72710000
                               RFA'AFTX,                                72715000
                               MSGSTACKADDR,                            72720000
                               MESSAGE'LEN,                             72725000
                               A'DUMMY, 0,                              72730000
                               A'DUMMY, 0);                             72735000
STATUS.CC := CCE;                                                       72740000
RETURN;                                                                 72745000
$PAGE "RFA'CALLS -- FSETMODE     "                                      72750000
<< -------------------------------------------------------- >>          72755000
<< FSETMODE                                                 >>          72760000
<<    CALLING SEQUENCE:                                     >>          72765000
<<    DOUBLE PROCEDURE RFA'FSETMODE  (                      >>          72770000
<<                                    AFTX,                 >>          72775000
<<                                    MODEFLAGES);          >>          72780000
<<    FUNCTIONAL RETURN: none                               >>          72785000
<<                                                          >>          72790000
<<    ALGORITHM:                                            >>          72795000
<<       same as FCONTROL                                   >>          72800000
<< -------------------------------------------------------- >>          72805000
<< message header format                                    >>          72810000
<<                       Req message      Reply message     >>          72815000
<<    MESSAGE'LEN      =                                    >>          72820000
<<    MESSAGE(1).(8:8) = RFA'SMD          RFA'SMD           >>          72825000
<<                                                          >>          72830000
<<    FPARMS(0).(8:8)  =  2                1                >>          72835000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          72840000
<<    FPARMS(2)        = Modeflags                          >>          72845000
<< -------------------------------------------------------- >>          72850000
RFA'FSETMODE:                                                           72855000
                                                                        72860000
INITIALIZE;                                                             72865000
IF CHECK'IF'ERROR THEN RETURN;                                          72870000
                                                                        72875000
MESSAGE(1).REQ := RFA'SMD;                                              72880000
FPARMS(0).(8:8) := 2;                                                   72885000
FPARMS(2) := P1;                                                        72890000
MESSAGE'LEN := ((@FPARMS(2) - @MESSAGE)+1)&LSL(1);                      72895000
                                                                        72900000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'SMD,                                 72905000
                               RFA'AFTX,                                72910000
                               MSGSTACKADDR,                            72915000
                               MESSAGE'LEN,                             72920000
                               A'DUMMY, 0,                              72925000
                               A'DUMMY, 0);                             72930000
STATUS.CC := CCE;                                                       72935000
RETURN;                                                                 72940000
$PAGE "RFA'CALLS -- FSPACE       "                                      72945000
<< -------------------------------------------------------- >>          72950000
<< FSPACE algorithm:                                        >>          72955000
<<    CALLING SEQUENCE:                                     >>          72960000
<<    DOUBLE PROCEDURE RFA'FSPACE    (                      >>          72965000
<<                                    AFTX,                 >>          72970000
<<                                    DISPLACEMENT);        >>          72975000
<<    FUNCTIONAL RETURN: none                               >>          72980000
<<                                                          >>          72985000
<<    ALGORITHM:                                            >>          72990000
<<       same as FCONTROL                                   >>          72995000
<< -------------------------------------------------------- >>          73000000
<< message header format                                    >>          73005000
<<                       Req message      Reply message     >>          73010000
<<    MESSAGE'LEN      =                                    >>          73015000
<<    MESSAGE(1).(8:8) = RFA'SPA          RFA'SPA           >>          73020000
<<                                                          >>          73025000
<<    FPARMS(0).(8:8)  =  2                1                >>          73030000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          73035000
<<    FPARMS(2)        = Displacement                       >>          73040000
<< -------------------------------------------------------- >>          73045000
RFA'FSPACE:                                                             73050000
                                                                        73055000
INITIALIZE;                                                             73060000
IF CHECK'IF'ERROR THEN RETURN;                                          73065000
                                                                        73070000
MESSAGE(1).REQ := RFA'SPA;                                              73075000
FPARMS(0).(8:8) := 2;                                                   73080000
FPARMS(2) := P1;                                                        73085000
MESSAGE'LEN := ((@FPARMS(2) - @MESSAGE)+1)&LSL(1);                      73090000
                                                                        73095000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'SPA,                                 73100000
                               RFA'AFTX,                                73105000
                               MSGSTACKADDR,                            73110000
                               MESSAGE'LEN,                             73115000
                               A'DUMMY, 0,                              73120000
                               A'DUMMY, 0);                             73125000
STATUS.CC := CCE;                                                       73130000
RETURN;                                                                 73135000
$PAGE "RFA'CALLS -- FUNLOCK      "                                      73140000
<< -------------------------------------------------------- >>          73145000
<< FUNLOCK:                                                 >>          73150000
<<    CALLING SEQUENCE:                                     >>          73155000
<<    DOUBLE PROCEDURE RFA'FUNLOCK   (                      >>          73160000
<<                                    AFTX);                >>          73165000
<<    FUNCTIONAL RETURN: none                               >>          73170000
<<                                                          >>          73175000
<<    NOTES: RFA while Nowait IO pending is allowed         >>          73180000
<<                                                          >>          73185000
<< -------------------------------------------------------- >>          73190000
<< message header format                                    >>          73195000
<<                       Req message      Reply message     >>          73200000
<<    MESSAGE'LEN      =                                    >>          73205000
<<    MESSAGE(1).(8:8) = RFA'ULK          RFA'ULK           >>          73210000
<<                                                          >>          73215000
<<    FPARMS(0).(8:8)  =  1                1                >>          73220000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          73225000
<< -------------------------------------------------------- >>          73230000
RFA'FUNLOCK:                                                            73235000
                                                                        73240000
RFA'DURING'NW'IO := TRUE;                                               73245000
INITIALIZE;                                                             73250000
IF CHECK'IF'ERROR THEN RETURN;                                          73255000
                                                                        73260000
MESSAGE(1).REQ := RFA'ULK;                                              73265000
FPARMS(0).(8:8) := 1;                                                   73270000
MESSAGE'LEN := ((@FPARMS(1) - @MESSAGE)+1)&LSL(1);                      73275000
                                                                        73280000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'ULK,                                 73285000
                               RFA'AFTX,                                73290000
                               MSGSTACKADDR,                            73295000
                               MESSAGE'LEN,                             73300000
                               A'DUMMY, 0,                              73305000
                               A'DUMMY, 0);                             73310000
STATUS.CC := CCE;                                                       73315000
RETURN;                                                                 73320000
$PAGE "RFA'CALLS -- FWRITELABEL  "                                      73325000
<< -------------------------------------------------------- >>          73330000
<< FWRITELABEL:                                             >>          73335000
<<    CALLING SEQUENCE:                                     >>          73340000
<<    DOUBLE PROCEDURE  RFA'FWRITELABEL (                   >>          73345000
<<                                       AFTX,              >>          73350000
<<                                       TARGET,            >>          73355000
<<                                       TCOUNT,            >>          73360000
<<                                       LABELID,           >>          73365000
<<                                       PMASK);            >>          73370000
<<    FUNCTIONAL RETURN: none                               >>          73375000
<<                                                          >>          73380000
<<    ALGORITHM:                                            >>          73385000
<<                                                          >>          73390000
<< -------------------------------------------------------- >>          73395000
<< message header format                                    >>          73400000
<<    MESSAGE'LEN      = Req messege      Reply messege     >>          73405000
<<    MESSAGE(1).(8:8) = RFA'WLB          RFA'WLB           >>          73410000
<<                                                          >>          73415000
<<    FPARMS(0.(8:8)   =  4                1                >>          73420000
<<    FPARMS(1)        = RemotefileID     status/localfileID>>          73425000
<<    FPARMS(2)        = Tcount                             >>          73430000
<<    FPARMS(3)        = labelID                            >>          73435000
<<    FPARMS(4)        = parametermask                      >>          73440000
<< -------------------------------------------------------- >>          73445000
RFA'FWRITELABEL:                                                        73450000
                                                                        73455000
INITIALIZE;                                                             73460000
IF CHECK'IF'ERROR THEN RETURN;                                          73465000
                                                                        73470000
MESSAGE(1).REQ := RFA'WLB;                                              73475000
FPARMS(0).(8:8) := 4;                                                   73480000
FPARMS(2) := P2;   << TCOUNT >>                                         73485000
FPARMS(3) := P3;   << LABEL ID >>                                       73490000
FPARMS(4) := P4;   << PMASK >>                                          73495000
MESSAGE'LEN := ((@FPARMS(4)-@MESSAGE)+1)&LSL(1);                        73500000
                                                                        73505000
@PTR1 := P1; << P1 == @TARGET >>                                        73510000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'WLB,                                 73515000
                               RFA'AFTX,                                73520000
                               MSGSTACKADDR,                            73525000
                               MESSAGE'LEN,                             73530000
                               PTR1,      << out target >>              73535000
                               P2,        << out tcount >>              73540000
                               A'DUMMY, 0);                             73545000
STATUS.CC := CCE;                                                       73550000
RETURN;                                                                 73555000
$PAGE "RFA'CALLS -- FFINDBYKEY   "                                      73560000
<< -------------------------------------------------------- >>          73565000
<< FFINDBYKEY:                                              >>          73570000
<< CALLING SEQUENCE:                                        >>          73575000
<<   DOUBLE PROCEDURE RFA'FFINDBYKEY (                      >>          73580000
<<                                    AFTX,                 >>          73585000
<<                                    KEYLOCATION,          >>          73590000
<<                                    KEYLENGTH,            >>          73595000
<<                                    RELOP,                >>          73600000
<<                                    @KEYBPTR);            >>          73605000
<<    NOTE: the 128 wd key is sent as data                  >>          73610000
<< -------------------------------------------------------- >>          73615000
<<    FPARMS(0).(8:8)  =  4                2                >>          73620000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          73625000
<<    FPARMS(2)        = keylocation                        >>          73630000
<<    FPARMS(3)        = keylength                          >>          73635000
<<    FPARMS(4)        = relop                              >>          73640000
<< -------------------------------------------------------- >>          73645000
RFA'FFINDBYKEY:                                                         73650000
                                                                        73655000
INITIALIZE;                                                             73660000
IF CHECK'IF'ERROR THEN RETURN;                                          73665000
                                                                        73670000
MESSAGE(1).REQ := RFA'FKY;                                              73675000
FPARMS(0).(8:8) := 4;                                                   73680000
FPARMS(2) := P1;   << keylocation >>                                    73685000
FPARMS(3) := P2;   << keylength >>                                      73690000
FPARMS(4) := P3;   << relop >>                                          73695000
                                                                        73700000
MESSAGE'LEN := ((@FPARMS(4)-@MESSAGE)+1)&LSL(1);                        73705000
                                                                        73710000
<< set out byte ptr to the key byte addr passed to us >>                73715000
@BPTR1 := P4;                                                           73720000
                                                                        73725000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'FKY,                                 73730000
                               RFA'AFTX,                                73735000
                               MSGSTACKADDR,                            73740000
                               MESSAGE'LEN,                             73745000
                               BPTR1,         << out target >>          73750000
                               MAXKSAMKEYLEN, << out len    >>          73755000
                               A'DUMMY, 0);                             73760000
STATUS.CC := CCE;                                                       73765000
RETURN;                                                                 73770000
$PAGE "RFA'CALLS -- FFINDN       "                                      73775000
<< -------------------------------------------------------- >>          73780000
<< FFINDN algorithm:                                        >>          73785000
<<    CALLING SEQUENCE:                                     >>          73790000
<<    DOUBLE PROCEDURE RFA'FFINDN    (                      >>          73795000
<<                                    AFTX,                 >>          73800000
<<                                    NUM0,                 >>          73805000
<<                                    NUM1,                 >>          73810000
<<                                    KEYLOCATION);         >>          73815000
<<    FUNCTIONAL RETURN: none                               >>          73820000
<<                                                          >>          73825000
<<    ALGORITHM:                                            >>          73830000
<<       same as FCONTROL                                   >>          73835000
<< -------------------------------------------------------- >>          73840000
<< message header format                                    >>          73845000
<<                       Req message      Reply message     >>          73850000
<<    MESSAGE'LEN      =                                    >>          73855000
<<    MESSAGE(1).(8:8) = RFA'FDN          RFA'FDN           >>          73860000
<<                                                          >>          73865000
<<    FPARMS(0).(8:8)  =  2                1                >>          73870000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          73875000
<<    FPARMS(2)        = number0                            >>          73880000
<<    FPARMS(3)        = number1                            >>          73885000
<<    FPARMS(4)        = keylocation                        >>          73890000
<< -------------------------------------------------------- >>          73895000
RFA'FFINDN:                                                             73900000
                                                                        73905000
INITIALIZE;                                                             73910000
IF CHECK'IF'ERROR THEN RETURN;                                          73915000
                                                                        73920000
MESSAGE(1).REQ := RFA'FDN;                                              73925000
FPARMS(0).(8:8) := 4;                                                   73930000
FPARMS(2) := P1;                                                        73935000
FPARMS(3) := P2;                                                        73940000
FPARMS(4) := P3;                                                        73945000
MESSAGE'LEN := ((@FPARMS(4) - @MESSAGE)+1)&LSL(1);                      73950000
                                                                        73955000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'FDN,                                 73960000
                               RFA'AFTX,                                73965000
                               MSGSTACKADDR,                            73970000
                               MESSAGE'LEN,                             73975000
                               A'DUMMY, 0,                              73980000
                               A'DUMMY, 0);                             73985000
STATUS.CC := CCE;                                                       73990000
RETURN;                                                                 73995000
$PAGE "RFA'CALLS -- FGETKEYINFO  "                                      74000000
<< -------------------------------------------------------- >>          74005000
<< FGETKEYINFO:                                             >>          74010000
<<    CALLING SEQUENCE:                                     >>          74015000
<<    DOUBLE PROCEDURE RFA'FGETKEYINFO (                    >>          74020000
<<                                      AFTX,               >>          74025000
<<                                      @PARMPTR,           >>          74030000
<<                                      @CONTROLPTR);       >>          74035000
<<    FUNCTIONAL RETURN: none                               >>          74040000
<<                                                          >>          74045000
<<    ALGORITHM:                                            >>          74050000
<<                                                          >>          74055000
<< -------------------------------------------------------- >>          74060000
<< message header format                                    >>          74065000
<<                       Req message      Reply message     >>          74070000
<<    MESSAGE'LEN      =                                    >>          74075000
<<    MESSAGE(1).(8:8) = RFA'GKY          RFA'GKY           >>          74080000
<<                                                          >>          74085000
<<    FPARMS(0).(8:8)  =  1                1                >>          74090000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          74095000
<<    FPARMS(2)        =                  ksamcontrolptr    >>          74100000
<<    FPARMS(3)        =                  End of Parms Ptr  >>          74105000
<<    NOTE: ksam param is returned as inbound data          >>          74110000
<< -------------------------------------------------------- >>          74115000
RFA'FGETKEYINFO:                                                        74120000
                                                                        74125000
INITIALIZE;                                                             74130000
IF CHECK'IF'ERROR THEN RETURN;                                          74135000
                                                                        74140000
MESSAGE(1).REQ := RFA'GKY;                                              74145000
FPARMS(0).(8:8) := 1;                                                   74150000
MESSAGE'LEN := ((@FPARMS(1) - @MESSAGE) + 1)&LSL(1);                    74155000
                                                                        74160000
@PTR1 := P1;    << ksam param array address >>                          74165000
                                                                        74170000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'GKY,                                 74175000
                               RFA'AFTX,                                74180000
                               MSGSTACKADDR,                            74185000
                               MESSAGE'LEN,                             74190000
                               A'DUMMY, 0,                              74195000
                               PTR1,         << in target >>            74200000
                               MAXKSAMPARMS);<< in len    >>            74205000
IF RSTATUS = CCE THEN                                                   74210000
BEGIN                                                                   74215000
   << now move the control array back to user's stack >>                74220000
   @PTR2 := P2;                                                         74225000
   MOVE PTR2 := MESSAGE(FPARMS(2)/2),(MAXKSAMCTRLEN);                   74230000
END;                                                                    74235000
                                                                        74240000
RETURN;                                                                 74245000
$PAGE "RFA'CALLS -- FREMOVE      "                                      74250000
<< -------------------------------------------------------- >>          74255000
<< FREMOVE:                                                 >>          74260000
<<    CALLING SEQUENCE:                                     >>          74265000
<<    DOUBLE PROCEDURE RFA'FREMOVE   (                      >>          74270000
<<                                    AFTX);                >>          74275000
<<    FUNCTIONAL RETURN: none                               >>          74280000
<<                                                          >>          74285000
<<    ALGORITHM:                                            >>          74290000
<<       same as FCONTROL                                   >>          74295000
<< -------------------------------------------------------- >>          74300000
<< message header format                                    >>          74305000
<<                       Req message      Reply message     >>          74310000
<<    MESSAGE'LEN      =                                    >>          74315000
<<    MESSAGE(1).(8:8) = RFA'RMV          RFA'RMV           >>          74320000
<<                                                          >>          74325000
<<    FPARMS(0).(8:8)  =  1                1                >>          74330000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          74335000
<< -------------------------------------------------------- >>          74340000
RFA'FREMOVE:                                                            74345000
                                                                        74350000
INITIALIZE;                                                             74355000
IF CHECK'IF'ERROR THEN RETURN;                                          74360000
                                                                        74365000
MESSAGE(1).REQ := RFA'RMV;                                              74370000
FPARMS(0).(8:8) := 1;                                                   74375000
MESSAGE'LEN := ((@FPARMS(1) - @MESSAGE) + 1)&LSL(1);                    74380000
                                                                        74385000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'RMV,                                 74390000
                               RFA'AFTX,                                74395000
                               MSGSTACKADDR,                            74400000
                               MESSAGE'LEN,                             74405000
                               A'DUMMY, 0,                              74410000
                               A'DUMMY, 0);                             74415000
STATUS.CC := CCE;                                                       74420000
RETURN;                                                                 74425000
$PAGE "RFA'CALLS -- KSPACE       "                                      74430000
<< -------------------------------------------------------- >>          74435000
<< KSPACE algorithm:                                        >>          74440000
<<    CALLING SEQUENCE:                                     >>          74445000
<<    DOUBLE PROCEDURE RFA'KSPACE    (                      >>          74450000
<<                                    AFTX,                 >>          74455000
<<                                    DISPLACEMENT);        >>          74460000
<<    FUNCTIONAL RETURN: none                               >>          74465000
<<                                                          >>          74470000
<<    ALGORITHM:                                            >>          74475000
<<       same as FCONTROL                                   >>          74480000
<< -------------------------------------------------------- >>          74485000
<< message header format                                    >>          74490000
<<                       Req message      Reply message     >>          74495000
<<    MESSAGE'LEN      =                                    >>          74500000
<<    MESSAGE(1).(8:8) = RFA'KSP          RFA'KSP           >>          74505000
<<                                                          >>          74510000
<<    FPARMS(0).(8:8)  =  2                1                >>          74515000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          74520000
<<    FPARMS(2)        = Displacement                       >>          74525000
<< -------------------------------------------------------- >>          74530000
RFA'KSPACE:                                                             74535000
                                                                        74540000
INITIALIZE;                                                             74545000
IF CHECK'IF'ERROR THEN RETURN;                                          74550000
                                                                        74555000
MESSAGE(1).REQ := RFA'KSP;                                              74560000
FPARMS(0).(8:8) := 2;                                                   74565000
FPARMS(2) := P1;                                                        74570000
MESSAGE'LEN := ((@FPARMS(2) - @MESSAGE)+1)&LSL(1);                      74575000
                                                                        74580000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'KSP,                                 74585000
                               RFA'AFTX,                                74590000
                               MSGSTACKADDR,                            74595000
                               MESSAGE'LEN,                             74600000
                               A'DUMMY, 0,                              74605000
                               A'DUMMY, 0);                             74610000
STATUS.CC := CCE;                                                       74615000
RETURN;                                                                 74620000
$PAGE "RFA'CALLS -- handle local errors"                                74625000
<< -------------------------------------------------------- >>          74630000
<< SPECIAL REQUEST                                          >>          74635000
<<    CALLING SEQUENCE:                                     >>          74640000
<<    DOUBLE PROCEDURE RFA'CALLS'ERR (                      >>          74645000
<<                                    AFTX,                 >>          74650000
<<                                    LOCAL'ERR'NUM);       >>          74655000
<<    FUNCTIONAL RETURN: none                               >>          74660000
<<                                                          >>          74665000
<<    ALGORITHM:                                            >>          74670000
<<       same as FCONTROL                                   >>          74675000
<< -------------------------------------------------------- >>          74680000
<< message header format                                    >>          74685000
<<                       Req message      Reply message     >>          74690000
<<    MESSAGE'LEN      =                                    >>          74695000
<<    MESSAGE(1).(8:8) = RFA'SPE          RFA'SPE           >>          74700000
<<                                                          >>          74705000
<<    FPARMS(0).(8:8)  =  2                1                >>          74710000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          74715000
<<    FPARMS(2)        = err number                         >>          74720000
<< -------------------------------------------------------- >>          74725000
RFA'CALLS'ERR:                                                          74730000
                                                                        74735000
RFA'DURING'NW'IO := TRUE;                                               74740000
INITIALIZE;                                                             74745000
IF CHECK'IF'ERROR THEN RETURN;                                          74750000
                                                                        74755000
MESSAGE(1).REQ := RFA'SPE;                                              74760000
FPARMS(0).(8:8) := 2;                                                   74765000
FPARMS(2) := P1;                                                        74770000
MESSAGE'LEN := ((@FPARMS(2) - @MESSAGE) + 1)&LSL(1);                    74775000
                                                                        74780000
RFA'CALLS := PCAL'RFA'HANDLER (RFA'SPE,                                 74785000
                               RFA'AFTX,                                74790000
                               MSGSTACKADDR,                            74795000
                               MESSAGE'LEN,                             74800000
                               A'DUMMY, 0,                              74805000
                               A'DUMMY, 0);                             74810000
RETURN;                                                                 74815000
                                                                        74820000
END;                              << of RFA'CALLS                >>     74825000
$PAGE "RFA'FOPEN"                                                       74830000
DOUBLE PROCEDURE  RFA'FOPEN (RFA'AFTX,                                  74835000
                             FOPTIONS,                                  74840000
                             AOPTIONS,                                  74845000
                             RECSIZE,                                   74850000
                             USERLABELS,                                74855000
                             BLOCKFACTOR,                               74860000
                             NUMBUFFERS,                                74865000
                             FILESIZE,                                  74870000
                             NUMEXTENTS,                                74875000
                             INITALLOC,                                 74880000
                             FILECODE,                                  74885000
                             FOPENPMASK,                                74890000
                             PRIV'MODE,                                 74895000
                             KSAM,                                      74900000
                             DISP,                             <<11610>>74901000
                             FILENAME,                                  74905000
                             ADSENVID,                                  74910000
                             DEVICE,                                    74915000
                             FORMSMSG);                                 74920000
VALUE                                                                   74925000
   RFA'AFTX, FOPTIONS, AOPTIONS, RECSIZE, USERLABELS, BLOCKFACTOR,      74930000
   NUMBUFFERS, FILESIZE, NUMEXTENTS, INITALLOC, FILECODE,               74935000
   FOPENPMASK, PRIV'MODE, KSAM, DISP;                          <<11610>>74940000
LOGICAL                                                                 74945000
   FOPTIONS, AOPTIONS, FOPENPMASK, PRIV'MODE, KSAM, DISP;      <<11610>>74950000
INTEGER                                                                 74955000
   RFA'AFTX, RECSIZE, USERLABELS, BLOCKFACTOR, NUMBUFFERS,              74960000
   NUMEXTENTS, INITALLOC, FILECODE;                                     74965000
DOUBLE                                                                  74970000
   FILESIZE;                                                            74975000
BYTE ARRAY                                                              74980000
   FILENAME, ADSENVID, DEVICE, FORMSMSG;                                74985000
OPTION PRIVILEGED, UNCALLABLE;                                 <<01767>>74986000
                                                                        74990000
<< -------------------------------------------------------- >>          74995000
<< Functional return:  double word return  |--------------| >>          75000000
<<                                         | error code   | >>          75005000
<<                                         |--------------| >>          75010000
<<                                         | remote status| >>          75015000
<<                                         |--------------| >>          75020000
<<                                                          >>          75025000
<<    Algorithm:                                            >>          75030000
<<    initialize variables and ds plabels                   >>          75035000
<<    if not successful then                                >>          75040000
<<       set correct error code and clean up                >>          75045000
<<       return to FOPEN                                    >>          75050000
<<    build fopen message                                   >>          75055000
<<    update aft                                            >>          75060000
<<                                                          >>          75065000
<< -------------------------------------------------------- >>          75070000
<< FOPEN messege header format:                             >>          75075000
<<                       Req messege      Reply messege     >>          75080000
<<    MESSAGE'LEN      =                                    >>          75085000
<<    MESSAGE(1).(8:8) = RFA'OPE          RFA'OPE           >>          75090000
<<                                                          >>          75095000
<<    FPARMS(0).(8:8)  = 15                4                >>          75100000
<<    FPARMS(1)        = foptions         status/remotefile >>          75105000
<<    FPARMS(2)        = aoptions         blocksize|fcheck# >>          75110000
<<    FPARMS(3)        = recsize          aoptions          >>          75115000
<<    FPARMS(4)        = userlabels       foptions          >>          75120000
<<    FPARMS(5)        = blockfactor      ----------------- >>          75125000
<<    FPARMS(6)        = numbuffers                         >>          75130000
<<    FPARMS(7)        = filesize                           >>          75135000
<<    FPARMS(8)        = filesize                           >>          75140000
<<    FPARMS(9)        = numextents                         >>          75145000
<<    FPARMS(10)       = initalloc                          >>          75150000
<<    FPARMS(11)       = filecode                           >>          75155000
<<    FPARMS(12)       = parameter mask                     >>          75160000
<<    FPARMS(13)       = LocalFileID                        >>          75165000
<<    FPARMS(14)       = RFAblockfactor                     >>          75170000
<<    FPARMS(15)       = migrated                           >>          75175000
<<                                                          >>          75180000
<<    VPARMBPTRS(1)    = logon id ptr     ----------------- >>          75185000
<<    VPARMBPTRS(2)    = Environmentptr                     >>          75190000
<<    VPARMBPTRS(3)    = filenameptr                        >>          75195000
<<    VPARMBPTRS(4)    = deviceptr                          >>          75200000
<<    VPARMBPTRS(5)    = formmsgptr                         >>          75205000
<<    VPARMBPTRS(6)    = End of Parms Ptr                   >>          75210000
<< -------------------------------------------------------- >>          75215000
BEGIN                   << OF RFA'FOPEN                     >>          75220000
                                                                        75225000
INTEGER                                                                 75230000
   ERROR'CODE = RFA'FOPEN,                                              75235000
   JOBNUM,                                                     <<02391>>75236000
   CILDEV,                                                     <<02391>>75236100
   RSTATUS    = RFA'FOPEN+1;                                            75240000
ARRAY                                                                   75245000
   AQ'FOPT(*) = FOPTIONS;                                               75250000
LOGICAL                                                                 75255000
   DLVAL,                                                               75260000
   QVAL,                                                                75265000
   QRELAFTX,                                                            75270000
   DEV'REV'RFA,                                                         75275000
   FLAGS'SETUP'ENV:=0,                                         <<01181>>75276000
   REMOTEADOPTED,                                                       75280000
   RETRY'W'LOCKWD;                                                      75285000
INTEGER                                                                 75290000
   DEVENVIDLEN:=0,                                                      75295000
   ENVIDLEN:=0,                                                         75300000
   FILEREFLEN:=0,                                                       75305000
   I,                                                                   75310000
   PLAB'RFA,                                                            75315000
   PLAB'ENVIRONMENTS,                                                   75320000
   RETURNADDR;                                                          75325000
DOUBLE                                                                  75330000
   RESULT;                                                              75335000
BYTE POINTER                                                            75340000
   BPTR1,                                                               75345000
   BPTR2,                                                               75350000
   ENVID;                                                               75355000
EQUATE                                                                  75360000
   <<--- DS Plabels --->>                                               75365000
   RFA'HANDLER'PLX  = 1,                                                75370000
   RA'SETUP'ENV'PLX = 2,                                                75375000
   AS'PARSE'ENVID'PLX = 30;                                             75380000
ARRAY                                                                   75385000
   WORK'BUFF(0:44); << formal designator + "LOCKWORD: ".."?" >>         75390000
BYTE ARRAY                                                              75395000
   BWORK'BUFF(*) = WORK'BUFF,                                           75400000
   BACKREF (0:5);   << to store "$BACK " >>                             75405000
DEFINE                                                                  75410000
   REMOTEADOPTED'SETUP = FLAGS'SETUP'ENV.(15:1) #,             <<01181>>75410100
   TYPE2RFA'SETUP = FLAGS'SETUP'ENV.(14:1) #,                  <<01181>>75410200
   REVRFA'SETUP = FLAGS'SETUP'ENV.(13:1) #,                    <<01181>>75410300
   FORMMSGBIT      = (8:1) #;                                           75415000
                                                                        75420000
<< -------------------------------------------------------- >>          75425000
<<          Declarations for use with FPARSE                >>          75430000
<<                                                          >>          75435000
<< Following variable declarations must have been made      >>          75440000
<< INTEGER ARRAY ITEMS (0:MAXNUMOFNAMES)                    >>          75445000
<< DOUBLE ARRAY ITEM'VECTORS (0:MAXNUMOFNAMES);             >>          75450000
<< INTEGER ARRAY IITEM'VECTORS(*) = ITEM'VECTORS;           >>          75455000
<< -------------------------------------------------------- >>          75460000
                                                                        75465000
EQUATE                                                                  75470000
   ITEM'END   = 0,                                                      75475000
   ITEM'FNAME = 1,                                                      75480000
   ITEM'LNAME = 2,                                                      75485000
   ITEM'GNAME = 3,                                                      75490000
   ITEM'ANAME = 4,                                                      75495000
   ITEM'ENAME = 5,                                                      75500000
   MAXNUMOFNAMES = ITEM'ENAME,                                          75505000
                                                                        75510000
   FP'RET'SYSFILE = 2,                                                  75515000
   FP'RET'BACKREF = 1;                                                  75520000
                                                                        75525000
DEFINE                                                                  75530000
   FP'ERRPTR    = IITEM'VECTORS(0) #,                                   75535000
   FP'FNAME'OFF = IITEM'VECTORS(0) #,                                   75540000
   FP'FNAME'LEN = IITEM'VECTORS(1) #,                                   75545000
   FP'LNAME'OFF = IITEM'VECTORS(2) #,                                   75550000
   FP'LNAME'LEN = IITEM'VECTORS(3) #,                                   75555000
   FP'GNAME'OFF = IITEM'VECTORS(4) #,                                   75560000
   FP'GNAME'LEN = IITEM'VECTORS(5) #,                                   75565000
   FP'ANAME'OFF = IITEM'VECTORS(6) #,                                   75570000
   FP'ANAME'LEN = IITEM'VECTORS(7) #,                                   75575000
   FP'ENAME'OFF = IITEM'VECTORS(8) #,                                   75580000
   FP'ENAME'LEN = IITEM'VECTORS(9) #,                                   75585000
   FP'DEF'DESIG = IITEM'VECTORS (10) #,                                 75590000
   FP'DESIG'LEN = IITEM'VECTORS(11) #,                                  75595000
   FP'IS'STDLIST = (FP'DEF'DESIG = 1) #,                                75600000
   FP'IS'NEWPASS = (FP'DEF'DESIG = 2) #,                                75605000
   FP'IS'OLDPASS = (FP'DEF'DESIG = 3) #,                                75610000
   FP'IS'STDIN   = (FP'DEF'DESIG = 4) #,                                75615000
   FP'IS'STDINX  = (FP'DEF'DESIG = 5) #,                                75620000
   FP'IS'NULL    = (FP'DEF'DESIG = 6) #,                                75625000
                                                                        75630000
   SETALLFPARSEITEMS = ITEMS(0) := ITEM'FNAME;                          75635000
                       ITEMS(1) := ITEM'LNAME;                          75640000
                       ITEMS(2) := ITEM'GNAME;                          75645000
                       ITEMS(3) := ITEM'ANAME;                          75650000
                       ITEMS(4) := ITEM'ENAME;                          75655000
                       ITEMS(5) := ITEM'END; #;                         75660000
INTEGER ARRAY                                                           75665000
   ITEMS (0:MAXNUMOFNAMES);                                             75670000
DOUBLE ARRAY                                                            75675000
   ITEM'VECTORS (0:MAXNUMOFNAMES);                                      75680000
INTEGER ARRAY                                                           75685000
   IITEM'VECTORS(*) = ITEM'VECTORS;                                     75690000
<< ---------------------------------------------------------            75695000
   array for fopen parms to be passed to RFA'HANDLER                    75700000
                             +------------------------+                 75705000
             MESSAGE(0)      | mesage len    +bytes   |                 75710000
                             | protocol   /req type   |                 75715000
             FPARMS(0)       | rfa flags  /# fxd parms|                 75720000
             FPARMS(1)       | 1st fixed parm         |                 75725000
                             |                        |                 75730000
                             |                        |                 75735000
             VPARMBPTRS(0)   | last fixed parm        |                 75740000
             VPARMBPTRS(1)   | 1st variable parm ptr  |                 75745000
                             |                        |                 75750000
                             |                        |                 75755000
                             | last variable parm ptr |                 75760000
      BMESSAGE(VPARMBPTRS(0))| 1st variable parm      |                 75765000
      BMESSAGE(VPARMBPTRS(1))| 2nd variable parm      |                 75770000
                             |                        |                 75775000
                             |                        |                 75780000
                             |                        |                 75785000
                             +------------------------+                 75790000
   --------------------------------------------------------- >>         75795000
EQUATE                                                                  75800000
   MAX'MESSAGE'LEN  = 175;                                              75805000
INTEGER ARRAY                                                           75810000
   MESSAGE (0:MAX'MESSAGE'LEN-1) = Q;                                   75815000
DOUBLE ARRAY                                                            75820000
   DMESSAGE (*)    = MESSAGE;                                           75825000
BYTE ARRAY                                                              75830000
                                                                        75835000
   BMESSAGE (*)    = MESSAGE;                                           75840000
INTEGER ARRAY                                                           75845000
   REMOTESESSIONID(*) = MESSAGE (RFA'HEAD),                             75850000
   FPARMS(*)       = MESSAGE(RFA'FPARMS0),                              75855000
   VPARMBPTRS(*)   = FPARMS(15);                                        75860000
DEFINE                                                                  75865000
   MESSAGE'LEN     = MESSAGE(0) #,                                      75870000
   SET'MESSAGE'PID = MESSAGE(1).(0:8) := RFA'MSG'PID# ,        <<01181>>75875000
                                                               <<01181>>75875100
   MSG'PRIVMODE = FPARMS(0).(2:1) #,                           <<01181>>75875200
   MSG'KSAM = FPARMS(0).(3:1) #,                               <<01181>>75875300
   MSG'REVRFA = FPARMS(0).(5:1) #,                             <<01181>>75875400
   MSG'BLOCKING = FPARMS(14) #,                                <<01181>>75875500
   MSG'MIGRATED = FPARMS(15) #;                                <<01181>>75875600
$PAGE                                                                   75880000
<< ===================== Subroutines ====================== >>          75885000
LOGICAL SUBROUTINE GET'LOCKWD;                                          75890000
<< **********************                                               75895000
   Prompt the user for the lockwd.                                      75900000
   Use the filesystem FREPLY and return the value                       75905000
   from FREPLY.                                                         75910000
   ********************** >>                                            75915000
BEGIN                   << OF GET'LOCKWD >>                             75920000
   MOVE BWORK'BUFF := "LOCKWORD: ";                                     75925000
   MOVE BWORK'BUFF(I:=10) := FILENAME, (FILEREFLEN);                    75930000
   I := I + FILEREFLEN;                                                 75935000
   IF FP'ENAME'OFF = 0 THEN                                             75940000
   BEGIN          << if envid is not in FD >>                           75945000
      BWORK'BUFF(I) := ":";                                             75950000
      MOVE BWORK'BUFF(I:=I+1) := ENVID,                                 75955000
                                 (MAX(DEVENVIDLEN,ENVIDLEN));           75960000
      I := I + MAX (DEVENVIDLEN,ENVIDLEN);                              75965000
   END;           << if envid is not in FD >>                           75970000
   BWORK'BUFF(I) := "?";                                                75975000
   GET'LOCKWD := FREPLY (BWORK'BUFF, I+1);                              75980000
END;                    << OF GET'LOCKWD >>                             75985000
LOGICAL SUBROUTINE CHECK'IF'ERROR;                                      75990000
<< **********************                                               75995000
   Function: will check if ERROR'CODE is <> 0, if so                    76000000
   error had just occured, set proper condition code                    76005000
   return TRUE                                                          76010000
   NOTE: If error is that the envid was an DS1 or X.25 node             76015000
   or that envid was rev RFA then set it to CCG so that                 76020000
   DS1 code would get a chance.                                         76025000
   ********************** >>                                            76030000
BEGIN                   << OF CHECK'IF'ERROR                >>          76035000
   CHECK'IF'ERROR := FALSE;                                             76040000
   IF ERROR'CODE <> 0 THEN                                              76045000
   BEGIN                                                                76050000
      IF ERROR'CODE = ERR'OLDDS OR ERROR'CODE = UNIMPL OR               76055000
         DEV'REV'RFA THEN                                               76060000
         STATUS.CC := CCG                                               76065000
      ELSE                                                              76070000
         STATUS.CC := CCL;                                              76075000
      CHECK'IF'ERROR := TRUE;                                           76080000
      SETAFTACCESS;                                                     76085000
      RELEASE'RFA'AFT;  << clear/release AFT >>                         76090000
   END;                                                                 76095000
END;                    << OF CHECK'IF'ERROR                >>          76100000
                                                                        76105000
SUBROUTINE INITIALIZE;                                                  76110000
<< **********************                                               76115000
   Function: perform initialization duities                             76120000
   and illegal access check                                             76125000
   ********************** >>                                            76130000
BEGIN                   << OF INITIALIZE                    >>          76135000
                                                                        76140000
   << misc. variables >>                                                76145000
   DEV'REV'RFA := FALSE;                                                76150000
   RFA'FOPEN := 0D;                                                     76155000
                                                                        76160000
   MESSAGE(0) := 0;  << clear out message array >>                      76165000
   MOVE MESSAGE(1) := MESSAGE(0),(MAX'MESSAGE'LEN-1);                   76170000
   SET'MESSAGE'PID;                                                     76175000
                                                                        76180000
   << plabels >>                                                        76185000
   PLAB'RFA := AS'DSPLABEL (RFA'HANDLER'PLX);                           76190000
   PLAB'ENVIRONMENTS := AS'DSPLABEL (RA'SETUP'ENV'PLX);                 76195000
   IF PLAB'RFA = 0 OR PLAB'ENVIRONMENTS = 0 THEN                        76200000
   BEGIN                                                                76205000
      ERROR'CODE := UNIMPL;                                             76210000
      RETURN;                                                           76215000
   END;                                                                 76220000
END;                    << OF INITIALIZE                    >>          76225000
$PAGE                                                                   76230000
<<                                                                      76235000
   The parameters for the subroutine are identical to the               76240000
   one's for RFA'HANDLER ( ... )                                        76245000
   Therefore we save the return address on TOS at                       76250000
   beginning of this subroutine then the PCAL is made.                  76255000
   All this is done to make the stacking of the parms                   76260000
   a little easier to maintain.                                         76265000
   NOTE:                                                                76270000
   When it comes time to exit from the subroutine there                 76275000
   will be an attempt to execute SXIT N where N is the                  76280000
   number of parms to this subroutine. the problem here                 76285000
   is that these parms were used as parms to the procedure              76290000
   we just called, and which were deleted from stack along              76295000
   with its stack marker. so before the subroutine gets                 76300000
   the chance to do SXIT N we explicitly ask it to do                   76305000
   RETURN 0 so that just the return address is taken off, yes!          76310000
   its kludgey.                                                         76315000
>>                                                                      76320000
DOUBLE SUBROUTINE PCAL'RFA'HANDLER (S'REQ,                              76325000
                                    S'AFTX,                             76330000
                                    S'MESSAGE,                          76335000
                                    S'MESSAGE'LEN,                      76340000
                                    S'OUTBUF,                           76345000
                                    S'OUTBUF'LEN,                       76350000
                                    S'INBUF,                            76355000
                                    S'INBUF'LEN);                       76360000
VALUE                                                                   76365000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             76370000
INTEGER                                                                 76375000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             76380000
BYTE ARRAY                                                              76385000
   S'INBUF, S'OUTBUF;                                                   76390000
INTEGER ARRAY                                                           76395000
   S'MESSAGE;                                                           76400000
                                                                        76405000
<< **********************                                               76410000
   Function: to call rfa'handler                                        76415000
   ********************** >>                                            76420000
BEGIN                    << OF PCAL'RFA'HANDLER             >>          76425000
   RETURNADDR := TOS;                                                   76430000
                                                                        76435000
   TOS := PLAB'RFA;                                                     76440000
   ASSEMBLE (PCAL 0); << will have one word return >>                   76445000
                                                                        76450000
   TOS := RETURNADDR;                                                   76455000
   RETURN 0;                                                            76460000
END;                     << OF PCAL'RFA'HANDLER             >>          76465000
                                                                        76470000
                                                                        76475000
SUBROUTINE PCAL'RA'SETUP'ENV (S'ENVID,                                  76480000
                              S'ENVID'LEN,                              76485000
                              S'AFTX,                                   76490000
                              S'SERVER'ADOPTED,                         76495000
                              S'REMOTE'SESSION'ID,                      76500000
                              S'JOBNUM,                        <<02391>>76501000
                              S'CILDEV,                        <<02391>>76501100
                              S'RFA'STATUS);                            76505000
VALUE                                                                   76510000
   S'ENVID'LEN, S'AFTX;                                                 76515000
INTEGER                                                                 76520000
   S'JOBNUM, S'CILDEV, S'ENVID'LEN, S'AFTX, S'RFA'STATUS;      <<02391>>76525000
LOGICAL                                                                 76530000
   S'SERVER'ADOPTED;                                                    76535000
BYTE ARRAY                                                              76540000
   S'ENVID;                                                             76545000
INTEGER ARRAY                                                           76550000
   S'REMOTE'SESSION'ID;                                                 76555000
BEGIN                    << OF PCAL'RA'SETUP'ENVIRONMENTS   >>          76560000
   RETURNADDR := TOS;                                                   76565000
                                                                        76570000
   TOS := PLAB'ENVIRONMENTS;                                            76575000
   ASSEMBLE (PCAL 0);                                                   76580000
                                                                        76585000
   TOS := RETURNADDR;                                                   76590000
   RETURN 0;                                                            76595000
END;                     << OF PCAL'RA'SETUP'ENVIRONMENTS   >>          76600000
$PAGE                                                                   76605000
SUBROUTINE LOOKFOR'NODESPEC;                                            76610000
<< **********************                                               76615000
   Function: parse filename or device                                   76620000
   specification for node name may come in various flavors              76625000
   type 1: Filename=fname[/lockwd][.group[.acct]][:nodename]            76630000
   type 2: DEV=[[nodename]#][MPEDEVICE]                                 76635000
                                                                        76640000
   Type 2 is mainly there for backwards compatibility                   76645000
   and it will only support envid's of 8 chars and only the             76650000
   node specified. This will discourage its use in the future           76655000
   Each type is mutually exclusive and attempt to specify               76660000
   the node in more than one way will generate error.                   76665000
                                                                        76670000
   The fileref and envid has been syntax checked by fparse              76675000
   prior to this call, so we may assume a legal syntax.                 76680000
   However FOPEN does not directly call FPARSE so it cannot             76685000
   pass to us some key information, making us call it againg.           76690000
   ********************** >>                                            76695000
BEGIN                   << OF LOOKFOR'NODESPEC              >>          76700000
   SETALLFPARSEITEMS;                                                   76705000
   FPARSE (FILENAME, RESULT, ITEMS, ITEM'VECTORS);                      76710000
   IF RESULT < 0D THEN                                         <<01768>>76711000
   BEGIN    << Err, means no FORMDESIG parm for FOPEN >>       <<01768>>76712000
      ITEM'VECTORS := 0D;                                      <<01768>>76713000
      MOVE IITEM'VECTORS(2):=IITEM'VECTORS(0),                 <<01768>>76714000
                             (MAXNUMOFNAMES*2);                <<01768>>76714100
      << We zero out the vectors array in order to zero >>     <<01768>>76714200
      << out the length vectors of all name items       >>     <<01768>>76714300
   END;     << Err, no FORMDESIG parm >>                       <<01768>>76714400
   FILEREFLEN := FP'DESIG'LEN;                                          76715000
   ERROR'CODE := 0;                                                     76720000
   IF FP'ENAME'LEN = 0 THEN                                             76725000
   BEGIN                << if env id not in FD >>                       76730000
      IF DEVICE = "#" THEN                                              76735000
      BEGIN                << if rev rfa thru DEV parm >>               76740000
         DEV'REV'RFA := TRUE;                                           76745000
         MOVE BACKREF := "$BACK ";                                      76750000
         @ENVID := @BACKREF;                                            76755000
         ENVIDLEN := 5;                                                 76760000
      END                  << if rev rfa thru DEV parm >>               76765000
      ELSE BEGIN           << else its type 2 >>                        76770000
         MOVE DEVICE := DEVICE WHILE ANS,1;                             76775000
         @BPTR2 := TOS;                                                 76780000
         @ENVID := @DEVICE;                                             76785000
         IF (DEVENVIDLEN:=@BPTR2-@DEVICE) > MAXDEVPARMLEN               76790000
            OR BPTR2 <> "#" THEN                                        76795000
            ERROR'CODE := INVDEV;                                       76800000
         TYPE2RFA'SETUP := 1;                                  <<01181>>76801000
      END;                 << else its type 2 >>                        76805000
   END                  << if env id not in FD >>                       76810000
   ELSE BEGIN           << else its type 1 >>                           76815000
      IF ADSENVID = "#" THEN                                            76820000
         ERROR'CODE := INVDEV;                                          76825000
      @ENVID := @ADSENVID; << same as FILENAME(FP'ENAME'OFF) >>         76830000
      ENVIDLEN := FP'ENAME'LEN;                                         76835000
   END;                 << else its type 1 >>                           76840000
END;                    << OF LOOKFOR'NODESPEC              >>          76845000
$PAGE                                                                   76850000
SUBROUTINE SETUP'ENVIRONMENTS;                                          76855000
<< **********************                                               76860000
   Function: to check if the local and remote environments              76865000
   are setup and if NOT the the local environments would be             76870000
   setup by the ADV DS procedure RA'SETUP'ENVIRONMENTS and              76875000
   we must build and send a message requesting that the                 76880000
   remote server that was activated for this FOPEN be adopted           76885000
   to the remote session that VT has setup                              76890000
   (or remote session created automatically).                           76895000
   ********************** >>                                            76900000
BEGIN                   << OF SETUP'ENVIRONMENTS            >>          76905000
                                                                        76910000
   PCAL'RA'SETUP'ENV (ENVID, MAX (ENVIDLEN,DEVENVIDLEN),                76915000
                      RFA'AFTX,                                         76920000
                      FLAGS'SETUP'ENV,                         <<01181>>76925000
                      REMOTESESSIONID,                                  76930000
                      JOBNUM,                                  <<02391>>76931000
                      CILDEV,                                  <<02391>>76931100
                      ERROR'CODE);                                      76935000
   IF ERROR'CODE <> 0 THEN                                              76940000
      RETURN;                                                           76945000
                                                                        76950000
   IF NOT REMOTEADOPTED'SETUP THEN                             <<01181>>76955000
   BEGIN                << remote server not adopted yet    >>          76960000
      MESSAGE(1).REQ := RFA'ADP;                                        76965000
      FPARMS(0).(8:8) := 5;                                    <<02391>>76970000
      FPARMS(4) := JOBNUM;                                     <<02391>>76971000
      FPARMS(5) := CILDEV;                                     <<02391>>76971100
      MESSAGE'LEN := (RFA'HEAD + SESSION'ID'LEN + 2)&LSL(1);   <<02391>>76975000
                                                                        76980000
      RFA'FOPEN := PCAL'RFA'HANDLER (RFA'ADP,                           76985000
                                     RFA'AFTX,                          76990000
                                     MESSAGE, MESSAGE'LEN,              76995000
                                     A'DUMMY, 0,                        77000000
                                     A'DUMMY, 0);                       77005000
      IF RSTATUS <> CCE THEN                                            77010000
         ERROR'CODE := ERR'ADOPTION;                                    77015000
   END;                 << remote server not adopted yet    >>          77020000
END;                    << OF SETUP'ENVIRONMENTS            >>          77025000
$PAGE                                                                   77030000
SUBROUTINE BUILD'MESSAGE;                                               77035000
<< **********************                                               77040000
   Function: to insert all the necessary parms for remote               77045000
   fopen in the message array which will be passed to                   77050000
   RFA'HANDLER.                                                         77055000
   ********************** >>                                            77060000
BEGIN                   << OF BUILD'MESSAGE                 >>          77065000
   MESSAGE(1).REQ := RFA'OPE; << request code >>                        77070000
   FPARMS(0) := 0;            << zero out 3rd wd of RFA'HEAD>>          77075000
   FPARMS(0).(8:8) := 15;     << # of fixed parms >>                    77080000
   << ----------------------------------------------------- >>          77085000
   << fill in fixed length parms                            >>          77090000
   << shortcut to copy some of fixed parms off Q-# area     >>          77095000
   << ----------------------------------------------------- >>          77100000
   MOVE FPARMS(1) := AQ'FOPT,(12);                                      77105000
   << ----------------------------------- >>                            77110000
   << these are ADVDS related not Filesys >>                            77115000
   << ----------------------------------- >>                            77120000
   MOVE FPARMS(13) := (3(0));                                           77125000
   MSG'BLOCKING := 1;  << blocking factor, a future feature >> <<01181>>77130000
   MSG'PRIVMODE := PRIV'MODE.(15:1);                           <<01181>>77135000
   MSG'KSAM := KSAM.(15:1);                                    <<01181>>77140000
   MSG'REVRFA := REVRFA'SETUP;                                 <<01181>>77141000
   MSG'MIGRATED := 0; << migrated file?, ha ha >>              <<01181>>77145000
   << --------------------------------------------- >>                  77150000
   << now for variable length parms                 >>                  77155000
   << Logon Id variable parm starts at vparmbptr(7) >>                  77160000
   << --------------------------------------------- >>                  77165000
   VPARMBPTRS(1) := (@VPARMBPTRS(7) - @MESSAGE)&LSL(1);                 77170000
   VPARMBPTRS(2) := VPARMBPTRS(1); << for future use >>                 77175000
   << ----------------------------------------- >>                      77180000
   << put file ref + 1 char delimiter to vparm3 >>                      77185000
   << ----------------------------------------- >>                      77190000
   VPARMBPTRS(3) := VPARMBPTRS(2);  << ptr to filename >>               77195000
   @BPTR1 := @BPTR2 := @BMESSAGE(VPARMBPTRS(3));                        77200000
   MOVE BPTR1 := FILENAME(FP'FNAME'OFF), (FP'FNAME'LEN), 2;    <<01768>>77205000
   @BPTR1 := TOS; << destinaton addr was on TOS >>                      77210000
   IF NOT RETRY'W'LOCKWD THEN                                           77215000
   BEGIN                << first time through >>                        77220000
      BPTR1 := "/";     << will become null lockwd if lockwd >>         77225000
      @BPTR1 := @BPTR1 + 1; << was not specified in FD >>               77230000
      IF FP'LNAME'OFF <> 0 THEN        << lockwd specified >>           77235000
      BEGIN                                                             77240000
         RETRY'W'LOCKWD := TRUE;  << no retry for lockword >>           77245000
         MOVE BPTR1 := FILENAME(FP'LNAME'OFF),(FP'LNAME'LEN),2;         77250000
         @BPTR1 := TOS; << destinaton addr was on TOS >>                77255000
      END;                                                              77260000
   END                  << first time through >>                        77265000
   ELSE BEGIN                                                           77270000
      BPTR1 := "/";                                                     77275000
      MOVE BPTR1(1) := BWORK'BUFF WHILE ANS,1;                          77280000
      @BPTR1 := TOS;   << destination addr was on TOS >>                77285000
   END;                                                                 77290000
   IF FP'GNAME'OFF <> 0 THEN                                            77295000
   BEGIN                                                                77300000
      BPTR1 := ".";                                                     77305000
      MOVE BPTR1(1) := FILENAME(FP'GNAME'OFF),(FP'GNAME'LEN),2;         77310000
      @BPTR1 := TOS;   << destination addr was on TOS >>                77315000
      IF FP'ANAME'OFF <> 0 THEN                                         77320000
      BEGIN                                                             77325000
         BPTR1 := ".";                                                  77330000
         MOVE BPTR1(1) := FILENAME(FP'ANAME'OFF),                       77335000
                                  (FP'ANAME'LEN),2;                     77340000
         @BPTR1 := TOS;   << destination addr was on TOS >>             77345000
      END;                                                              77350000
   END;                                                                 77355000
   BPTR1 := " ";                                                        77360000
   @BPTR1 := @BPTR1 + 1;                                                77365000
   << device >>                                                         77370000
   VPARMBPTRS(4) := VPARMBPTRS(3)+@BPTR1-@BPTR2;                        77375000
   IF DEVICE = "#" AND DEVICE(1) = SPECIAL THEN                         77380000
   BEGIN           << if REV RFA and default device >>                  77385000
      MOVE BMESSAGE(VPARMBPTRS(4)):= "DISC  ";                          77390000
      I := 6;                                                           77395000
   END             << if REV RFA and default device >>                  77400000
   ELSE BEGIN      << else REV RFA w/ dev spec or regular RFA>>         77405000
      IF FP'ENAME'LEN <> 0 THEN                                         77410000
      BEGIN           << If ENV id was specified in FD >>               77415000
         I := MAXDEVLEN;                                                77420000
         MOVE BMESSAGE(VPARMBPTRS(4)):=DEVICE,(I);                      77425000
      END             << If ENV id was specified in FD >>               77430000
      ELSE IF DEVICE(DEVENVIDLEN) = "#" AND                             77435000
              DEVICE(DEVENVIDLEN+1) = SPECIAL THEN                      77440000
      BEGIN           << Else if its is DEVICE but def dev >>           77445000
         MOVE BMESSAGE(VPARMBPTRS(4)):= "DISC  ";                       77450000
         I := 6;                                                        77455000
      END             << Else if its is DEVICE but def dev >>           77460000
      ELSE BEGIN      << Else its in DEVICE or REV rfa w/ dev>>         77465000
         <<--- if REV rfa then DEVENVIDLEN is 0   --->>                 77470000
         <<--- "#" in DEVICE must be skipped over --->>                 77475000
         I := MAXDEVLEN-DEVENVIDLEN-1;                                  77480000
         MOVE BMESSAGE(VPARMBPTRS(4)) := DEVICE(DEVENVIDLEN+1),         77485000
                                         (I);                           77490000
      END;            << Else its in DEVICE or REV rfa w/ dev>>         77495000
   END;            << else REV RFA w/ dev spec or regular RFA>>         77500000
   << -------- >>                                                       77505000
   << formsmsg >>                                                       77510000
   << -------- >>                                                       77515000
   VPARMBPTRS(5) := VPARMBPTRS(4)+I;                                    77520000
   IF FOPENPMASK.FORMMSGBIT THEN                                        77525000
   BEGIN                                                                77530000
      MOVE BMESSAGE(VPARMBPTRS(5)) := FORMSMSG,(MAXFORMMSGLEN);         77535000
      VPARMBPTRS(6) := (VPARMBPTRS(5)+MAXFORMMSGLEN+1);                 77540000
   END                                                                  77545000
   ELSE                                                                 77550000
      VPARMBPTRS(6) := (VPARMBPTRS(5)+1);                               77555000
   MESSAGE'LEN := VPARMBPTRS(6);                                        77560000
                                                                        77565000
END;                    << OF BUILD'MESSAGE                 >>          77570000
$PAGE                                                                   77575000
<< ====== Procedure Body ====== >>                                      77580000
                                                                        77585000
INITIALIZE;                                                             77590000
IF CHECK'IF'ERROR THEN RETURN;                                          77595000
                                                                        77600000
SETAFTACCESS;                                                           77605000
INITIALIZE'RFA'AFT; << this aft is now in used by RFA >>                77610000
RFA'AFT'PDISP := DISP; << pending disposition for fclose >>    <<11610>>77611000
                                                                        77615000
LOOKFOR'NODESPEC;                                                       77620000
IF CHECK'IF'ERROR THEN RETURN;                                          77625000
                                                                        77630000
RETRY'W'LOCKWD := FALSE;                                                77635000
LOCKWORD'RETRY:                                                         77640000
SETUP'ENVIRONMENTS;                                                     77645000
IF CHECK'IF'ERROR THEN RETURN;                                          77650000
                                                                        77655000
BUILD'MESSAGE;                                                          77660000
                                                                        77665000
RFA'FOPEN := PCAL'RFA'HANDLER (RFA'OPE,                                 77670000
                               RFA'AFTX,                                77675000
                               MESSAGE,                                 77680000
                               MESSAGE'LEN,                             77685000
                               A'DUMMY, 0,                              77690000
                               A'DUMMY, 0);                             77695000
IF RSTATUS <> CCE THEN                                                  77700000
BEGIN                                                                   77705000
   IF ERROR'CODE = LWVIOL AND NOT RETRY'W'LOCKWD THEN                   77710000
   BEGIN                                                                77715000
      RETRY'W'LOCKWD := TRUE;                                           77720000
      IF GET'LOCKWD THEN                                                77725000
      BEGIN                                                             77730000
         RFA'FOPEN := 0d;     << error code and status >>               77735000
         GO LOCKWORD'RETRY;                                             77740000
      END;                                                              77745000
   END;                                                                 77750000
   STATUS.CC := CCL;                                                    77755000
   SETAFTACCESS;                                                        77760000
   RELEASE'RFA'AFT;                                                     77765000
END                                                                     77770000
ELSE                                                                    77775000
   STATUS.CC := CCE;                                                    77780000
END;                    << OF RFA'FOPEN               >>                77785000
$PAGE "RFA'FCHECK"                                                      77790000
DOUBLE PROCEDURE  RFA'FCHECK (RFA'AFTX,                                 77795000
                              FCHECKPMASK,                              77800000
                              ERRORCODE,                                77805000
                              TLOG,                                     77810000
                              BLOCKNUM,                                 77815000
                              NUMRECS,                                  77820000
                              CRIT);                                    77825000
VALUE                                                                   77830000
   RFA'AFTX, FCHECKPMASK, BLOCKNUM, CRIT;                               77835000
INTEGER                                                                 77840000
   RFA'AFTX, ERRORCODE, TLOG, NUMRECS;                                  77845000
DOUBLE                                                                  77850000
   BLOCKNUM;                                                            77855000
LOGICAL                                                                 77860000
   FCHECKPMASK, CRIT;                                                   77865000
OPTION PRIVILEGED, UNCALLABLE;                                 <<01767>>77866000
<< -------------------------------------------------------- >>          77870000
<<    FUNCTIONAL RETURN: none                               >>          77875000
<<                                                          >>          77880000
<<    ALGORITHM:                                            >>          77885000
<<                                                          >>          77890000
<< -------------------------------------------------------- >>          77895000
<< FCHECK messege header format:                            >>          77900000
<<                       Req messege      Reply messege     >>          77905000
<<    MESSAGE'LEN      =                                    >>          77910000
<<    MESSAGE(1).(8:8) = RFA'CHK          RFA'CHK           >>          77915000
<<                                                          >>          77920000
<<    FPARMS(0).(8:8)  =  2                6                >>          77925000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          77930000
<<    FPARMS(2)        = parmetermask     errorcode         >>          77935000
<<    FPARMS(3)        = ------------     tlog              >>          77940000
<<    FPARMS(4)        =                  blocknum          >>          77945000
<<    FPARMS(5)        =                  blocknum          >>          77950000
<<    FPARMS(6)        =                  numrecs           >>          77955000
<< -------------------------------------------------------- >>          77960000
BEGIN                   << OF RFA'FCHECK                    >>          77965000
                                                                        77970000
INTEGER                                                                 77975000
   ERROR'CODE = RFA'FCHECK,                                             77980000
   RSTATUS    = RFA'FCHECK+1;                                           77985000
LOGICAL                                                                 77990000
   DLVAL,                                                               77995000
   QVAL,                                                                78000000
   QRELAFTX;                                                            78005000
INTEGER                                                                 78010000
   I,                                                                   78015000
   RFA'STATUS,                                                          78020000
   RETURNADDR,                                                          78025000
   SAVEDST;                                                             78030000
EQUATE                                                                  78035000
   <<--- DS Plabels --->>                                               78040000
   RFA'HANDLER'PLX  = 1;                                                78045000
INTEGER                                                                 78050000
   PLAB'RFA;                                                            78055000
DEFINE                                                                  78060000
   PMASK'ECODE     = FCHECKPMASK.(12:1) #;                              78065000
<< ---------------------------------------------------------            78070000
   array for fopen parms to be passed to RFA'HANDLER                    78075000
                             +------------------------+                 78080000
             MESSAGE(0)      | mesage len    +bytes   |                 78085000
                             | protocol   /req type   |                 78090000
             FPARMS(0)       | rfa flags  /# fxd parms|                 78095000
             FPARMS(1)       | 1st fixed parm         |                 78100000
                             |                        |                 78105000
                             |                        |                 78110000
             VPARMBPTRS(0)   | last fixed parm        |                 78115000
             VPARMBPTRS(1)   | 1st variable parm ptr  |                 78120000
                             |                        |                 78125000
                             |                        |                 78130000
                             | last variable parm ptr |                 78135000
      BMESSAGE(VPARMBPTRS(0))| 1st variable parm      |                 78140000
      BMESSAGE(VPARMBPTRS(1))| 2nd variable parm      |                 78145000
                             |                        |                 78150000
                             |                        |                 78155000
                             |                        |                 78160000
                             +------------------------+                 78165000
   --------------------------------------------------------- >>         78170000
EQUATE                                                                  78175000
   MAX'MESSAGE'LEN  = 20;                                               78180000
POINTER                                                                 78185000
   MSGSTACKADDR;                                                        78190000
INTEGER ARRAY                                                           78195000
   MESSAGE (0:MAX'MESSAGE'LEN-1) = Q;                                   78200000
INTEGER ARRAY                                                           78205000
   FPARMS(*)       = MESSAGE(RFA'FPARMS0);                              78210000
DOUBLE ARRAY                                                            78215000
   DFPARMS(*)      = FPARMS;                                            78220000
DEFINE                                                                  78225000
   MESSAGE'LEN     = MESSAGE(0) #,                                      78230000
   SET'MESSAGE'PID = MESSAGE(1).(0:8) := RFA'MSG'PID# ;                 78235000
<< ===================== Subroutines ====================== >>          78240000
<<                                                                      78245000
   The parameters for the subroutine are identical to the               78250000
   one's for RFA'HANDLER ( ... ).                                       78255000
   Therefore we save the return address on TOS at                       78260000
   beginning of this subroutine then the PCAL is made.                  78265000
   All this is done to make the stacking of the parms                   78270000
   a little easier to maintain.                                         78275000
   NOTE:                                                                78280000
   when it comes time to exit from the subroutine there                 78285000
   will be an attempt to execute SXIT N where N is the                  78290000
   number of parms to this subroutine. the problem here                 78295000
   is that these parms were used as parms to the procedure              78300000
   we just called, and which were deleted from stack along              78305000
   with its stack marker. so before the subroutine gets                 78310000
   the chance to do SXIT N we explicitly ask it to do                   78315000
   RETURN 0 so that just the return address is taken off, yes!          78320000
   its kludgey.                                                         78325000
>>                                                                      78330000
DOUBLE SUBROUTINE PCAL'RFA'HANDLER (S'REQ,                              78335000
                                    S'AFTX,                             78340000
                                    S'MESSAGE,                          78345000
                                    S'MESSAGE'LEN,                      78350000
                                    S'OUTBUF,                           78355000
                                    S'OUTBUF'LEN,                       78360000
                                    S'INBUF,                            78365000
                                    S'INBUF'LEN);                       78370000
VALUE                                                                   78375000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             78380000
INTEGER                                                                 78385000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             78390000
BYTE ARRAY                                                              78395000
   S'INBUF, S'OUTBUF;                                                   78400000
INTEGER ARRAY                                                           78405000
   S'MESSAGE;                                                           78410000
<< **********************                                               78415000
   Function: to call rfa'handler                                        78420000
   ********************** >>                                            78425000
BEGIN                    << OF PCAL'RFA'HANDLER             >>          78430000
   RETURNADDR := TOS;                                                   78435000
                                                                        78440000
   TOS := PLAB'RFA;                                                     78445000
   ASSEMBLE (PCAL 0); << will have one word return >>                   78450000
                                                                        78455000
   TOS := RETURNADDR;                                                   78460000
   RETURN 0;                                                            78465000
END;                     << OF PCAL'RFA'HANDLER             >>          78470000
INTEGER SUBROUTINE PCAL'DSCHECK (S'RFA'AFTX);                           78475000
VALUE S'RFA'AFTX;                                                       78480000
INTEGER S'RFA'AFTX;                                                     78485000
<< **********************                                               78490000
   Function: call dscheck with the AFTX for this file                   78495000
   it will attempt to map the error codes in word 2,3 to                78500000
   an exiting DS/file system error number                               78505000
   ********************** >>                                            78510000
BEGIN                                                                   78515000
   RETURNADDR := TOS;                                                   78520000
   TOS := DSCHKPLABEL;   << old dscheck plab, Sysdb (%335) >>  <<09919>>78525000
   ASSEMBLE (PCAL 0);                                                   78530000
   << the error number is at tos and dscheck did an EXIT 1 >>           78535000
   TOS := RETURNADDR;                                                   78540000
   RETURN 0;                                                            78545000
END;                                                                    78550000
LOGICAL SUBROUTINE CHECK'IF'ERROR;                                      78555000
<< **********************                                               78560000
   Function: will check if ERROR'CODE or ERRORCODE <> 0                 78565000
   error had just occured, so set proper condition code                 78570000
   return TRUE                                                          78575000
   NOTE: ERROR'CODE is internal error that resulted in this             78580000
                    procedure, its part of functional return            78585000
         ERRORCODE is caller's by ref parameter for getting             78590000
                   previous ONENET error or remote filesys err          78595000
   ********************** >>                                            78600000
BEGIN                   << OF CHECK'IF'ERROR                >>          78605000
   CHECK'IF'ERROR := FALSE;                                             78610000
   IF ERROR'CODE <> 0 OR ERRORCODE <> 0 THEN                            78615000
   BEGIN                                                                78620000
      IF RFA'AFT'FAILURE THEN                                           78625000
         STATUS.CC := CCE                                               78630000
      ELSE                                                              78635000
         STATUS.CC := CCL;                                              78640000
      CHECK'IF'ERROR := TRUE;                                           78645000
   END;                                                                 78650000
END;                    << OF CHECK'IF'ERROR                >>          78655000
SUBROUTINE INITIALIZE;                                                  78660000
<< **********************                                               78665000
   Function: perform initialization duities                             78670000
   ********************** >>                                            78675000
BEGIN                   << OF INITIALIZE                    >>          78680000
   << misc. variables >>                                                78685000
   RFA'FCHECK := 0D;                                                    78690000
                                                                        78695000
   WHERES'DB;                                                           78700000
   IF = THEN                                                            78705000
      @MSGSTACKADDR := @MESSAGE                                         78710000
   ELSE BEGIN           << else split stack call >>                     78715000
      SAVEDST := EXCHANGEDB (0);                                        78720000
      @MSGSTACKADDR := @MESSAGE;                                        78725000
      EXCHANGEDB (SAVEDST);                                             78730000
   END;                 << else split stack call >>                     78735000
                                                                        78740000
   SETAFTACCESS;                                                        78745000
   IF RFA'AFT'FAILURE THEN                                              78750000
   BEGIN                                                                78755000
      ERRORCODE := PCAL'DSCHECK (RFA'AFTX);                             78760000
      RETURN;                                                           78765000
   END;                                                                 78770000
   << message array >>                                                  78775000
   MESSAGE(0) := 0;                                                     78780000
   MOVE MESSAGE(1) := MESSAGE(0),(MAX'MESSAGE'LEN-1);                   78785000
   SET'MESSAGE'PID;                                                     78790000
                                                                        78795000
   << plabels >>                                                        78800000
   PLAB'RFA := AS'DSPLABEL (RFA'HANDLER'PLX);                           78805000
   IF PLAB'RFA = 0 THEN                                                 78810000
   BEGIN                                                                78815000
      ERROR'CODE := UNIMPL;                                             78820000
      RSTATUS := CCL;                                                   78825000
      RETURN;                                                           78830000
   END;                                                                 78835000
END;                    << OF INITIALIZE                    >>          78840000
<< ====== Procedure Body ====== >>                                      78845000
                                                                        78850000
   ERRORCODE := 0;                                                      78855000
   INITIALIZE;                                                          78860000
   IF CHECK'IF'ERROR THEN RETURN;                                       78865000
                                                                        78870000
   MESSAGE(1).REQ := RFA'CHK;                                           78875000
   FPARMS(0).(8:8) := 2;                                                78880000
   FPARMS(2) := FCHECKPMASK;                                            78885000
   MESSAGE'LEN := ((@FPARMS(2)-@MESSAGE)+1)&LSL(1);                     78890000
                                                                        78895000
   RFA'FCHECK:= PCAL'RFA'HANDLER (RFA'CHK,                              78900000
                                  RFA'AFTX,                             78905000
                                  MSGSTACKADDR,                         78910000
                                  MESSAGE'LEN,                          78915000
                                  A'DUMMY, 0,                           78920000
                                  A'DUMMY, 0);                          78925000
   IF RSTATUS = CCE THEN                                                78930000
   BEGIN                                                                78935000
      ERRORCODE := FPARMS(2);                                           78940000
      TLOG := FPARMS(3);                                                78945000
      BLOCKNUM := DFPARMS(2);                                           78950000
      NUMRECS := FPARMS(6);                                             78955000
   END;                                                                 78960000
                                                                        78965000
   STATUS.CC := CCE;                                                    78970000
END;                    << OF RFA'FCHECK                    >>          78975000
$PAGE "RFA'FFILEINFO"                                                   78980000
DOUBLE PROCEDURE RFA'FFILEINFO (RFA'AFTX,                               78985000
                            ITEM1, ITEM2, ITEM3, ITEM4, ITEM5,          78990000
                            ILEN1, ILEN2, ILEN3, ILEN4, ILEN5,          79000000
                            FFILEINFOPMASK,                             79005000
                            ITEMVAL1, ITEMVAL2, ITEMVAL3,               79010000
                            ITEMVAL4, ITEMVAL5, CRIT);                  79015000
VALUE                                                                   79020000
   RFA'AFTX, FFILEINFOPMASK,                                            79025000
   ITEM1, ITEM2, ITEM3, ITEM4, ITEM5,                                   79030000
   ILEN1, ILEN2, ILEN3, ILEN4, ILEN5, CRIT;                             79035000
INTEGER                                                                 79040000
   RFA'AFTX, ITEM1, ITEM2, ITEM3, ITEM4, ITEM5,                         79045000
   ILEN1, ILEN2, ILEN3, ILEN4, ILEN5;                                   79050000
LOGICAL                                                                 79055000
   FFILEINFOPMASK, CRIT;                                                79060000
BYTE ARRAY                                                              79065000
   ITEMVAL1, ITEMVAL2, ITEMVAL3, ITEMVAL4, ITEMVAL5;                    79070000
OPTION PRIVILEGED, UNCALLABLE;                                 <<01767>>79071000
<< -------------------------------------------------------- >>          79075000
<<    FUNCTIONAL RETURN: none                               >>          79080000
<<                                                          >>          79085000
<<    ALGORITHM:                                            >>          79090000
<<                                                          >>          79095000
<< -------------------------------------------------------- >>          79100000
<<    messege header format:                                >>          79105000
<<                       Req messege      Reply messege     >>          79110000
<<    MESSAGE'LEN      =                                    >>          79115000
<<    MESSAGE(1).(8:8) = RFA'FIL          RFA'FIL           >>          79120000
<<                                                          >>          79125000
<<    FPARMS(0).(8:8)  = 12                7                >>          79130000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          79135000
<<    FPARMS(2)        = itemnum1         item1ptr          >>          79140000
<<    FPARMS(3)        = ilen1            item2ptr          >>          79145000
<<    FPARMS(4)        = itemnum2         item3ptr          >>          79150000
<<    FPARMS(5)        = ilen2            item4ptr          >>          79155000
<<    FPARMS(6)        = itemnum3         item5ptr          >>          79160000
<<    FPARMS(7)        = ilen3            endofparmsptr     >>          79165000
<<    FPARMS(8)        = itemnum4         ------------------>>          79170000
<<    FPARMS(9)        = ilen4                              >>          79175000
<<    FPARMS(10)       = itemnum5                           >>          79180000
<<    FPARMS(11)       = ilen5                              >>          79185000
<<    FPARMS(12)       = parametermask                      >>          79190000
<< -------------------------------------------------------- >>          79195000
BEGIN                   << OF RFA'FFILEINFO                 >>          79200000
                                                                        79205000
INTEGER                                                                 79210000
   ERROR'CODE = RFA'FFILEINFO,                                          79215000
   RSTATUS    = RFA'FFILEINFO+1;                                        79220000
DEFINE                                                                  79225000
   PMASK'IVAL5= FFILEINFOPMASK.(15:1) #,                                79230000
   PMASK'IVAL4= FFILEINFOPMASK.(13:1) #,                                79235000
   PMASK'IVAL3= FFILEINFOPMASK.(11:1) #,                                79240000
   PMASK'IVAL2= FFILEINFOPMASK.( 9:1) #,                                79245000
   PMASK'IVAL1= FFILEINFOPMASK.( 7:1) #;                                79250000
LOGICAL                                                                 79255000
   DLVAL,                                                               79260000
   QVAL,                                                                79265000
   QRELAFTX;                                                            79270000
INTEGER                                                                 79275000
   I,                                                                   79280000
   RFA'STATUS,                                                          79285000
   RETURNADDR;                                                          79290000
EQUATE                                                                  79295000
   RFA'ENVID'ITEM = 61,  ! ffileinfo item num for node name             79300000
   <<--- DS Plabels --->>                                               79305000
   RFA'HANDLER'PLX  = 1,                                                79310000
   RFA'GET'ENVID'PLX = 3;                                               79315000
INTEGER                                                                 79320000
   PLAB'RFA,                                                            79325000
   PLAB'RFA'GET'ENVID;                                                  79330000
<< ---------------------------------------------------------            79335000
   array for fopen parms to be passed to RFA'HANDLER                    79340000
                             +------------------------+                 79345000
             MESSAGE(0)      | mesage len    +bytes   |                 79350000
                             | protocol   /req type   |                 79355000
             FPARMS(0)       | rfa flags  /# fxd parms|                 79360000
             FPARMS(1)       | 1st fixed parm         |                 79365000
                             |                        |                 79370000
                             |                        |                 79375000
             VPARMBPTRS(0)   | last fixed parm        |                 79380000
             VPARMBPTRS(1)   | 1st variable parm ptr  |                 79385000
                             |                        |                 79390000
                             |                        |                 79395000
                             | last variable parm ptr |                 79400000
      BMESSAGE(VPARMBPTRS(0))| 1st variable parm      |                 79405000
      BMESSAGE(VPARMBPTRS(1))| 2nd variable parm      |                 79410000
                             |                        |                 79415000
                             |                        |                 79420000
                             |                        |                 79425000
                             +------------------------+                 79430000
   --------------------------------------------------------- >>         79435000
EQUATE                                                                  79440000
   MAX'MESSAGE'LEN = 128;                                               79445000
INTEGER ARRAY                                                           79450000
   MESSAGE (0:MAX'MESSAGE'LEN-1);                                       79455000
BYTE ARRAY                                                              79460000
   BMESSAGE(*)      = MESSAGE;                                          79465000
INTEGER ARRAY                                                           79470000
   FPARMS(*)       = MESSAGE(RFA'FPARMS0),                              79475000
   VPARMBPTRS(*)   = FPARMS(1);                                         79480000
DOUBLE ARRAY                                                            79485000
   DFPARMS(*)      = FPARMS;                                            79490000
DEFINE                                                                  79495000
   MESSAGE'LEN     = MESSAGE(0) #,                                      79500000
   SET'MESSAGE'PID = MESSAGE(1).(0:8) := RFA'MSG'PID# ;                 79505000
<< ===================== Subroutines ====================== >>          79510000
LOGICAL SUBROUTINE CHECK'IF'ERROR;                                      79515000
<< **********************                                               79520000
   Function: will check if ERROR'CODE is <> 0, if so                    79525000
   error had just occured, so set proper condition code                 79530000
   return TRUE                                                          79535000
   ********************** >>                                            79540000
BEGIN                   << OF CHECK'IF'ERROR                >>          79545000
   CHECK'IF'ERROR := FALSE;                                             79550000
   IF ERROR'CODE <> 0 THEN                                              79555000
   BEGIN                                                                79560000
      STATUS.CC := CCL;                                                 79565000
      CHECK'IF'ERROR := TRUE;                                           79570000
   END;                                                                 79575000
END;                    << OF CHECK'IF'ERROR                >>          79580000
$page                                                                   79585000
<<                                                                      79590000
   The parameters for the subroutine are identical to the               79595000
   one's for DSCHECK  and RFA'HANDLER ( ... ).                          79600000
   Therefore we save the return address on TOS at                       79605000
   beginning of this subroutine then the PCAL is made.                  79610000
   All this is done to make the stacking of the parms                   79615000
   a little easier to maintain.                                         79620000
   NOTE:                                                                79625000
   when it comes time to exit from the subroutine there                 79630000
   will be an attempt to execute SXIT N where N is the                  79635000
   number of parms to this subroutine. the problem here                 79640000
   is that these parms were used as parms to the procedure              79645000
   we just called, and which were deleted from stack along              79650000
   with its stack marker. so before the subroutine gets                 79655000
   the chance to do SXIT N we explicitly ask it to do                   79660000
   RETURN 0 so that just the return address is taken off, yes!          79665000
   its kludgey.                                                         79670000
>>                                                                      79675000
INTEGER SUBROUTINE PCAL'DSCHECK (S'AFTX);                               79680000
VALUE S'AFTX;                                                           79685000
INTEGER S'AFTX;                                                         79690000
<< **********************                                               79695000
   Function: call dscheck with the AFTX for this file                   79700000
   it will attempt to map the error codes in word 2,3 to                79705000
   an exiting DS/file system error number                               79710000
   ********************** >>                                            79715000
BEGIN                                                                   79720000
   RETURNADDR := TOS;                                                   79725000
   TOS := DSCHKPLABEL;   << old dscheck plab, Sysdb (%335) >>  <<09919>>79730000
   ASSEMBLE (PCAL 0);                                                   79735000
   << the error number is at tos and dscheck did an EXIT 1 >>           79740000
   TOS := RETURNADDR;                                                   79745000
   RETURN 0;                                                            79750000
END;                                                                    79755000
DOUBLE SUBROUTINE PCAL'RFA'HANDLER (S'REQ,                              79760000
                                    S'AFTX,                             79765000
                                    S'MESSAGE,                          79770000
                                    S'MESSAGE'LEN,                      79775000
                                    S'OUTBUF,                           79780000
                                    S'OUTBUF'LEN,                       79785000
                                    S'INBUF,                            79790000
                                    S'INBUF'LEN);                       79795000
VALUE                                                                   79800000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             79805000
INTEGER                                                                 79810000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             79815000
BYTE ARRAY                                                              79820000
   S'INBUF, S'OUTBUF;                                                   79825000
INTEGER ARRAY                                                           79830000
   S'MESSAGE;                                                           79835000
<< **********************                                               79840000
   Function: to call rfa'handler                                        79845000
   ********************** >>                                            79850000
BEGIN                    << OF PCAL'RFA'HANDLER             >>          79855000
   RETURNADDR := TOS;                                                   79860000
                                                                        79865000
   TOS := PLAB'RFA;                                                     79870000
   ASSEMBLE (PCAL 0); << will have one word return >>                   79875000
                                                                        79880000
   TOS := RETURNADDR;                                                   79885000
   RETURN 0;                                                            79890000
END;                     << OF PCAL'RFA'HANDLER             >>          79895000
SUBROUTINE PCAL'RFA'GET'ENVID (S'AFTX, S'ENVID);                        79900000
VALUE S'AFTX;                                                           79905000
INTEGER S'AFTX;                                                         79910000
BYTE ARRAY S'ENVID;                                                     79915000
BEGIN                   << OF PCAL'RFA'GET'ENVID            >>          79920000
   RETURNADDR := TOS;                                                   79925000
   TOS := PLAB'RFA'GET'ENVID;                                           79930000
   ASSEMBLE (PCAL 0);                                                   79935000
   TOS := RETURNADDR;                                                   79940000
   RETURN 0;                                                            79945000
END;                    << OF PCAL'RFA'GET'ENVID            >>          79950000
SUBROUTINE INITIALIZE;                                                  79955000
<< **********************                                               79960000
   Function: perform initialization duities                             79965000
   ********************** >>                                            79970000
BEGIN                   << OF INITIALIZE                    >>          79975000
                                                                        79980000
   << misc. variables >>                                                79985000
   RFA'FFILEINFO := 0D;                                                 79990000
                                                                        79995000
   SETAFTACCESS;                                                        80000000
   IF RFA'AFT'FAILURE THEN                                              80005000
   BEGIN                                                                80010000
      ERROR'CODE := PCAL'DSCHECK (RFA'AFTX);                            80015000
      RETURN;                                                           80020000
   END;                                                                 80025000
                                                                        80030000
   << message array >>                                                  80035000
   MESSAGE(0) := 0;                                                     80040000
   MOVE MESSAGE(1) := MESSAGE(0),(MAX'MESSAGE'LEN-1);                   80045000
   SET'MESSAGE'PID;                                                     80050000
                                                                        80055000
   << plabels >>                                                        80060000
   PLAB'RFA := AS'DSPLABEL (RFA'HANDLER'PLX);                           80065000
   PLAB'RFA'GET'ENVID := AS'DSPLABEL (RFA'GET'ENVID'PLX);               80070000
   IF PLAB'RFA = 0 AND PLAB'RFA'GET'ENVID = 0 THEN                      80075000
   BEGIN                                                                80080000
      ERROR'CODE := UNIMPL;                                             80085000
      RETURN;                                                           80090000
   END;                                                                 80095000
END;                    << OF INITIALIZE                    >>          80100000
<< ====== Procedure Body ====== >>                                      80105000
                                                                        80110000
   INITIALIZE;                                                          80115000
   IF CHECK'IF'ERROR THEN RETURN;                                       80120000
                                                                        80125000
   MESSAGE(1).REQ := RFA'FIL;                                           80130000
   FPARMS(0).(8:8) := 12;                                               80135000
   FPARMS(2) := ITEM1;                                                  80140000
   IF PMASK'IVAL1 THEN FPARMS(3) := ILEN1;                              80145000
   FPARMS(4) := ITEM2;                                                  80150000
   IF PMASK'IVAL2 THEN FPARMS(5) := ILEN2;                              80155000
   FPARMS(6) := ITEM3;                                                  80160000
   IF PMASK'IVAL3 THEN FPARMS(7) := ILEN3;                              80165000
   FPARMS(8) := ITEM4;                                                  80170000
   IF PMASK'IVAL4 THEN FPARMS(9) := ILEN4;                              80175000
   FPARMS(10) := ITEM5;                                                 80180000
   IF PMASK'IVAL5 THEN FPARMS(11) := ILEN5;                             80185000
   FPARMS(12) := FFILEINFOPMASK;                                        80190000
                                                                        80195000
   MESSAGE'LEN := ((@FPARMS(12)-@MESSAGE)+1)&LSL(1);                    80200000
                                                                        80205000
   RFA'FFILEINFO := PCAL'RFA'HANDLER (RFA'FIL,                          80210000
                                      RFA'AFTX,                         80215000
                                      MESSAGE,                          80220000
                                      MESSAGE'LEN,                      80225000
                                      A'DUMMY, 0,                       80230000
                                      A'DUMMY, 0);                      80235000
   IF RSTATUS = CCE THEN                                                80240000
   BEGIN    << move the given item values >>                            80245000
      SETAFTACCESS;                                            <<01183>>80246000
      IF PMASK'IVAL1 THEN                                               80250000
      BEGIN              << check for special RFA items >>              80255000
         IF ITEM1 = RFA'ENVID'ITEM THEN                                 80260000
            PCAL'RFA'GET'ENVID (RFA'AFTX, ITEMVAL1)                     80265000
         ELSE                                                           80270000
            MOVE ITEMVAL1 := BMESSAGE(VPARMBPTRS(1)),                   80275000
                             (VPARMBPTRS(2)-VPARMBPTRS(1));             80280000
         IF ITEM1 = 6 AND ITEMVAL1 <> (0,0) THEN               <<01183>>80285000
            ITEMVAL1 := RFA'AFT'ENVNUM                         <<01183>>80290000
         ELSE IF ITEM1 = 51 THEN                               <<01183>>80291000
            ITEMVAL1(1) := RFA'AFT'ENVNUM;                     <<01183>>80292000
      END;                                                              80295000
      IF PMASK'IVAL2 THEN                                               80300000
      BEGIN              << check for special RFA items >>              80305000
         IF ITEM2 = RFA'ENVID'ITEM THEN                                 80310000
            PCAL'RFA'GET'ENVID (RFA'AFTX, ITEMVAL2)                     80315000
         ELSE                                                           80320000
            MOVE ITEMVAL2 := BMESSAGE(VPARMBPTRS(2)),                   80325000
                             (VPARMBPTRS(3)-VPARMBPTRS(2));             80330000
         IF ITEM2 = 6 AND ITEMVAL2 <> (0,0) THEN               <<01183>>80335000
            ITEMVAL2 := RFA'AFT'ENVNUM                         <<01183>>80340000
         ELSE IF ITEM2 = 51 THEN                               <<01183>>80341000
            ITEMVAL2(1) := RFA'AFT'ENVNUM;                     <<01183>>80342000
      END;                                                              80345000
      IF PMASK'IVAL3 THEN                                               80350000
      BEGIN              << check for special RFA items >>              80355000
         IF ITEM3 = RFA'ENVID'ITEM THEN                                 80360000
            PCAL'RFA'GET'ENVID (RFA'AFTX, ITEMVAL3)                     80365000
         ELSE                                                           80370000
            MOVE ITEMVAL3 := BMESSAGE(VPARMBPTRS(3)),                   80375000
                             (VPARMBPTRS(4)-VPARMBPTRS(3));             80380000
         IF ITEM3 = 6 AND ITEMVAL3 <> (0,0) THEN               <<01183>>80385000
            ITEMVAL3 := RFA'AFT'ENVNUM                         <<01183>>80390000
         ELSE IF ITEM3 = 51 THEN                               <<01183>>80391000
            ITEMVAL3(1) := RFA'AFT'ENVNUM;                     <<01183>>80392000
      END;                                                              80395000
      IF PMASK'IVAL4 THEN                                               80400000
      BEGIN              << check for special RFA items >>              80405000
         IF ITEM4 = RFA'ENVID'ITEM THEN                                 80410000
            PCAL'RFA'GET'ENVID (RFA'AFTX, ITEMVAL4)                     80415000
         ELSE                                                           80420000
            MOVE ITEMVAL4 := BMESSAGE(VPARMBPTRS(4)),                   80425000
                             (VPARMBPTRS(5)-VPARMBPTRS(4));             80430000
         IF ITEM4 = 6 AND ITEMVAL4 <> (0,0) THEN               <<01183>>80435000
            ITEMVAL4 := RFA'AFT'ENVNUM                         <<01183>>80440000
         ELSE IF ITEM4 = 51 THEN                               <<01183>>80441000
            ITEMVAL4(1) := RFA'AFT'ENVNUM;                     <<01183>>80442000
      END;                                                              80445000
      IF PMASK'IVAL5 THEN                                               80450000
      BEGIN              << check for special RFA items >>              80455000
         IF ITEM5 = RFA'ENVID'ITEM THEN                                 80460000
            PCAL'RFA'GET'ENVID (RFA'AFTX, ITEMVAL5)                     80465000
         ELSE                                                           80470000
            MOVE ITEMVAL5 := BMESSAGE(VPARMBPTRS(5)),                   80475000
                             (VPARMBPTRS(6)-VPARMBPTRS(5));             80480000
         IF ITEM5 = 6 AND ITEMVAL5 <> (0,0) THEN               <<01183>>80485000
            ITEMVAL5 := RFA'AFT'ENVNUM                         <<01183>>80490000
         ELSE IF ITEM5 = 51 THEN                               <<01183>>80491000
            ITEMVAL5(1) := RFA'AFT'ENVNUM;                     <<01183>>80492000
      END;                                                              80495000
      << VPARMBPTRS(6) has the last+1 byte index to vparms >>           80500000
   END;     << move the given item values >>                            80505000
                                                                        80510000
   STATUS.CC := CCE;                                                    80515000
END;                    << OF RFA'FFILEINFO                 >>          80520000
$PAGE "RFA'FGETINFO"                                                    80525000
DOUBLE PROCEDURE  RFA'FGETINFO (RFA'AFTX,                               80530000
                                FGETINFOPMASK1,                         80535000
                                FGETINFOPMASK2,                         80540000
                                FOPTIONS,                               80545000
                                AOPTIONS,                               80550000
                                RECSIZE,                                80555000
                                DEVTYPE,                                80560000
                                LDEVNUM,                                80565000
                                HARDWAREADDR,                           80570000
                                FILECODE,                               80575000
                                RECPTR,                                 80580000
                                EOFPTR,                                 80585000
                                FILELIMIT,                              80590000
                                LOGCOUNT,                               80595000
                                PHYSCOUNT,                              80600000
                                BLOCKSIZE,                              80605000
                                EXTENTSIZE,                             80610000
                                NUMEXTENTS,                             80615000
                                USERLABELS,                             80620000
                                FILENAME,                               80625000
                                CREATORID,                              80630000
                                DISKADDR,                               80635000
                                CRIT);                                  80640000
VALUE                                                                   80645000
   RFA'AFTX, FGETINFOPMASK1, FGETINFOPMASK2, CRIT;                      80650000
INTEGER                                                                 80655000
   RFA'AFTX, RECSIZE, DEVTYPE, FILECODE, BLOCKSIZE, NUMEXTENTS,         80660000
   USERLABELS;                                                          80665000
LOGICAL                                                                 80670000
   FGETINFOPMASK1, FGETINFOPMASK2 , FOPTIONS, AOPTIONS, LDEVNUM,        80675000
   HARDWAREADDR, EXTENTSIZE, CRIT;                                      80680000
DOUBLE                                                                  80685000
   RECPTR, EOFPTR, FILELIMIT, LOGCOUNT, PHYSCOUNT, DISKADDR;            80690000
BYTE ARRAY                                                              80695000
   FILENAME, CREATORID;                                                 80700000
OPTION PRIVILEGED, UNCALLABLE;                                 <<01767>>80701000
<< -------------------------------------------------------- >>          80705000
<<    FUNCTIONAL RETURN: none                               >>          80710000
<<                                                          >>          80715000
<<    ALGORITHM:                                            >>          80720000
<<                                                          >>          80725000
<< -------------------------------------------------------- >>          80730000
<<    messege header format:                                >>          80735000
<<                       Req messege      Reply messege     >>          80740000
<<    MESSAGE'LEN      =                                    >>          80745000
<<    MESSAGE(1).(8:8) = RFA'GET          RFA'GET           >>          80750000
<<                                                          >>          80755000
<<    FPARMS(0).(8:8)  =  2               24                >>          80760000
<<    FPARMS(1)        = RemotefileID     status/localfileid>>          80765000
<<    FPARMS(2)        = parametermask1   foptions          >>          80770000
<<    FPARMS(3)        = parametermask2   aoptions          >>          80775000
<<    FPARMS(4)        = --------------   recsize           >>          80780000
<<    FPARMS(5)        =                  devtype           >>          80785000
<<    FPARMS(6)        =                  ldevnum           >>          80790000
<<    FPARMS(7)        =                  hardwareaddr      >>          80795000
<<    FPARMS(8)        =                  filecode          >>          80800000
<<    FPARMS(9)        =                  recptr            >>          80805000
<<    FPARMS(10)       =                    "               >>          80810000
<<    FPARMS(11)       =                  eofptr            >>          80815000
<<    FPARMS(12)       =                    "               >>          80820000
<<    FPARMS(13)       =                  filelimit         >>          80825000
<<    FPARMS(14)       =                    "               >>          80830000
<<    FPARMS(15)       =                  logcount          >>          80835000
<<    FPARMS(16)       =                    "               >>          80840000
<<    FPARMS(17)       =                  physcount         >>          80845000
<<    FPARMS(18)       =                    "               >>          80850000
<<    FPARMS(19)       =                  blocksize         >>          80855000
<<    FPARMS(20)       =                  extentsize        >>          80860000
<<    FPARMS(21)       =                  numextents        >>          80865000
<<    FPARMS(22)       =                  userlabels        >>          80870000
<<    FPARMS(23)       =                  diskaddr          >>          80875000
<<    FPARMS(24)       =                    "               >>          80880000
<<    VPARMBPTRS(1)    =                  filenameptr       >>          80885000
<<    VPARMBPTRS(2)    =                  creatorIDptr      >>          80890000
<<    VPARMBPTRS(3)    =                  endofparmsptr     >>          80895000
<< -------------------------------------------------------- >>          80900000
BEGIN                   << OF RFA'FGETINFO                  >>          80905000
                                                                        80910000
INTEGER                                                                 80915000
   ERROR'CODE = RFA'FGETINFO,                                           80920000
   RSTATUS    = RFA'FGETINFO+1;                                         80925000
                                                                        80930000
DEFINE                                                                  80935000
   PMASK'FNAME       = FGETINFOPMASK1.(13:1) #,                         80940000
   PMASK'CREATID     = FGETINFOPMASK2.(14:1) #,                         80945000
   PMASK'HDADDR      = FGETINFOPMASK2.( 3:1) #,                         80950000
   PMASK'DISKADDR    = FGETINFOPMASK2.(15:1) #;                         80955000
                                                                        80960000
LOGICAL                                                                 80965000
   DLVAL,                                                               80970000
   QVAL,                                                                80975000
   QRELAFTX;                                                            80980000
                                                                        80985000
INTEGER                                                                 80990000
   I,                                                                   80995000
   PREVQ'UBND,                                                          81000000
   RFA'STATUS,                                                          81005000
   RETURNADDR;                                                          81010000
                                                                        81015000
<< DS Plabels >>                                                        81020000
EQUATE                                                                  81025000
   RFA'HANDLER'PLX  = 1;                                                81030000
                                                                        81035000
INTEGER                                                                 81040000
   PLAB'RFA;                                                            81045000
                                                                        81050000
DEFINE                                                                  81055000
   RETURNBERR      = BEGIN                                              81060000
                        STATUS.CC := CCL;                               81065000
                        RETURN;                                         81070000
                     END #;                                             81075000
                                                                        81080000
<<                                                                      81085000
   array for fopen parms to be passed to RFA'HANDLER                    81090000
                             +------------------------+                 81095000
             MESSAGE(0)      | mesage len    +words   |                 81100000
                             | protocol   /req type   |                 81105000
             FPARMS(0)       | rfa flags  /# fxd parms|                 81110000
             FPARMS(1)       | 1st fixed parm         |                 81115000
                             |                        |                 81120000
                             |                        |                 81125000
             VPARMBPTRS(0)   | last fixed parm        |                 81130000
             VPARMBPTRS(1)   | 1st variable parm ptr  |                 81135000
                             |                        |                 81140000
                             |                        |                 81145000
                             | last variable parm ptr |                 81150000
      BMESSAGE(VPARMBPTRS(0))| 1st variable parm      |                 81155000
      BMESSAGE(VPARMBPTRS(1))| 2nd variable parm      |                 81160000
                             |                        |                 81165000
                             |                        |                 81170000
                             |                        |                 81175000
                             +------------------------+                 81180000
>>                                                                      81185000
EQUATE                                                                  81190000
   MAX'MESSAGE'LEN = 50;                                                81195000
INTEGER ARRAY                                                           81200000
   MESSAGE (0:MAX'MESSAGE'LEN-1) = Q;                                   81205000
BYTE ARRAY                                                              81210000
   BMESSAGE(*)      = MESSAGE;                                          81215000
INTEGER ARRAY                                                           81220000
   FPARMS(*)       = MESSAGE(RFA'FPARMS0),                              81225000
   VPARMBPTRS(*)   = FPARMS(24);                                        81230000
DOUBLE ARRAY                                                            81235000
   DFPARMS(*)      = FPARMS;                                            81240000
DEFINE                                                                  81245000
   MESSAGE'LEN     = MESSAGE(0) #,                                      81250000
   SET'MESSAGE'PID = MESSAGE(1).(0:8) := RFA'MSG'PID# ;                 81255000
                                                                        81260000
<< ===================== Subroutines ====================== >>          81265000
LOGICAL SUBROUTINE CHECK'IF'ERROR;                                      81270000
<< **********************                                               81275000
   Function: will check if ERROR'CODE is <> 0, if so                    81280000
   error had just occured, so set proper condition code                 81285000
   return TRUE                                                          81290000
   ********************** >>                                            81295000
BEGIN                   << OF CHECK'IF'ERROR                >>          81300000
   CHECK'IF'ERROR := FALSE;                                             81305000
   IF ERROR'CODE <> 0 THEN                                              81310000
   BEGIN                                                                81315000
      STATUS.CC := CCL;                                                 81320000
      CHECK'IF'ERROR := TRUE;                                           81325000
   END;                                                                 81330000
                                                                        81335000
END;                    << OF CHECK'IF'ERROR                >>          81340000
$PAGE                                                                   81345000
<<                                                                      81350000
   The parameters for the subroutine are identical to the               81355000
   one's for DSCHECK and RFA'HANDLER ( ... ).                           81360000
   Therefore we save the return address on TOS at                       81365000
   beginning of this subroutine then the PCAL is made.                  81370000
   All this is done to make the stacking of the parms                   81375000
   a little easier to maintain.                                         81380000
   NOTE:                                                                81385000
   when it comes time to exit from the subroutine there                 81390000
   will be an attempt to execute SXIT N where N is the                  81395000
   number of parms to this subroutine. the problem here                 81400000
   is that these parms were used as parms to the procedure              81405000
   we just called, and which were deleted from stack along              81410000
   with its stack marker. so before the subroutine gets                 81415000
   the chance to do SXIT N we explicitly ask it to do                   81420000
   RETURN 0 so that just the return address is taken off, yes!          81425000
   its kludgey.                                                         81430000
>>                                                                      81435000
INTEGER SUBROUTINE PCAL'DSCHECK (S'RFA'AFTX);                           81440000
VALUE S'RFA'AFTX;                                                       81445000
INTEGER S'RFA'AFTX;                                                     81450000
<< **********************                                               81455000
   Function: call dscheck with the AFTX for this file                   81460000
   it will attempt to map the error codes in word 2,3 to                81465000
   an exiting DS/file system error number                               81470000
   ********************** >>                                            81475000
BEGIN                                                                   81480000
   RETURNADDR := TOS;                                                   81485000
   TOS := DSCHKPLABEL;   << old dscheck plab, Sysdb (%335) >>  <<09919>>81490000
   ASSEMBLE (PCAL 0);                                                   81495000
   << the error number is at tos and dscheck did an EXIT 1 >>           81500000
   TOS := RETURNADDR;                                                   81505000
   RETURN 0;                                                            81510000
END;                                                                    81515000
DOUBLE SUBROUTINE PCAL'RFA'HANDLER  (S'REQ,                             81520000
                                     S'AFTX,                            81525000
                                     S'MESSAGE,                         81530000
                                     S'MESSAGE'LEN,                     81535000
                                     S'OUTBUF,                          81540000
                                     S'OUTBUF'LEN,                      81545000
                                     S'INBUF,                           81550000
                                     S'INBUF'LEN);                      81555000
VALUE                                                                   81560000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             81565000
INTEGER                                                                 81570000
   S'REQ, S'AFTX, S'MESSAGE'LEN, S'INBUF'LEN, S'OUTBUF'LEN;             81575000
BYTE ARRAY                                                              81580000
   S'INBUF, S'OUTBUF;                                                   81585000
INTEGER ARRAY                                                           81590000
   S'MESSAGE;                                                           81595000
                                                                        81600000
<< **********************                                               81605000
   Function: to call rfa'handler                                        81610000
   ********************** >>                                            81615000
BEGIN                    << OF PCAL'RFA'HANDLER             >>          81620000
   RETURNADDR := TOS;                                                   81625000
                                                                        81630000
   TOS := PLAB'RFA;                                                     81635000
   ASSEMBLE (PCAL 0); << will have one word return >>                   81640000
                                                                        81645000
   TOS := RETURNADDR;                                                   81650000
   RETURN 0;                                                            81655000
END;                     << OF PCAL'RFA'HANDLER             >>          81660000
SUBROUTINE INITIALIZE;                                                  81665000
<< **********************                                               81670000
   Function: perform initialization duities                             81675000
   ********************** >>                                            81680000
BEGIN                   << OF INITIALIZE                    >>          81685000
                                                                        81690000
   << misc. variables >>                                                81695000
   RFA'FGETINFO := 0D;                                                  81700000
                                                                        81705000
   SETAFTACCESS;                                                        81710000
   IF RFA'AFT'FAILURE THEN                                              81715000
   BEGIN                                                                81720000
      ERROR'CODE := PCAL'DSCHECK (RFA'AFTX);                            81725000
      RETURN;                                                           81730000
   END;                                                                 81735000
                                                                        81740000
   MESSAGE(0) := 0;  << clear out message array >>                      81745000
   MOVE MESSAGE(1) := MESSAGE(0),(MAX'MESSAGE'LEN-1);                   81750000
   SET'MESSAGE'PID;                                                     81755000
                                                                        81760000
   << plabels >>                                                        81765000
   PLAB'RFA := AS'DSPLABEL (RFA'HANDLER'PLX);                           81770000
   IF PLAB'RFA = 0 THEN                                                 81775000
   BEGIN                                                                81780000
      ERROR'CODE := UNIMPL;                                             81785000
      RETURN;                                                           81790000
   END;                                                                 81795000
END;                    << OF INITIALIZE                    >>          81800000
                                                                        81805000
<< ====== Procedure Body ====== >>                                      81810000
                                                                        81815000
   INITIALIZE;                                                          81820000
   IF CHECK'IF'ERROR THEN RETURN;                                       81825000
                                                                        81830000
   MESSAGE(1).REQ := RFA'GET;                                           81835000
   FPARMS(0).(8:8) := 3;                                                81840000
   FPARMS(2) := FGETINFOPMASK1;                                         81845000
   FPARMS(3) := FGETINFOPMASK2;                                         81850000
                                                                        81855000
   MESSAGE'LEN := ((@FPARMS(3)-@MESSAGE)+1)&LSL(1);                     81860000
                                                                        81865000
   RFA'FGETINFO := PCAL'RFA'HANDLER (RFA'GET,                           81870000
                                     RFA'AFTX,                          81875000
                                     MESSAGE,                           81880000
                                     MESSAGE'LEN,                       81885000
                                     A'DUMMY, 0,                        81890000
                                     A'DUMMY, 0);                       81895000
                                                                        81900000
   IF RSTATUS = CCE THEN                                                81905000
   BEGIN         << if remote fgetinfo was ok >>                        81910000
       FOPTIONS    := FPARMS( 2);                                       81915000
       AOPTIONS    := FPARMS( 3);                                       81920000
       RECSIZE     := FPARMS( 4);                                       81925000
       DEVTYPE     := FPARMS( 5);                                       81930000
       IF FPARMS(6) = 0 THEN                                   <<01183>>81935000
          LDEVNUM := 0                                         <<01183>>81936000
       ELSE                                                    <<01183>>81937000
          LDEVNUM := LOGICAL(FPARMS(6)) LOR %177400;           <<01183>>81938000
       << HARDWAREADDR:=FPARMS( 7) needs bounds checking >>             81940000
       FILECODE    := FPARMS( 8);                                       81945000
       TOS         := FPARMS( 9);                                       81950000
       TOS         := FPARMS(10);                                       81955000
       RECPTR      := TOS;                                              81960000
       TOS         := FPARMS(11);                                       81965000
       TOS         := FPARMS(12);                                       81970000
       EOFPTR      := TOS;                                              81975000
       TOS         := FPARMS(13);                                       81980000
       TOS         := FPARMS(14);                                       81985000
       FILELIMIT   := TOS;                                              81990000
       TOS         := FPARMS(15);                                       81995000
       TOS         := FPARMS(16);                                       82000000
       LOGCOUNT    := TOS;                                              82005000
       TOS         := FPARMS(17);                                       82010000
       TOS         := FPARMS(18);                                       82015000
       PHYSCOUNT   := TOS;                                              82020000
       BLOCKSIZE   := FPARMS(19);                                       82025000
       EXTENTSIZE  := FPARMS(20);                                       82030000
       NUMEXTENTS  := FPARMS(21);                                       82035000
       USERLABELS  := FPARMS(22);                                       82040000
                                                                        82045000
                                                                        82050000
       PREVQ'UBND := -(DELTAQ+26); << 26=FGETINFO UBND >>               82055000
                                                                        82060000
       IF PMASK'FNAME THEN                                              82065000
       BEGIN    << filename wanted >>                                   82070000
          IF NOT FBNDCHK(@FILENAME,-28,PREVQ'UBND) THEN                 82075000
             RETURNBERR;                                                82080000
          MOVE FILENAME := BMESSAGE(VPARMBPTRS(1)),                     82085000
                                   (VPARMBPTRS(2)-VPARMBPTRS(1));       82090000
       END;                                                             82095000
                                                                        82100000
       IF PMASK'CREATID THEN                                            82105000
       BEGIN    << Creator ID wanted >>                                 82110000
          IF NOT FBNDCHK(@CREATORID,-8,PREVQ'UBND) THEN                 82115000
             RETURNBERR;                                                82120000
          MOVE CREATORID := BMESSAGE(VPARMBPTRS(2)),                    82125000
                                    (VPARMBPTRS(3)-VPARMBPTRS(2));      82130000
       END;                                                             82135000
                                                                        82140000
       IF PMASK'DISKADDR THEN                                           82145000
       BEGIN    << Disk address wanted >>                               82150000
          IF NOT FBNDCHK(@DISKADDR,2,PREVQ'UBND) THEN                   82155000
             RETURNBERR;                                                82160000
          TOS := FPARMS(23);                                            82165000
          TOS := FPARMS(24);                                            82170000
          DISKADDR := TOS;                                              82175000
       END;                                                             82180000
                                                                        82185000
       IF PMASK'HDADDR THEN                                             82190000
       BEGIN    << return hardware address >>                           82195000
          IF NOT FBNDCHK(@HARDWAREADDR,1,PREVQ'UBND) THEN               82200000
             RETURNBERR;                                                82205000
          HARDWAREADDR := FPARMS(7);                                    82210000
       END;                                                             82215000
   END;          << if remote fgetinfo was ok >>                        82220000
                                                                        82225000
   STATUS.CC := CCE;                                                    82230000
END;                    << OF RFA'FGETINFO                  >>          82235000
$PAGE "RFA'CIPIN"                                              <<01767>>82240000
INTEGER PROCEDURE RFA'CIPIN (PIN);                             <<01767>>82240010
VALUE PIN;                                                     <<01767>>82240012
INTEGER PIN;                                                   <<01767>>82240014
OPTION PRIVILEGED, UNCALLABLE;                                 <<01767>>82240016
COMMENT                                                        <<01767>>82240020
***************************************************************<<01767>>82240021
*                                                             *<<01767>>82240022
*                   FUNCTION OF PROCEDURE                     *<<01767>>82240023
*                                                             *<<01767>>82240024
* This procedure will return the CI pin number for the        *<<01767>>82240025
* specified pin for regular  son processes of the CI or       *<<01767>>82240026
* dsserver processes which are NS servers for that Job/Session*<<01767>>82240027
* but are sons of DSDAD, a system process. If the pin is      *<<01767>>82240028
* neither of then a 0 value is returned.                      *<<01767>>82240029
*                                                             *<<01767>>82240030
***************************************************************<<01767>>82240031
*                                                             *<<01767>>82240040
*                         ALGORITHM                           *<<01767>>82240041
*                                                             *<<01767>>82240042
* if process is a dsserver type then                          *<<01767>>82240043
*    call as'ptab'extn'get using the NS plabel table          *<<01767>>82240044
* else                                                        *<<01767>>82240045
*    while father is not CI Ptype or father pin <> 0          *<<01767>>82240046
*       pcb := father (pcb)                                   *<<01767>>82240047
*                                                             *<<01767>>82240048
***************************************************************<<01767>>82240049
*                                                             *<<01767>>82240050
*                         PARAMETERS                          *<<01767>>82240051
*                                                             *<<01767>>82240052
* rfa'cipin           : CI pin for following pin parm         *<<01767>>82240053
*                       return value                          *<<01767>>82240054
* pin                 : the process number whose CI pin is    *<<01767>>82240060
*                       about to be found out                 *<<01767>>82240061
*                                                             *<<01767>>82240062
***************************************************************<<01767>>82240063
*                                                             *<<01767>>82240064
*                     NOTES AND CAUTIONS                      *<<01767>>82240065
*                                                             *<<01767>>82240066
* DB SETTING:  ENTRY = Stack            EXIT = Stack          *<<01767>>82240067
* RESOURCES: none                                             *<<01767>>82240068
* CONDITION CODES: not used                                   *<<01767>>82240069
*                                                             *<<01767>>82240080
***************************************************************<<01767>>82240081
*                                                             *<<01767>>82240082
* CREATOR OF MODULE:  John Hahn                               *<<01767>>82240083
*                                                             *<<01767>>82240084
* MODIFICATION HISTORY:                                       *<<01767>>82240085
*  Date    SR #    Fix #   Name           Summary             *<<01767>>82240086
* ------ -------- ------ -------- --------------------------- *<<01767>>82240087
* 1/3/86                 J. Hahn  Submittal of this procedure *<<01767>>82240088
*                                                             *<<01767>>82240089
***************************************************************<<01767>>82240298
END OF COMMENT;                                                <<01767>>82240299
                                                               <<01767>>82240300
BEGIN                   << Procedure RFA'CIPIN >>              <<01767>>82240310
                                                               <<01767>>82240320
INTEGER                                                        <<01767>>82240330
   return'val = RFA'CIPIN,                                     <<01767>>82240340
   savedb;                                                     <<01767>>82240342
LOGICAL                                                        <<01767>>82240350
   pcbpt,                                                      <<01767>>82240360
   plab;                                                       <<01767>>82240370
EQUATE                                                         <<01767>>82240380
   IDX'AS'PTAB'EXTN'GET = 33,                                  <<01767>>82240390
   AS'RFA'OFF'EXTN = 11,                                       <<01767>>82240400
   AS'RFA'LEN'EXTN = 1,                                        <<01767>>82240410
   USER'MAIN       = 2,    << Process type for a ci pin.   >>  <<01767>>82240420
   SYSPROC'PTYPE   = 4;    << PCB ptype for system process.>>  <<01767>>82240430
                                                               <<01767>>82240440
   return'val := 0;                                            <<01767>>82241000
                                                               <<01767>>82241010
   pcbpt := pin * PCBSIZE;                                     <<01767>>82241020
   if spcbsrve then                                            <<01767>>82241030
   begin           << if dsserver process >>                   <<01767>>82241040
      savedb := exchangedb (0);                                <<01767>>82241042
      plab := AS'DSPLABEL (IDX'AS'PTAB'EXTN'GET);              <<01767>>82241050
      if plab <> 0 then                                        <<01767>>82241100
      begin             << if NS installed >>                  <<01767>>82241110
         tos := pin;                                           <<01767>>82241120
         tos := AS'RFA'OFF'EXTN;                               <<01767>>82241130
         tos := AS'RFA'LEN'EXTN;                               <<01767>>82241141
         tos := @return'val;                                   <<01767>>82241150
         tos := plab;                                          <<01767>>82241160
         assemble (PCAL 0);                                    <<01767>>82241170
      end;              << if NS installed >>                  <<01767>>82241180
      if savedb <> 0 then                                      <<01767>>82241182
         exchangedb (savedb);                                  <<01767>>82241184
   end             << if dsserver process >>                   <<01767>>82241190
   else begin      << else all others >>                       <<01767>>82241210
      WHILE ( integer(spcbptype) < user'main )                 <<01767>>82241212
            AND ( integer(pcbpt) <> 0 )                        <<01767>>82241220
         DO pcbpt := integer(spcbfatherinfo);                  <<01767>>82241230
      if integer(spcbptype) = user'main then                   <<01767>>82241240
         return'val := pcbpt/PCBSIZE;                          <<01767>>82241244
   end;            << else all others >>                       <<01767>>82241250
                                                               <<01767>>82241260
END;                    << Procedure RFA'CIPIN >>              <<01767>>82241270
PROCEDURE  FILESYSRFAVERS (VERS);                                       82245000
BYTE ARRAY VERS;                                                        82250000
BEGIN                                                                   82255000
   MOVE VERS := RFA'VERSION'STR;                                        82260000
END;                                                                    82265000
$PAGE "MPE V FILE SYSTEM - OUTER BLOCK"                                 82270000
$CONTROL SEGMENT=FILEACCESS, MAP                                        82275000
END.   << File System >>                                                82280000
