Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / burroughs / b79dir.alg < prev next >

Wrap

Text File | 2020-01-01 | 98KB | 1,206 lines

$ SET LIST 10000000 %#CP PPT 10001000 $ SET USERTREE 10001500 $ SHARING = PRIVATE 10002000 10003000 10004000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10004200 % %10004250 % %10004300 % L I B R A R Y / D I R S E A R C H %10004350 % ================================= %10004400 % %10004450 % MAKES DIRECTORY SEARCHES EASY %10004500 % %10004550 % COPYRIGHT: EINDHOVEN UNIVERSITY OF TECHNOLOGY, 1982. %10004600 % %10004650 % AUTHOR: CAREL BRAAM, JANUARY 1982. %10004700 % %10004750 % %10004800 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10005000 $ PAGE 10006000 BEGIN 10015000 10015250 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10015260 % %10015270 % DESCRIPTION OF EXPORTED PROCEDURES %10015280 % AND THEIR USAGE %10015290 % %10015300 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10015310 % %10015320 % %10015330 % EXPORT LIST: %10015340 % %10015350 % DIRREQUEST %10015360 % DIRSIZE %10015370 % DISPLAYFILEKIND %10015380 % DISPLAYREQUEST %10015390 % GETDIRECTORY %10015395 % GETTITLE %10015400 % INITDIR %10015420 % TITLESTART %10015430 % %10015440 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10015450 % 10015453 % 10015454 BOOLEAN PROCEDURE DIRSIZE (FILES, SEGS); 10015455 % ------- 10015456 INTEGER FILES, SEGS; FORWARD; 10015457 % 10015460 % 10015470 % DIRSIZE RESULT VALUES: SEE GETTITLE RESULT VALUES. 10015472 % FILES: NUMBER OF FILES IN DIRECTORY 10015474 % SEGS: NUMBER OF SEGMENTS IN USE BY THIS DIRECTORY 10015476 % 10015478 % 10015480 BOOLEAN PROCEDURE DIRREQUEST (DIR, SPEC); 10015490 % ---------- 10015500 VALUE DIR, SPEC; POINTER DIR; BOOLEAN SPEC; FORWARD; 10015510 10015520 DEFINE 10015530 % 10015540 % 10015550 % *** MEANING OF THE OPTION BITS IN SPEC (INPUT PARAMETER) 10015560 % 10015570 % 10015580 USERDIRF = [0:1] #, 10015590 NOONPARTF = [1:1] #, 10015600 RETAINUSF = [2:1] #, 10015610 ALLOWSUBF = [3:1] #, 10015620 ALLOWEMPTYF = [4:1] #, 10015630 WAITONFILEF = [5:1] #, 10015640 ONEPACKONLYF = [6:1] #, 10015650 % 10015660 % *** DIRREQUEST RESULT VALUES 10015670 % 10015680 ERRORBIT = [ 0: 1] #, 10015690 ERTYPEF = [ 3: 3] #, 10015700 NVLDREQUEST = 0 #, 10015710 NVLDONPART = 1 #, 10015720 TOOMANYNAMES = 2 #, 10015730 USERCODESNTX = 3 #, 10015740 NAMESNTX = 4 #, 10015750 STRINGSNTX = 5 #, 10015760 NOSPONSOR = 6 #, 10015770 ONPARTXPTD = 7 #, 10015780 EQUALF = [ 4: 1] #, 10015790 PERIODF = [ 5: 1] #, 10015800 FILEORDIRF = [ 6: 1] #, 10015810 VISIBLEF = [ 7: 1] #, 10015820 NOPREFIXF = [ 8: 1] #, 10015830 OTHERLIBF = [ 9: 1] #, 10015840 STRUCTDIRF = [10: 1] #, 10015850 NNAMESF = [27: 4] #, 10015860 SCANLENF = [37:10] #, 10015870 TITLESTARTF = [47:10] #, 10015880 LASTDIRDEF = #; 10015890 % 10015900 % 10015910 % 10015920 BOOLEAN PROCEDURE GETTITLE (TITL); ARRAY TITL [0]; FORWARD; 10015950 % -------- 10015960 10015970 DEFINE 10015980 % 10015984 % GETTITLE RESULT VALUES 10015985 % 10015986 % ERRORBIT = [ 0:1] #, 10015987 % ERTYPEF = [ 3:3] #, 10015988 ENDOFDIR = 0 #, % NORMAL 10015989 NOFILES = 1 #, 10015990 NOFAMILY = 2 #, 10015991 SOFTERROR = 3 #, 10015992 HARDERROR = 4 #, 10015993 % HARDERRORF = [11:8] #, 10015994 SOFTERRORF = [46:8] #, % ERRORVALUEF 10015995 % 10015996 % 10016000 % TITL: THE FIRST TITLESTART WORDS CONTAIN FILE ATTRIBUTES 10016010 % AS SHOWN IN THE TABLE BELOW. 10016020 % IN TITLE [TITLESTART] STARTS THE FILE TITLE IN DISPLAY FORM, 10016022 % FOLLOWED BY A PERIOD AND A NULL CHARACTER. 10016024 % 10016026 % 10016028 % 10016030 FILEINFO = 0 #, 10016050 10016052 % SUB FIELDS: 10016055 FILEKINDF = [46:8] #, 10016060 OPENF = [36:1] #, 10016070 OWNERF = [34:2] #, 10016080 LENGTHF = [32:10] #, % PART OF LINK FIELD 10016090 10016095 CREATIONDATE = 1 #, 10016100 BLOCKING = 2 #, 10016110 % SUB FIELDS: 10016115 BLOCKSIZEF = [47:16] #, 10016120 MINRECSIZEF = [31:16] #, 10016130 MAXRESIZEF = [15:16] #, 10016140 10016145 SAVEFACTOR = 3 #, 10016150 HEADERSIZE = 4 #, 10016160 ROWSIZE = 5 #, 10016170 FILESTATUS = 6 #, 10016180 % SUB FIELDS: 10016185 IADF = [0:1] #, 10016190 CRUNCHEDF = [1:1] #, 10016200 GUARDF = [2:1] #, 10016210 10016215 ROWSINUSE = 7 #, 10016220 COMPLETEHEADER = 8 #, 10016230 DIRINFO = 9 #, 10016240 % SUB FIELDS: 10016245 FILEF = [1:2] #, 10016250 % VALUES: 10016255 FILEV = 1 #, 10016260 DIRV = 2 #, 10016270 FILEDIRV= 3 #, 10016280 10016285 AVAILF = [2:1] #, 10016290 10016295 AREAS = 10 #, 10016300 EOF = 11 #, 10016310 EOFBITS = 12 #, 10016320 SECURITY = 13 #, 10016330 TANKDATA1 = 14 #, 10016340 % SUB FIELDS: 10016345 BLOCKEDF = [47:1] #, 10016350 EXTMODEF = [46:3] #, 10016360 UNITSF = [39:1] #, 10016370 FILETYPEF = [38:4] #, 10016380 SIZEMODEF = [34:3] #, 10016390 SIZEOFFSETF= [31:16] #, 10016400 SIZE2F = [15:16] #, 10016410 10016415 LASTACCESSDATE = 15 #, 10016420 CATALOG = 16 #, 10016430 GUARDFILE = 17 #, 10016440 B7800 = 18 #, 10016450 VERSION = 19 #, 10016460 CYCLE = 20 #, 10016470 TIMESTAMP = 21 #, 10016480 FILESIZE = 22 #, 10016490 APL = 23 #, 10016500 B7800ADDL = 24 #, 10016510 USETIME = 25 #, 10016513 USERINFO = 26 #, 10016514 ALTERDATE = 27 #, 10016515 ALTERTIME = 28 #, 10016516 CREATIONTIME = 29 #, 10016517 TITLESTARTV = 30 #, % LAST ATTRIBUTE VALUE + 1 10016520 % 10016530 % 10016540 % 10016550 LASTTITLEDEF = #; 10016690 % 10016700 % 10016710 % 10016720 10017000 BOOLEAN PROCEDURE CALLGETSTATUS; FORWARD; 10018000 % ------------- 10019000 10020000 PROCEDURE DIRECTORYERROR; FORWARD; 10021000 % -------------- 10022000 10023000 10031000 INTEGER PROCEDURE DISPLAYFILEKIND (INFO, DEST); VALUE INFO, DEST; 10032000 % --------------- 10033000 REAL INFO; POINTER DEST; FORWARD; 10034000 10035000 INTEGER PROCEDURE DISPLAYREQUEST (DEST); VALUE DEST; POINTER DEST; 10036000 % -------------- 10037000 FORWARD; 10038000 10039000 BOOLEAN PROCEDURE GETDIRECTORY (DIR); ARRAY DIR [0]; FORWARD; 10043000 % ------------ 10044000 10045000 BOOLEAN PROCEDURE GETSTATUSERROR (RSLT); VALUE RSLT; BOOLEAN RSLT; 10046000 % -------------- 10047000 FORWARD; 10048000 10049000 BOOLEAN PROCEDURE INITDIR (MSK); VALUE MSK; REAL MSK; FORWARD; 10050000 % ------- 10051000 10052000 PROCEDURE LEVEL1NAME (AI); VALUE AI; REAL AI; FORWARD; 10053000 % ---------- 10054000 10055000 PROCEDURE PUTNAME (AI); VALUE AI; REAL AI; FORWARD; 10056000 % ------- 10057000 10058000 INTEGER PROCEDURE TITLESTART; FORWARD; 10059000 % ---------- 10060000 10061000 ARRAY 10062000 A [0:4095], 10062100 LVLNDX [1:20], 10062200 MYUSERCODE, 10062300 ONPART, 10062400 SPONSUSERCODE [0:3]; 10062500 POINTER 10062600 PFAM, 10062700 PSUB; 10062800 DEFINE 10063000 EA (I) = POINTER (A [(I) DIV 6]) % AVOIDS P-BITS ON 10063600 + ((I) MOD 6) #; % COPY DESCRIPTOR 10063800 EBCDIC ARRAY 10064000 FAMSPEC [0:83], 10064200 FILENAME [0:300]; 10064400 INTEGER 10065000 FILEINDEX, 10065200 MAXLEVEL, 10065400 OWNER, 10065600 ONLEN, 10065800 SPONSUSERLEN, 10066000 TFILES, 10066200 TSEGS, 10066400 USERLEN; 10066600 REAL 10067000 A0, 10067300 MASK, 10067400 STATE, 10067500 SUBCLASS, 10067600 TYPE; 10067700 BOOLEAN 10068000 APPENDONPART, 10068300 FIRSTCALL, 10068400 FULLDIR, 10068500 INITRSLT, 10068550 NOPREFIX, 10068600 ONEPACK; 10068700 10069000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10070000 % % 10071000 % D E F I N E S % 10072000 % % 10073000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 10074000 DEFINE 10075000 ADDNAME (PNAME, NAMELEN, ALPHALEN, LEN) = 10076000 BEGIN 10077000 LEN := LVLNDX [MAXLEVEL]; 10078000 REPLACE FILENAME [LEN] BY 10079000 PNAME FOR ALPHALEN:NAMELEN WHILE IN ALPHA, "/"; 10080000 IF ALPHALEN = 0 THEN 10081000 LVLNDX [MAXLEVEL+1] := LEN+NAMELEN+1 10082000 ELSE 10083000 BEGIN 10084000 REPLACE FILENAME[LEN] BY """, 10085000 PNAME FOR NAMELEN, ""/"; 10086000 LVLNDX[MAXLEVEL+1] := LEN+NAMELEN+3; 10087000 END; 10088000 END ADDNAME #, 10089000 NEXTENTRY = 10090000 BEGIN 10091000 IF FILEINDEX >= A0-1 THEN 10092000 BEGIN 10093000 STATE := MYSTATE; 10094000 RESULT := CALLGETSTATUS; 10095000 IF RESULT THEN GO XIT; 10096000 END IF; 10097000 FILEINDEX := *+1; 10098000 AI := A [FILEINDEX]; 10099000 END NEXTENTRY #, 10100000 10100200 CHECKDIRERROR = 10100250 BEGIN 10100300 IF STATE NEQ MYSTATE THEN 10100350 IF STATE = INITERR THEN 10100400 BEGIN 10100450 RESULT := INITRSLT; 10100500 STATE := GSTERR; 10100550 GO XIT; 10100600 END ELSE 10100650 DIRECTORYERROR; 10100700 END CHECKDIRERROR #, 10100750 10101000 P = POINTER #, 10102000 B = BOOLEAN #, 10103000 10103020 % SECURITY BYTE LAYOUT 10104000 10104500 DIRTYPE = [1:2] #, 10105000 MINEORSYS = 1 #, 10106000 SYSONLY = 2 #, 10107000 USERCODE = 3 #, 10108000 PACKBIT = [2:1] #, 10109000 % 10110000 % 10111000 % LINKS AND OTHER FIELDS IN GETSTATUSARRAY 10165000 % 10165500 % TYPE 10166000 % 10167000 LINKINONPARTF = [45: 1] #, 10168000 WAITFORFILEF = [43: 1] #, 10169000 RETAINUSERCODEF = [42: 1] #, 10170000 USERCODEONLYF = [41: 1] #, 10171000 RETURNFULLNAMEF = [40: 1] #, 10172000 DISPLAYFORMNAMEF = [39: 1] #, 10173000 ONLYSYSTEMFILESF = [38: 1] #, 10174000 RETURNRESIDENTF = [37: 1] #, 10175000 SUBTYPEF = [15: 8] #, 10176000 % SUBTYPE VALUES 10177000 ONEFILEONLY = 0 #, 10178000 FIRSTREQUEST = 1 #, 10179000 CONTINUATION = 2 #, 10180000 COPYDIRTOFILE = 3 #, 10181000 NEXTREQUEST = 4 #, 10182000 VOLUME = 5 #, 10183000 TYPEF = [ 7: 8] #, 10184000 % SUBCLASS 10185000 MAXCATLEVELF = [47: 8] #, 10186000 ORGLEVELF = [39:20] #, 10187000 MAXLEVELELF = [19:20] #, 10188000 % ARY 10189000 ERRORF = [47: 1] #, 10190000 ERRORVALUEF = [46: 8] #, 10191000 ADDLINFOF = [46: 8] #, 10192000 SUBVALUE2F = [38: 2] #, 10194000 % RESERVED = 0 #, 10195000 % FILEV = 1 #, 10196000 % DIRV = 2 #, 10197000 % FILEANDDIRV = 3 #, 10198000 SUBVALUE3F = [36: 1] #, % 1 INDICATES OPEN 10199000 SUBVALUE1F = [35: 3] #, 10200000 ONBIT = [35: 1] #, 10201000 % OWNERF = [34: 2] #, 10202000 % RESERVED = 0 #, 10203000 MYDIR = 1 #, % DIRECTORY OF TASKS USERCODE 10204000 SYSTEM = 2 #, % SYSTEM FILE 10205000 USERCOD = 3 #, % OTHER USERCODE 10206000 LINKF = [32:17] #, 10207000 NEXTLEVELLINKF = [15:11] #, 10208000 RESIDENTSTATEF = [ 4: 1] #, 10209000 LEVELF = [ 3: 4] #, 10210000 INFOF = [15:16] #, % LENGTH OF ENTRY IN ARY [XX.LINKF] 10211000 ONPARTLINKF = [43:11] #, 10212000 NAMESTART = 401 #, 10213000 % 10214000 % 10216000 % 10223000 % GETSTATUS RESULT VALUES 10224000 % 10225000 % ERRORBIT = [ 0: 1] #, 10226000 HARDERRORF = [11: 8] #, 10227000 % 10263000 % STATE VALUES 10264000 % 10265000 TITLESIZES = 0 #, 10266000 SUBUSERS = 1 #, 10267000 NOREQUEST = 2 #, 10268000 BADREQUEST = 3 #, 10269000 DOUBLEINIT = 4 #, 10270000 GSTERR = 5 #, 10271000 INITERR = 6 #, 10271500 COMPLETED = 7 #, 10272000 % 10273000 INFOMASK = 10274000 REAL (NOT FALSE).[TITLESTARTV:TITLESTARTV+1] % ALL, BUT: 10274500 & 0 [GUARDFILE:1] 10275000 & 0 [COMPLETEHEADER:1] 10276000 & 0 [CATALOG:1] 10277000 & 0 [B7800ADDL:1] 10278000 & 0 [B7800:1] 10279000 & 0 [HEADERSIZE:1] 10280000 #, 10281000 FILESIZEMASK = 0 & 1 [FILEINFO:1] & 1 [FILESIZE:1] #, 10282000 TITLEMASK = 0 & 1 [FILEINFO:1] #, 10283000 LASTDEFINE = #; 10284000 10285000 BOOLEAN PROCEDURE CALLGETSTATUS; 10286000 % ------------- 10287000 BEGIN 10288000 BOOLEAN RSLT; POINTER PT; LABEL XIT; 10289000 IF FIRSTCALL THEN 10290000 BEGIN 10291000 A[1].LINKF := 6; 10292000 IF ONEPACK THEN REPLACE MYSELF.FAMILY BY "."; 10293000 END ELSE 10294000 BEGIN 10295000 TYPE := * & (NEXTREQUEST) SUBTYPEF; 10296000 IF A0.ERRORF = 0 THEN 10297000 BEGIN 10298000 RSLT := TRUE; 10299000 STATE := COMPLETED; 10300000 GO XIT; 10301000 END; 10302000 END; 10303000 A [0] := NAMESTART-1; 10304000 RSLT := GETSTATUS (TYPE, SUBCLASS, MASK, A); 10305000 IF RSLT THEN 10306000 BEGIN 10307000 RSLT := GETSTATUSERROR (RSLT); 10308000 STATE := GSTERR; 10309000 END ELSE 10310000 IF APPENDONPART THEN 10311000 BEGIN 10312000 PT := EA [A[A[1].ONPARTLINKF].LINKF]; 10313000 ONLEN := REAL (PT, 1) + 4; 10314000 REPLACE ONPART BY " ON ", 10315000 PT+1 FOR ONLEN-4; 10316000 END IF; 10317000 FILEINDEX := 1; 10318000 A0 := A [0]; 10319000 XIT: 10320000 IF FIRSTCALL THEN 10321000 BEGIN 10322000 IF ONEPACK THEN REPLACE MYSELF.FAMILY BY FAMSPEC; 10323000 FIRSTCALL := FALSE; 10324000 END; 10325000 CALLGETSTATUS := RSLT; 10326000 END CALLGETSTATUS; 10327000 10328000 PROCEDURE DIRECTORYERROR; 10329000 % -------------- 10330000 BEGIN 10331000 CASE STATE OF 10332000 BEGIN 10333000 (TITLESIZES): 10334000 DISPLAY ("ERROR: GETDIRECTORY CALL NOT ALLOWED"); 10335000 (SUBUSERS): 10336000 DISPLAY ("ERROR: GETDIRECTORY CALL EXPECTED"); 10337000 (NOREQUEST): 10338000 DISPLAY ("ERROR: DIRSEARCH NOT INITIALIZED"); 10339000 (BADREQUEST): 10340000 DISPLAY ("ERROR: ILLEGAL DIRECTORY REQUEST"); 10341000 (DOUBLEINIT): 10342000 DISPLAY ("ERROR: DIRECTORY ALREADY INITIALIZED"); 10343000 (GSTERR): 10344000 DISPLAY ("ERROR: PREVIOUS CALL WENT WRONG"); 10345000 (COMPLETED): 10346000 DISPLAY ("ERROR: DIRECTORY SEARCH WAS COMPLETED"); 10347000 END CASE; 10348000 MYSELF.STATUS :=-1; 10349000 END DIRECTORYERROR; 10350000 10351000 BOOLEAN PROCEDURE DIRREQUEST (DIR, SPEC); 10352000 % ---------- 10353000 VALUE DIR, SPEC; POINTER DIR; BOOLEAN SPEC; 10354000 BEGIN 10355000 LABEL XIT; 10356000 TRUTHSET FILENAMESTARTERS (ALPHA OR ""="), 10357000 STOPPER ("""48"00"); % IT'S SAVE TO END DIR WITH 0 10358000 REAL SECBYTE; % SECURITY BYTE 10359000 INTEGER I, J, K, L, TOTLEN, NAMES; 10360000 BOOLEAN RESULT, LAST, SPONSOR, NOSTARTER, WANTONPART; 10361000 POINTER PA, PD, PT, PN, PFAM; 10362000 DEFINE 10363000 INL = 5000 #, % KEEP IT SAVE 10364000 % SPEC FIELDS 10365000 USERDIR = SPEC.USERDIRF #, 10366000 NOONPART = SPEC.NOONPARTF #, 10367000 RETAINUS = SPEC.RETAINUSF #, 10368000 ALLOWSUB = SPEC.ALLOWSUBF #, 10369000 ALLOWEMPTY = SPEC.ALLOWEMPTYF #, 10370000 WAITFORFILE = SPEC.WAITONFILEF #, 10371000 ONEPACKONLY = SPEC.ONEPACKONLYF #, 10372000 10373000 FATALERROR (T) = 10374000 BEGIN 10375000 RESULT := TRUE & B(T) ERTYPEF; 10376000 STATE := BADREQUEST; 10377000 GO XIT; 10378000 END FATALERROR #, 10379000 SKIPBLANKS = 10380000 SCAN PD:PD FOR L:L WHILE = " " #, 10381000 LASTDEFINE = #; 10382000 10383000 STATE := NOREQUEST; 10383500 FULLDIR := FALSE; 10383510 REPLACE P(MYUSERCODE) BY MYSELF.USERCODE; 10384000 SCAN PT:P(MYUSERCODE) FOR I:20 UNTIL = "."; 10385000 USERLEN := 20-I; 10387000 IF USERLEN > 0 THEN SPONSOR := REAL (PT-1, 1) < 48"F0"; 10387500 IF SPONSOR AND USERLEN = 3 THEN % (CAS) 10388000 RESULT := FALSE & (TRUE) VISIBLEF; % ALMOST ALWAYS TRUE 10389000 PN := POINTER (A [NAMESTART]); 10390000 PA := PN+3; 10391000 PD := DIR; 10392000 TOTLEN := 3; 10393000 SECBYTE := 0 & 1 PACKBIT; 10394000 L := INL; 10395000 SKIPBLANKS; 10396000 CASE REAL (PD, 1) OF 10397000 BEGIN 10398000 ELSE: 10399000 NOSTARTER := TRUE; 10400000 RESULT := * & (TRUE) VISIBLEF; 10401000 SECBYTE := * & (MINEORSYS) DIRTYPE; 10402000 "=": 10403000 PD := PD+1; L:=L-1; 10404000 SKIPBLANKS; 10405000 LAST := TRUE; 10406000 SECBYTE := * & (MINEORSYS) DIRTYPE; 10407000 RESULT := * & (TRUE) EQUALF & (TRUE) VISIBLEF; 10408000 "*": 10409000 SECBYTE := * & (SYSONLY) DIRTYPE; 10410000 PD := PD+1; L := L-1; 10411000 SKIPBLANKS; 10412000 IF PD = "=" THEN 10413000 BEGIN 10414000 LAST := TRUE; 10415000 PD := PD+1; L:=L-1; 10416000 SKIPBLANKS; 10417000 RESULT := * & (TRUE) EQUALF; 10418000 END; 10419000 FULLDIR := TRUE; % MAY BE 10420000 RESULT := * & (TRUE) OTHERLIBF & (FALSE) VISIBLEF; 10421000 "(": 10422000 PD := PD+1; L := L-1; 10423000 SKIPBLANKS; 10424000 REPLACE PA+1 BY PD:PD FOR K:L WHILE IN ALPHA, "."; 10425000 IF K=L THEN FATALERROR (USERCODESNTX); 10426000 I := MIN (L-K, 17); L := K; 10427000 REPLACE PA BY I.[7:48] FOR 1; 10428000 SKIPBLANKS; 10429000 IF PD NEQ ")" THEN FATALERROR (USERCODESNTX); 10430000 PD := PD+1; L := L -1; 10431000 SKIPBLANKS; 10432000 IF PD = "=" THEN 10433000 BEGIN 10434000 LAST := TRUE; 10435000 PD := PD+1; L:= L-1; 10436000 RESULT := * & (TRUE) EQUALF; 10437000 SKIPBLANKS; 10438000 END; 10439000 SKIPBLANKS; 10440000 RESULT := * & (TRUE) OTHERLIBF; 10441000 IF I = USERLEN THEN 10442000 BEGIN 10443000 IF MYUSERCODE = PA+1 FOR (I+1) THEN 10444000 BEGIN 10445000 RESULT := * & (TRUE) VISIBLEF 10446000 & (FALSE) OTHERLIBF; 10447000 SECBYTE := * & (MINEORSYS) DIRTYPE; 10448000 USERDIR := TRUE; % LOOK ONLY IN MY LIBRARY 10449000 END; 10450000 END; 10451000 IF RESULT.OTHERLIBF THEN 10452000 BEGIN 10453000 $ SET OMIT = NOT USERTREE 10453500 IF SPONSOR AND I > USERLEN THEN 10454000 IF MYUSERCODE = PA+1 FOR USERLEN THEN 10455000 RESULT := * & (TRUE) VISIBLEF; 10456000 $ POP OMIT 10456500 SECBYTE := * & (USERCODE) DIRTYPE; 10457000 I := I+1; PA := PA+I; TOTLEN := TOTLEN+I; 10458000 NAMES := 1; 10459000 END; 10460000 $ SET OMIT = NOT USERTREE 10460500 "<": 10461000 IF ALLOWSUB THEN 10461400 BEGIN 10461500 WANTONPART := TRUE; 10462000 SECBYTE := * & (SYSONLY) DIRTYPE; 10464000 STATE := SUBUSERS; LAST := TRUE; 10465000 J := L; % STORE OLD LENGTH. 10465500 PD := PD+1; L:= L-1; 10466000 SKIPBLANKS; 10467000 IF PD = "=" THEN 10468000 BEGIN PD := PD+1; L := L-1; END; 10469000 SKIPBLANKS; 10470000 IF PD = "(" THEN 10471000 BEGIN 10472000 PD := PD+1; L := L-1; 10473000 SKIPBLANKS; 10474000 REPLACE SPONSUSERCODE BY 10475000 PD:PD FOR K:L WHILE IN ALPHA, "."; 10476000 I := MIN (17, L-K); L := K; 10477000 IF PD-1 >= 48"F0" THEN FATALERROR (NOSPONSOR); 10478000 IF SPONSOR AND I > USERLEN THEN 10479000 RESULT := * & 10480000 (MYUSERCODE = SPONSUSERCODE FOR USERLEN)10481000 VISIBLEF 10482000 ELSE 10483000 IF I = USERLEN THEN 10484000 RESULT := * & 10484500 (MYUSERCODE = SPONSUSERCODE FOR (I+1)) 10485000 VISIBLEF; 10486000 SPONSUSERLEN := I; 10487000 IF SPONSUSERLEN=0 THEN 10488000 FATALERROR (USERCODESNTX); 10488500 SKIPBLANKS; 10489000 IF PD NEQ ")" THEN FATALERROR (USERCODESNTX); 10490000 PD := PD+1; 10491000 L := L-1; 10492000 RESULT := * & (TRUE) OTHERLIBF; 10493000 SKIPBLANKS; 10494000 END ELSE 10495000 BEGIN 10496000 IF NOT SPONSOR THEN 10497000 BEGIN 10497300 L := J; % SET BACK SCAN LENGTH. 10497400 FATALERROR (NOSPONSOR); 10497500 END; 10497600 REPLACE SPONSUSERCODE BY 10498000 MYUSERCODE FOR USERLEN; 10498500 SPONSUSERLEN := USERLEN; 10499000 RESULT := * & (TRUE) VISIBLEF; 10500000 END IF; 10501000 IF SPONSUSERLEN = 3 THEN SPONSUSERLEN := 0; % (CAS) 10502000 END ELSE 10502200 BEGIN 10502650 NOSTARTER := TRUE; 10502700 RESULT := * & (TRUE) VISIBLEF; 10502750 SECBYTE := * & (MINEORSYS) DIRTYPE; 10502800 END; 10502850 $ POP OMIT 10502900 END CASE; 10503000 10504000 IF USERLEN = 0 THEN RESULT := * & (TRUE) VISIBLEF; 10504500 IF NOT LAST THEN LAST := NOT (PD IN FILENAMESTARTERS); 10505000 IF NOT LAST THEN 10506000 IF L > 3 THEN 10507000 BEGIN 10508000 IF PD = "ON " THEN 10509000 BEGIN 10510000 SCAN PD+3 FOR I:L-3 WHILE = " "; 10511000 IF I > 0 THEN LAST := PD IN ALPHA; % ONPART 10512000 END IF; 10513000 END IF; 10514000 IF LAST THEN 10515000 BEGIN 10516000 IF NOSTARTER AND NOT ALLOWEMPTY THEN 10517000 FATALERROR (NVLDREQUEST); 10518000 END ELSE 10519000 BEGIN 10520000 FULLDIR := FALSE; 10521000 RESULT := * & (TRUE) FILEORDIRF; 10522000 END; 10523000 WHILE NOT LAST DO 10524000 BEGIN 10525000 IF NAMES = 14 THEN FATALERROR (TOOMANYNAMES); 10526000 CASE REAL (PD, 1) OF 10527000 BEGIN 10528000 ELSE: 10529000 REPLACE PA+1 BY PD:PD FOR K:L WHILE IN ALPHA; 10530000 IF L = K THEN FATALERROR (NAMESNTX); 10531000 I := MIN (L-K, 17); L := K; 10532000 REPLACE PA BY I.[7:48] FOR 1; 10533000 I := I+1; TOTLEN := *+I; 10534000 PA := PA+I; 10535000 NAMES := NAMES+1; 10536000 "=": 10537000 PD := PD+1; L := L-1; 10538000 LAST := TRUE; 10539000 RESULT := * & (FALSE) FILEORDIRF & (TRUE) EQUALF; 10540000 """: 10541000 REPLACE PA+1 BY PD:PD+1 FOR K:L-1 UNTIL IN STOPPER; 10543000 IF K = 0 THEN FATALERROR (STRINGSNTX); 10544000 I := L-K-1; L := K-1; 10545000 PD := PD+1; 10546000 I := MIN (I, 17); 10547000 REPLACE PA BY I.[7:48] FOR 1; 10548000 I := I+1; TOTLEN := *+I; 10549000 PA := PA+I; 10550000 NAMES := *+1; 10551000 END CASE; 10552000 SKIPBLANKS; 10553000 IF NOT LAST THEN 10554000 IF PD = "/" THEN 10555000 BEGIN 10556000 PD := PD+1; L := L-1; 10557000 SKIPBLANKS; 10558000 END ELSE 10559000 LAST := TRUE; 10560000 END WHILE; 10561000 10562000 IF FULLDIR AND ALLOWSUB THEN STATE := SUBUSERS; 10563000 ONEPACK := ONEPACKONLY; 10564000 IF ONEPACK THEN 10565000 BEGIN 10566000 REPLACE FAMSPEC BY MYSELF.FAMILY; 10567000 IF FAMSPEC NEQ "." THEN 10568000 BEGIN 10569000 SCAN PFAM:FAMSPEC UNTIL = "="; 10570000 SCAN PFAM:PFAM+1 WHILE = " "; 10571000 END; 10572000 END ELSE 10573000 REPLACE FAMSPEC BY "."; 10574000 IF L > 2 AND PD = "ON " THEN 10575000 BEGIN 10576000 PD := PD+3; L := L-3; 10577000 SKIPBLANKS; 10578000 REPLACE PA+1 BY PD:PD FOR K:L WHILE IN ALPHA, " "; 10579000 IF L = K THEN FATALERROR (NVLDONPART); 10580000 I := MIN (L-K, 17); L := K; 10581000 IF ONEPACK THEN 10582000 BEGIN 10583000 IF PA+1 = FAMSPEC FOR I+1 THEN % INCLUDING " " 10584000 BEGIN 10585000 REPLACE PA+1 BY PFAM FOR I:17 WHILE IN ALPHA; 10586000 I := 17-I; 10587000 END; 10588000 END; 10589000 REPLACE PA BY I.[7:48] FOR 1; 10590000 I := I+1; 10591000 TOTLEN := *+I; 10592000 NAMES := *+1; 10593000 SKIPBLANKS; 10594000 END ELSE 10595000 BEGIN 10596000 IF WANTONPART THEN FATALERROR (ONPARTXPTD); 10597000 IF ONEPACK AND FAMSPEC = "DISK " THEN 10598000 BEGIN 10599000 REPLACE PA+1 BY PFAM FOR I:17 WHILE IN ALPHA; 10600000 I := 17-I; 10601000 REPLACE PA BY I.[7:48] FOR 1; 10602000 I := I+1; 10603000 TOTLEN := *+I; 10604000 END ELSE 10605000 BEGIN 10606000 REPLACE PA BY 48"04""DISK"; 10607000 I := 5; 10608000 TOTLEN := *+5; 10609000 END; 10610000 NAMES := *+1; 10611000 END; 10612000 IF PD = "." THEN 10613000 BEGIN 10614000 PD := PD+1; L := L-1; 10615000 RESULT := * & (TRUE) PERIODF; 10616000 END; 10617000 10618000 REPLACE PN BY TOTLEN.[7:48] FOR 1, 10619000 SECBYTE.[7:48] FOR 1, 10620000 NAMES.[7:48] FOR 1; 10621000 NOPREFIX := (STATE NEQ SUBUSERS) AND 10622000 (NOT RETAINUS) AND 10623000 (NOT RESULT.OTHERLIBF); 10624000 TYPE := 0 & 3 TYPEF 10625000 & (1) RETAINUSERCODEF 10626000 & REAL (WAITFORFILE) WAITFORFILEF 10627000 & REAL (USERDIR) USERCODEONLYF 10628000 & (FIRSTREQUEST) SUBTYPEF; 10629000 10630000 IF STATE = SUBUSERS THEN 10631000 SUBCLASS := 1 % MAX LEVEL 10632000 ELSE 10633000 BEGIN 10634000 SUBCLASS := 0; 10635000 STATE := TITLESIZES; 10636000 END; 10637000 APPENDONPART := (STATE = SUBUSERS) OR (NOT NOONPART); 10638000 A0 := FILEINDEX := 0; FIRSTCALL := TRUE; 10639000 REPLACE FILENAME [0] BY 0 FOR 1 WORDS; 10640000 IF STATE = SUBUSERS THEN MASK := TITLEMASK 10641000 ELSE MASK := INFOMASK; 10642000 XIT: 10643000 DIRREQUEST := RESULT & B (INL-L) SCANLENF 10644000 & B (TITLESTARTV) TITLESTARTF 10645000 & B (NAMES-1) NNAMESF 10646000 & (STATE = SUBUSERS) STRUCTDIRF 10647000 & (NOPREFIX) NOPREFIXF; 10648000 END DIRREQUEST; 10649000 10650000 BOOLEAN PROCEDURE DIRSIZE (FILES, SEGS); 10651000 % ------- 10652000 INTEGER FILES, SEGS; 10653000 BEGIN 10654000 INTEGER I, LEVEL; REAL AI; LABEL XIT; 10655000 BOOLEAN RESULT; 10656000 DEFINE 10657000 MYSTATE = TITLESIZES #; 10658000 10659000 FILES := 0; 10659900 SEGS := 0; 10660000 CHECKDIRERROR; 10660100 MASK := FILESIZEMASK; 10661000 WHILE TRUE DO 10663000 BEGIN 10664000 NEXTENTRY; 10665000 LEVEL := AI.LEVELF; 10666000 WHILE LEVEL > 0 DO 10667000 BEGIN 10668000 NEXTENTRY; 10669000 LEVEL := AI.LEVELF; 10670000 END WHILE; 10671000 10672000 I := AI.LINKF+1; 10673000 AI := A [I]; 10674000 FILES := *+1; 10675000 SEGS := *+A [I+FILESIZE]; 10676000 END; 10677000 XIT: 10678000 DIRSIZE := RESULT; 10679000 END DIRSIZE; 10680000 10681000 INTEGER PROCEDURE DISPLAYFILEKIND (INFO, DEST); VALUE INFO, DEST; 10682000 % --------------- 10683000 REAL INFO; POINTER DEST; 10684000 BEGIN 10685000 DEFINE 10686000 PUT (L,T) = 10687000 BEGIN DISPLAYFILEKIND := L; REPLACE DEST BY T END #; 10688000 CASE INFO.FILEKINDF OF 10689000 BEGIN 10690000 ELSE: DISPLAYFILEKIND := 11; 10691000 REPLACE DEST BY "FKIND (", 10692000 INFO.FILEKINDF FOR 3 DIGITS, ")"; 10693000 ( 0): PUT ( 8, "NULLFILE"); 10694000 ( 1): PUT ( 9, "DIRECTORY"); 10695000 ( 2): PUT (15, "SYSTEMDIRECTORY"); 10696000 ( 3): PUT ( 7, "CATALOG"); 10697000 ( 4): PUT (10, "BACKUPDISK"); 10698000 ( 5): PUT (18, "RECONSTRUCTIONFILE"); 10699000 ( 6): PUT (13, "SYSTEMDIRFILE"); 10700000 ( 7): PUT (11, "JOBDESCFILE"); 10701000 ( 8): PUT (10, "ARCHIVELOG"); 10702000 ( 15): PUT ( 9, "XDISKFILE"); 10703000 ( 16): PUT (13, "BACKUPPRINTER"); 10704000 ( 17): PUT (11, "BACKUPPUNCH"); 10705000 ( 20): PUT (16, "COMPILERCODEFILE"); 10706000 ( 21): PUT (14, "CHECKPOINTFILE"); 10707000 ( 22): PUT ( 9, "CPJOBFILE"); 10708000 ( 23): PUT ( 7, "DCPCODE"); 10709000 ( 24): PUT ( 7, "NDLCODE"); 10710000 ( 25): PUT ( 9, "NDLIICODE"); 10710100 ( 26): PUT (12, "RECOVERYFILE"); 10711000 ( 27): PUT (12, "SCHEDULEFILE"); 10712000 ( 28): PUT ( 8, "INFOFILE"); 10713000 ( 29): PUT (11, "LIBRARYCODE"); 10714000 ( 30): PUT (13, "INTRINSICFILE"); 10715000 ( 31): PUT (11, "MCPCODEFILE"); 10716000 ( 32): PUT ( 9, "ALGOLCODE"); 10717000 ( 33): PUT ( 9, "COBOLCODE"); 10718000 ( 34): PUT (11, "FORTRANCODE"); 10719000 ( 35): PUT (10, "XALGOLCODE"); 10720000 ( 36): PUT ( 7, "PL1CODE"); 10721000 ( 37): PUT ( 9, "SATHECODE"); 10722000 ( 39): PUT ( 9, "ESPOLCODE"); 10723000 ( 40): PUT (11, "DCALGOLCODE"); 10724000 ( 41): PUT ( 9, "BASICCODE"); 10725000 ( 42): PUT (12, "XFORTRANCODE"); 10726000 ( 43): PUT ( 7, "JOBCODE"); 10727000 ( 44): PUT (11, "DMALGOLCODE"); 10728000 ( 45): PUT ( 8, "NEWPCODE"); 10728100 ( 47): PUT (10, "PASCALCODE"); 10729000 ( 50): PUT (13, "FORTRAN77CODE"); 10730000 ( 62): PUT ( 9, "BOUNDCODE"); 10731000 ( 63): PUT ( 8, "CODEFILE"); 10732000 ( 64): PUT (11, "ALGOLSYMBOL"); 10733000 ( 65): PUT (11, "COBOLSYMBOL"); 10734000 ( 66): PUT (13, "FORTRANSYMBOL"); 10735000 ( 67): PUT (12, "XALGOLSYMBOL"); 10736000 ( 68): PUT ( 9, "PL1SYMBOL"); 10737000 ( 69): PUT (12, "JOVIALSYMBOL"); 10738000 ( 71): PUT (11, "ESPOLSYMBOL"); 10739000 ( 72): PUT (13, "DCALGOLSYMBOL"); 10740000 ( 73): PUT (11, "BASICSYMBOL"); 10741000 ( 74): PUT (14, "XFORTRANSYMBOL"); 10742000 ( 75): PUT ( 9, "JOBSYMBOL"); 10743000 ( 77): PUT (14, "VFORTRANSYMBOL"); 10744000 ( 79): PUT (10, "NEWPSYMBOL"); 10744100 ( 81): PUT (12, "PASCALSYMBOL"); 10745000 ( 83): PUT (11, "NDLIISYMBOL"); 10745100 ( 84): PUT (15, "FORTRAN77SYMBOL"); 10746000 ( 94): PUT (12, "BINDERSYMBOL"); 10747000 ( 95): PUT (11, "DASDLSYMBOL"); 10748000 ( 96): PUT (13, "DMALGOLSYMBOL"); 10749000 ( 97): PUT ( 9, "DCPSYMBOL"); 10750000 ( 98): PUT ( 9, "NDLSYMBOL"); 10751000 (100): PUT ( 9, "RSNETFILE"); 10752000 (101): PUT ( 7, "UCRFILE"); 10753000 (102): PUT (11, "RSSORTTABLE"); 10754000 (103): PUT ( 7, "RSPCODE"); 10755000 (104): PUT ( 7, "MDLCODE"); 10756000 (105): PUT ( 9, "MDLSYMBOL"); 10757000 (106): PUT (12, "VFORTRANCODE"); 10758000 (107): PUT (12, "VMLINKEDCODE"); 10759000 (108): PUT ( 8, "VMCPCODE"); 10760000 (115): PUT ( 8, "FIRMWARE"); 10761000 (169): PUT (14, "CONFIDENCECODE"); 10762000 (192): PUT ( 4, "DATA"); 10763000 (193): PUT ( 7, "SEQDATA"); 10764000 (194): PUT ( 9, "GUARDFILE"); 10765000 (195): PUT ( 7, "APLDATA"); 10766000 (196): PUT (12, "APLWORKSPACE"); 10767000 (197): PUT ( 5, "CDATA"); 10768000 (198): PUT ( 8, "CSEQDATA"); 10769000 (199): PUT (12, "DBRESTARTSET"); 10770000 (200): PUT ( 6, "DBDATA"); 10771000 END CASE; 10772000 END DISPLAYFILEKIND; 10773000 10774000 INTEGER PROCEDURE DISPLAYREQUEST (DEST); VALUE DEST; POINTER DEST; 10775000 % -------------- 10776000 BEGIN 10777000 REAL SECBYTE; INTEGER I, J, L, NAMES; 10778000 POINTER PA, PD; 10779000 DEFINE APPEND = REPLACE PD:PD BY #; 10780000 IF STATE > SUBUSERS THEN 10781000 DIRECTORYERROR; 10781500 IF NOT FIRSTCALL THEN 10782000 BEGIN 10783000 DISPLAY ("ERROR: DISPLAYREQUEST MUST BE CALLED" 10784000 " BEFORE DIRECTORY IS SEARCHED"); 10785000 MYSELF.STATUS := -1; 10786000 END; 10787000 PA := POINTER (A [NAMESTART])+1; 10788000 SECBYTE := REAL (PA, 1); 10789000 NAMES := REAL (PA+1, 1); 10790000 PA := PA+2; 10791000 PD := DEST; 10792000 CASE SECBYTE.DIRTYPE OF 10793000 BEGIN 10794000 (MINEORSYS): 10795000 IF BOOLEAN (TYPE.USERCODEONLYF) THEN 10796000 BEGIN 10797000 APPEND "(", MYUSERCODE FOR USERLEN, ")"; 10798000 L := L+USERLEN+2; 10799000 END ELSE 10800000 IF NAMES = 1 THEN 10801000 BEGIN 10802000 APPEND "="; 10803000 L := L+1; 10804000 END; 10805000 (SYSONLY): 10806000 IF STATE = SUBUSERS AND NOT FULLDIR THEN 10807000 BEGIN 10808000 IF SPONSUSERLEN = 0 THEN % USERCODE CAS 10809000 BEGIN 10810000 APPEND "<= (CAS)"; 10811000 L := L+8; 10812000 END ELSE 10813000 BEGIN 10814000 APPEND "<= (", 10815000 P(SPONSUSERCODE) FOR SPONSUSERLEN, ")"; 10816000 L := L+SPONSUSERLEN+5; 10817000 END; 10818000 END ELSE 10819000 BEGIN 10820000 APPEND "*"; 10821000 L := L+1; 10822000 END; 10823000 (USERCODE): 10824000 I := REAL (PA, 1); 10825000 APPEND "(", PA+1 FOR I, ")"; 10826000 PA := PA+(I+1); 10827000 L := L+I+2; 10828000 NAMES := *-1; 10829000 END; 10830000 THRU (NAMES-1) DO 10831000 BEGIN 10832000 I := REAL (PA, 1); 10833000 APPEND PA+1 FOR J:I WHILE IN ALPHA; 10834000 IF J = 0 THEN % NO STRING 10835000 J := I 10836000 ELSE 10837000 BEGIN 10838000 PD := PD-(I-J); 10839000 APPEND """, PA+1 FOR I, """; 10840000 J := I+2; 10841000 END; 10842000 APPEND "/"; 10843000 L := L+J+1; 10844000 PA := PA+(I+1); 10845000 END; 10846000 IF NAMES > 1 THEN 10847000 BEGIN 10848000 REPLACE PD:PD-1 BY " ON "; 10849000 L := L+3; 10850000 END ELSE 10851000 BEGIN 10852000 APPEND " ON "; 10853000 L := L+4; 10854000 END; 10855000 I := REAL (PA, 1); 10856000 APPEND PA+1 FOR I, "."; 10857000 DISPLAYREQUEST := L+I+1; 10858000 END DISPLAYREQUEST; 10859000 10859180 BOOLEAN PROCEDURE GETDIRECTORY (DIR); ARRAY DIR[0]; 10859190 % ------------ 10859200 BEGIN 10859210 REAL AI; 10859220 INTEGER NAMELEN, ALPHALEN; 10859230 POINTER PNAME; 10859240 BOOLEAN RESULT, FOUND; 10859250 LABEL XIT; 10859260 DEFINE 10859270 MYSTATE = SUBUSERS #; 10859280 10859290 CHECKDIRERROR; 10859300 IF FULLDIR THEN 10859310 BEGIN 10859320 NEXTENTRY; 10859330 IF AI.LEVELF = 0 THEN AI := A [AI.LINKF+1]; 10859340 PNAME := EA [AI.LINKF+1]; 10859350 NAMELEN := REAL (PNAME-1, 1); 10859360 IF AI.OWNERF = USERCOD THEN 10859370 BEGIN 10859380 REPLACE DIR [1] BY "(", 10859390 PNAME FOR NAMELEN, ")", 10859400 ONPART FOR ONLEN, "."48"00"; 10859410 END ELSE 10859420 BEGIN 10859430 REPLACE DIR [1] BY "*", 10859440 PNAME FOR ALPHALEN:NAMELEN WHILE IN ALPHA, 10859450 ONPART FOR ONLEN, "."48"00"; 10859460 IF ALPHALEN > 0 THEN % STUPID STRINGS 10859470 BEGIN 10859480 REPLACE DIR [1]+1 BY """, 10859490 PNAME FOR NAMELEN, """, 10859500 ONPART FOR ONLEN, "."48"00"; 10859510 NAMELEN := *+2; 10859520 END; 10859530 END; 10859540 END ELSE 10859550 WHILE NOT FOUND DO 10859560 BEGIN 10859570 NEXTENTRY; 10859580 WHILE AI.LEVELF > 0 AND NOT FOUND DO 10859590 BEGIN 10859600 IF AI.OWNERF = USERCOD THEN 10859610 BEGIN 10859620 PNAME := EA [AI.LINKF]; 10859630 NAMELEN := REAL (PNAME, 1); 10859640 IF NAMELEN >= SPONSUSERLEN THEN 10859650 IF PNAME := PNAME+1 = P(SPONSUSERCODE) 10859660 FOR SPONSUSERLEN THEN 10859670 BEGIN 10859680 FOUND := TRUE; 10859690 REPLACE DIR [1] BY "(", 10859700 PNAME FOR NAMELEN, 10859710 ")", ONPART FOR ONLEN, "."48"00"; 10859720 END IF NAMELEN; 10859730 END IF AI; 10859740 IF NOT FOUND THEN NEXTENTRY; 10859750 END WHILE AI; 10859760 END WHILE TRUE; 10859770 DIR [0] := AI & NAMELEN LENGTHF; 10859780 XIT: 10859790 GETDIRECTORY := RESULT; 10859800 END GETDIRECTORY; 10859810 10859820 10860000 BOOLEAN PROCEDURE GETSTATUSERROR (RSLT); VALUE RSLT; BOOLEAN RSLT; 10861000 % -------------- 10862000 BEGIN 10863000 REAL ER, T; 10864000 ER := REAL (RSLT.HARDERRORF); 10865000 IF ER = 0 THEN 10866000 BEGIN 10867000 ER := A[1].ERRORVALUEF; 10868000 IF ER = 124 OR ER = 49 THEN T := NOFILES 10869000 ELSE IF ER = 120 THEN T := NOFAMILY 10870000 ELSE T := SOFTERROR; 10871000 GETSTATUSERROR :=TRUE & B(ER) SOFTERRORF & B(T) ERTYPEF; 10872000 END ELSE 10873000 BEGIN 10874000 GETSTATUSERROR := RSLT & B (HARDERROR) ERTYPEF; 10875000 END; 10876000 END GETSTATUSERROR; 10877000 10878000 BOOLEAN PROCEDURE GETTITLE (TITL); ARRAY TITL [0]; 10879000 % -------- 10880000 BEGIN 10881000 INTEGER I, T, LEVEL; REAL AI; LABEL XIT; 10882000 BOOLEAN RESULT; POINTER PT; 10883000 DEFINE 10884000 MYSTATE = TITLESIZES #; 10885000 10886000 CHECKDIRERROR; 10887000 NEXTENTRY; 10888000 LEVEL := AI.LEVELF; 10889000 WHILE LEVEL > 0 DO 10890000 BEGIN 10891000 MAXLEVEL := LEVEL; 10892000 IF MAXLEVEL = 1 THEN LEVEL1NAME (AI) 10893000 ELSE PUTNAME (AI); 10894000 NEXTENTRY; 10895000 LEVEL := AI.LEVELF; 10896000 END WHILE; 10897000 10898000 I := AI.LINKF+1; 10899000 AI := A [I]; 10900000 MAXLEVEL := AI.LEVELF; 10901000 IF MAXLEVEL = 1 THEN LEVEL1NAME (AI) 10902000 ELSE PUTNAME (AI); 10903000 T := LVLNDX [MAXLEVEL+1]; 10904000 REPLACE PT:(TITL[TITLESTARTV]) BY FILENAME[0] FOR (T-1); 10905000 IF APPENDONPART THEN 10906000 BEGIN 10907000 REPLACE PT:PT BY ONPART FOR ONLEN; 10908000 T:=T+ONLEN; 10909000 END; 10910000 REPLACE PT BY "."48"00"; 10911000 IF NOPREFIX THEN AI := * & (MAXLEVEL-1) LEVELF; 10912000 TITL [FILEINFO] := AI & (OWNER) OWNERF & (T) LENGTHF; 10913000 REPLACE P(TITL[1]) BY P(A[I+1]) FOR (TITLESTARTV-1) WORDS; 10914000 10915000 XIT: 10916000 GETTITLE := RESULT; 10917000 END GETTITLE; 10918000 10951000 BOOLEAN PROCEDURE INITDIR (MSK); VALUE MSK; REAL MSK; 10984000 % ------- 10985000 BEGIN 10986000 REAL 10986400 NEW; 10986500 IF STATE > SUBUSERS THEN DIRECTORYERROR; 10987000 IF MSK ISNT 0 THEN MASK := MSK & 1 [FILEINFO:1]; 10988000 IF FIRSTCALL THEN 10989000 BEGIN 10989500 INITRSLT := CALLGETSTATUS; 10990000 IF INITRSLT THEN 10990400 STATE := INITERR; 10990500 END ELSE 10991000 BEGIN 10992000 STATE := DOUBLEINIT; 10993000 DIRECTORYERROR; 10994000 END; 10995000 INITDIR := INITRSLT; 10995500 END INITDIR; 10996000 10997000 PROCEDURE LEVEL1NAME (AI); VALUE AI; REAL AI; 10998000 % ---------- 10999000 BEGIN 11000000 POINTER PNAME; INTEGER NAMELEN, ALPHALEN, T; 11001000 PNAME := EA [AI.LINKF]; 11002000 NAMELEN := REAL (PNAME, 1); 11003000 PNAME := PNAME+1; 11003500 OWNER := AI.OWNERF; 11004000 CASE OWNER OF 11005000 BEGIN 11006000 (SYSTEM): 11007000 REPLACE FILENAME [0] BY "*"; 11008000 LVLNDX [1] := 1; 11009000 ADDNAME (PNAME, NAMELEN, ALPHALEN, T); 11010000 NOPREFIX := FALSE; 11011000 (USERCOD): 11012000 REPLACE FILENAME [0] BY "(", 11013000 PNAME FOR NAMELEN, ")"; 11014000 LVLNDX [1] := 0; 11015000 IF NOPREFIX THEN 11016000 BEGIN 11017000 LVLNDX [2] := 0; 11018000 OWNER := MYDIR; 11019000 END ELSE 11020000 LVLNDX [2] := NAMELEN+2; 11021000 (MYDIR): 11022000 LVLNDX [1] := 0; 11023000 ADDNAME (PNAME, NAMELEN, ALPHALEN, T); 11024000 NOPREFIX := FALSE; 11025000 END CASE; 11026000 END LEVEL1NAME; 11027000 11028000 PROCEDURE PUTNAME (AI); VALUE AI; REAL AI; 11029000 % ------- 11030000 BEGIN 11031000 INTEGER NAMELEN, ALPHALEN, T; 11032000 POINTER PNAME; 11033000 PNAME := EA [AI.LINKF]; 11034000 NAMELEN := REAL (PNAME, 1); 11035000 ADDNAME (PNAME+1, NAMELEN, ALPHALEN, T); 11036000 END PUTNAME; 11037000 11038000 INTEGER PROCEDURE TITLESTART; 11039000 % ---------- 11040000 TITLESTART := TITLESTARTV; 11041000 11042000 EXPORT DIRREQUEST, DIRSIZE, DISPLAYFILEKIND, DISPLAYREQUEST, 11043000 GETTITLE, GETDIRECTORY, INITDIR, TITLESTART; 11044000 MYSELF.OPTION := * & 1 [12:1]; 11045000 STATE := NOREQUEST; 11046000 FREEZE (TEMPORARY); 11047000 END. 11048000