%constant %integer ssdatafiletype= 4 %constant %integer ssobjfiletype= 1 %constant %integer sscorruptobjfiletype=5 %constant %integer ssdirfiletype= 2 %constant %integer sscharfiletype= 3 %constant %integer sspdfiletype= 6 %constant %integer ssoptfiletype= 9 %record %format arf(%string (31) name, %integer type) %record %format pdhf(%integer dataend, datastart, size, filetype, sum, datetime, adir, count) %record %format rf(%integer conad, filetype, datastart, dataend) %record %format dhf(%integer dataend, datastart, size, filetype, sum, datetime, pstart, spare) %record %format lnf(%byte %integer type, %string (6) name, %integer rest, point, dr1) %record %format frf(%integer conad, filetype, datastart, datend, size, rup, eep, mode, users, arch, %string (6) tran, %string (8) date, time, %integer count, spare1, spare2) %record %format hf(%integer dataend, datastart, filesize, filetype, sum, datetime, format, records) %record %format dahf(%integer dataend, datastart, size, filetype, date, time, format, records) %system %routine %spec setwork(%integer %name ad, flag) %external %string %function %spec fromstring(%string %name s, %integer i, j) %system %routine %spec connect(%string (31) file, %integer mode, hole, prot, %record (rf) %name r, %integer %name flag) %system %routine fileanal(%string (31) file, %record (arf) %array %name r, %integer %name count, flag) %integer pstart, hashconst, i, conad, point, max, lda, list %integer link, mark %constant %byte %integer %array headoffset(16:20)= %c 4,16,28,32,36 %constant %byte %integer %array idenoffset(16:20)= %c 8,16,8,8,12 %string (255) s %record (pdhf) %name pdh %record (dhf) %name dh %record (rf) rr %record (lnf) %array %format haf(0:10000) %record (lnf) %array %name h max = count; !max no of elements in array r count = 0; !number filled by analyse connect(file, 0, 0, 0, rr, flag) ->err %if flag # 0 conad = rr_conad %if rr_filetype = ssobjfiletype %start; !object file lda = conad + integer(conad + 24); !abs addr ldata %cycle list = 16, 1, 20 link = integer(lda + headoffset(list)); !head of right list %while link # 0 %cycle count = count + 1 ->full %if count > max r(count)_name = string(conad + link + idenoffset(list)) r(count)_type = list link = integer(conad + link) %repeat %repeat ->err %finish %if rr_filetype = ssdirfiletype %start; !directory file dh == record(conad); !directory header hashconst = integer(conad + dh_datastart); !no of items in hash table h == array(conad + dh_datastart + 4, haf); !map onto hash arrray pstart = conad + dh_pstart point = 4; !first string !cycle through plist %while byteinteger(point + pstart) # 0 %cycle s = string(point + pstart) %if '=' # charno(s, 1) # 255 %and length(s) > 7 %and %c charno(s, 7) = '.' %then %start ! not an alias or empty string count = count + 1 ->full %if count > max; !array r is full r(count)_name = s r(count)_type = ssobjfiletype !now look for entry names that point to this name %cycle mark = 0, 1, 1; ! 0 for procedure entries, 1 for data entries. %cycle i = 0, 1, hashconst - 1 %if h(i)_point = point %and h(i)_name # ".EMPTY" %and %c h(i)_name # "" %and h(i)_type & 1 = mark %then %c %start count = count + 1 ->full %if count > max %if h(i)_type & X'80' # 0 %then %c r(count)_name = h(i)_name.string %c (conad + dh_pstart + h(i)_rest) %else %c r(count)_name = h(i)_name r(count)_type = mark + 16; ! 16 for procedure, 17 for data. %finish %repeat %repeat %finish point = point + length(s) + 1; !move on to next string in plist %repeat !now look for aliases point = 4; !first string in pointer list %while byteinteger(point + pstart) # 0 %cycle s = string(point + pstart) %if charno(s, 1) = '=' %start count = count + 1 ->full %if count > max r(count)_name = fromstring(s, 2, length(s)) !remove '=' r(count)_type = 21; !aliased name !now look for aliases that point here. %cycle i = 0, 1, hashconst - 1 %if h(i)_point = point %and h(i)_name # ".EMPTY" %and %c h(i)_name # "" %then %start count = count + 1 ->full %if count > max %if h(i)_type & X'80' # 0 %then %c r(count)_name = h(i)_name.string %c (conad + dh_pstart + h(i)_rest) %else %c r(count)_name = h(i)_name r(count)_type = 16 %finish %repeat %finish point = point + length(s) + 1; !move on to next string in plist %repeat ->err %finish; !end of directory file %if rr_filetype = sspdfiletype %start; !partitioned file pdh == record(conad) %if pdh_count <= max %then count = pdh_count %else %start flag = 300 count = max %finish !check if enough room in array r ->err %if count = 0; !no members point = conad + pdh_adir + 4 %cycle i = 1, 1, count r(i)_name = string(point + (i - 1) * 32) r(i)_type = 19; !member of a pdfile %repeat ->err %finish full: flag = 300; !user did not provide enough room in r count = count - 1; !reset count err: %end; !of fileanal %external %routine testanal(%string (255) file) %integer i, flag, count, ad %constant %integer maxrecs=10000 %record (arf) %array %format arfaf(1:maxrecs) %record (arf) %array %name r ad = maxrecs * (32 + 8) setwork(ad, flag) r == array(ad, arfaf) count = maxrecs flag = 0 fileanal(file, r, count, flag) write(flag, 1); newline %for i = 1, 1, count %cycle %exit %if r(i)_name = "" printstring(r(i)_name." is of type ") write(r(i)_type, 1) newline %repeat %end %end %of %file