home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
burroughs7900.tar.gz
/
burroughs7900.tar
/
b79dir.alg
next >
Wrap
Text File
|
1988-08-16
|
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