{ Subsystem Utility Program (SUP) Version 1.0 created on 14-Jul-81 JEN 1. Compilation and Link Information SUP is designed to run under the RT11 V4 operating system (DEC). It is written in OMSI - PASCAL. In order to compile SUP the OMSI - PASCAL System V1.2 is required. SUP.PAS must be compiled together with FORSTR.PAS, which contains some string handling routines (See appendix B). The command would be: R PASCAL *SUP,SUP=FORSTR,SUP/N SUP.PAS and FORSTR.PAS make use of several SYSLIB - routines. So when you assemble and link SUP, make sure to have SYSLIB.OBJ and SYSMAC.SML on SY:. 2. General SUP is a program to create and maintain subsystemfiles. Subsystemfiles reside as normal RT11 - files on random access devices (preferably hard disks). They are distinguished from other files by the fact that they have an internal structure similar to a RT11 random access device: _________________________________________________ | blocks # | contents | |------------------+----------------------------| | 0..5 | bootstrap & home blocks | |------------------+----------------------------| | 6..numseg*2+6 | directory | |------------------+----------------------------| | numseg*2+7..eof | filestorage | |------------------+----------------------------| In conjunction with the DLLOAD _ program and the XT - handler (included in the MRRT11 V01 package (DEC)) subsystemfiles can be used to emulate RT11 system devices for LSI11 microcomputers which have no own masstorage device. The commands of SUP, their syntax and functions are listed in the file SUPHLP.TXT (See appendix C). They also can be displayed on the console terminal by issuing the SUP command HELP. Make sure that both, SUP.SAV and SUPHLP.TXT reside on SY: before issuing the HELP command. 3. Program Description Since SUP mainly is concerned with manipulating the directory of a subsystemfile you are urged to read chapter 9.1 of the RT11 handbook (vol. 3B, SSM Software Support Manual) before you try to study this program. After that it should be quite easy to understand the data structures and the program flow of SUP. The variable and constant names have been chosen to to reflect the diction introduced in the SSM. The program structure is straightforward. The main program consists of a loop which prompts for a command string, parses it, checks for illegal commands or filespecs and calls the appropriate procedures. Typically there is one procedure for each command: Command Procedure ------------------------- HELP help xtract COPY insert transfer INITIALIZE initialize BOOT boot DIRECTORY directory RENAME rename KILL delete Only COPY differs in this respect. Depending on the logical arrangement of the filespecs in the command string either insert, xtract or transfer is called. } label 1,5,10; const {offsets in dir entry} namea = 1; nameb = 2; {filename and extension in RAD50} extension = 3; length = 4; {length of file} channel = 5; {channel on which file is open} date = 6; {creation date of file} {offsets in dir header} maxseg = 1; {segments availlable for entries} nextseg = 2; {link to next dir segment} highseg = 3; {highest segment currently open} extrawords = 4; {number of extrabytes per entry} strtblk = 5; {block where files begin} {file status codes} eoseg = 4000B; permanent = 2000B; empty = 1000B; tentative = 400B; {other constants} half = 256; full = 512; type buffer = array [1..half] of integer; segment = array [1..full] of integer; block = file of buffer; temp50 = array [1..3] of integer; var infile,outfile,subf1,subf2,cmnd,inbuf : string; inthere,outhere,sub1th,sub2th,fsperr,mn : boolean; curptr : integer; seg : segment; index,startblock,seghigh,segnum,curseg : integer; sub,main : block; procedure skipblanks(var buffr:string; var ptr:integer); { works on string in buffr and skips blanks, starting at current position of ptr, until next nonblank character. ptr is incremented for each blank. } begin while (buffr[ptr] = ' ') and (buffr[ptr] <> chr(0)) do ptr := ptr + 1; end; {skipblanks} procedure hack(var fname:string); { starts at curptr (which points to a char in inbuf) and puts all following chars in fname till ' ' or '/' encountered, on exit curptr points to ' ' or '/'. global: inbuf , curptr } var i : integer; begin i := 1; while not((inbuf[curptr] = ' ') or (inbuf[curptr] = '/') or (inbuf[curptr] = chr(0))) do begin fname[i] := inbuf[curptr]; i := i + 1; curptr := curptr + 1 end; {while} fname[i] := chr(0); end; {hack} procedure xtrfspec(var mainf,subf:string; var mnth,subth:boolean); { takes a filespec from inbuf, starting at curptr and puts it leftjustified in a specified string (mainf). If a subfilespec is encountered (/), the subfilespec is put into a different string (subf). The flags mnth and subth are set on return, if something was actually entered into the strings. global: curptr, inbuf. } begin skipblanks(inbuf,curptr); hack(mainf); mnth := (LEN(mainf) > 0); if inbuf[curptr] = '/' then begin curptr := curptr + 1; skipblanks(inbuf,curptr); hack(subf); subth := (LEN(subf) > 0); end; {if} end; {xtrfspec} function checkspec(var fname:string; mn:boolean):boolean; { checks a filespec for correctness and adds defaults (.DSK, .DAT, SY:). mn is a switch which determines if spec to be checked is mainfile (true) or subfile (false). Return: true if error in filespec } label 1; var aux : string; len,i,dotptr,colonptr : integer; dummy,err,dot,colon : boolean; begin len := 80; colon := false; dot := false; err := false; colonptr := 0; dotptr := 15; i := 1; repeat err := err or not (fname[i] in ['A'..'Z','0'..'9',':','.']); if fname[i] = '.' then begin if not dot then begin dot := true; dotptr := i; end {then not dot} else err := true; end {then} else begin if fname[i] = ':' then begin if not colon then begin colon := true; colonptr := i; end {then not colon} else err := true; end; {then} end; {else} i := i + 1; until fname[i] = chr(0); if err then goto 1; {wrong character in filespec} err := ((i > 15) and mn) or ((i > 11) and not mn) or (not mn and colon); if err then goto 1; {filespec too long or colon in subfilespec} if dotptr > i then dotptr := i; {adjust dotptr} {start checking of filespec format} err := ((dotptr - colonptr) >= 8) or (dot and ((i - dotptr) <> 4)) or (colon and not ((colonptr = 3) or (colonptr = 4))); if err then goto 1; {filespec format wrong} {start adding defaults} if not dot then if ((dotptr - colonptr) >= 2) then begin { must be filestructured device } if mn then aux := '.DSK ' {default extension for subsystemfile} else aux := '.DAT '; {default extension for subfile} aux[5] := chr(0); CONCAT(fname,aux,fname,len,dummy); end; {if >=2} if not colon and mn then begin aux := 'SY: '; {default device for mainfile} aux[4] := chr(0); CONCAT(aux,fname,aux,len,dummy); fname := aux; end; {if not colon} 1: checkspec := err; end; {checkspec} procedure IRAD50(var icnt:integer; var inpt:string; var outpt:temp50);fortran; { SYSLIB-routine; takes icnt characters from inpt, converts them from ASCII to RAD50 representation and stores the result in outpt } procedure R50ASC(var icnt,inpt:integer; var outpt:string); fortran; { SYSLIB -routine; converts inpt from RAD50 representation to ASCII and stores result in outpt. icnt is the number of ASCII charcters to generate. If inpt is an array element of an integer, onedimensional array, more than 3 ASCII characters can be converted by specifying icnt > 3 and storing the RAD50 characters in consecutive locations of the input array starting with inpt. } procedure convert50(filn:string;var result:temp50); { takes an ASCII filespec in filn (name.ext) and converts it to RAD50 and stores it in result } var i,j :integer; begin i := 0; repeat i := i + 1; until filn[i] = '.'; if i = 7 then {shift down extension} for j := 1 to 4 do begin filn[i] := filn[i + 1]; i := i + 1; end {for} else begin filn[i] := ' '; i := i + 1; while i < 7 do begin {shift up extension and fill in blanks} for j := 4 downto 1 do filn[i + j] := filn[i + j - 1]; filn[i] := ' '; i := i + 1; end; {while} end; {else} j := 9; {number of chars to convert} IRAD50(j,filn,result); end; {convert} procedure writespecs(var subsy,subf:string); { writes the filespecs in subsy and subf and inserts a '/' between them to form a subsystem filespec } begin writestring(output,subsy); write('/'); writestring(output,subf); end; {writestring} procedure writefilenotfound; { This message is needed by various routines. In order to conserve space (approx. 70 words !) it has been coded as procedure. } begin write('?SUP-F-File not found: '); end; {writefilenotfound} function entry(searched:integer; var ind,stblock:integer):boolean; { finds a directory entry of specd. type (permanent, tentative, empty). If it finds an entry before reaching the end of segment it returns true, and index points to that entry. While skipping the entries, startblock is updated. } begin entry := false; while seg[ind] <> eoseg do begin if seg[ind] = searched then begin entry := true; exit; end; {if} stblock := stblock + seg[ind + length]; ind := ind + 7 + seg[extrawords]; end; {while} end; {entry} procedure blockcheck(read:boolean); { checks if segment currently in memory (curseg) is equal to requested segment (segnum). If not, reads (writes if read = false) segment specified by segnum, and updates curseg. Global: segnum,curseg,sub,seg,startblock,index } var blocknum,i : integer; begin if segnum <> curseg then begin blocknum := segnum * 2 + 5; seek(sub,blocknum); curseg := segnum; if read then begin for i := 1 to half do seg[i] := sub^[i]; get(sub); for i := half + 1 to full do seg[i] := sub^[i - half]; index := 6; startblock := seg[strtblk] + 1; end {then} else begin for i := 1 to half do sub^[i] := seg[i]; put(sub); for i := half + 1 to full do sub^[i - half] := seg[i]; put(sub) end; {else} end {if segnum} end; {blockcheck} procedure nexblock; { gets the next directory segment into memory } var rd : boolean; begin rd := true; segnum := seg[nextseg]; blockcheck(rd); end; {nexblock} function filefound(var searchname:string; var ind,stblock:integer):boolean; { scans a subdirectory for a file of specd. name and updates the startblock and index as it goes along. Returns true if file found } var typ : integer; aux : temp50; found : boolean; j : integer; begin filefound :=false; typ := permanent; convert50(searchname,aux); repeat while entry(typ,ind,stblock) do begin {find permanent entry} found := (seg[ind + namea] = aux[1]) and (seg[ind + nameb] = aux[2]) and (seg[ind + extension] = aux[3]); if found then begin filefound := true; exit {while loop} end; {if} stblock := stblock + seg[ind + length]; ind := ind + 7 + seg[extrawords]; end; {while} if (seg[nextseg] = 0) or found then exit {repeat loop} else nexblock; until false; end; {file found} procedure copyblocks(var inp,out:block; length:integer); { copys blocks from inpfile to outfile in sequential manner } var j : integer; begin for j := 1 to length - 1 do begin out^ := inp^; put(out); get(inp); end; {for} out^ := inp^; put(out); end; {copyblocks} function getsubdir(filename:string):boolean; { opens subsystemfile as random access fileand reads in first segment of subdirectory. Returns false if error during open of subsystemfile. Global: seg,index,segmax,segnum,curseg,seghigh,sub } var option : string; leng : integer; err,rd : boolean; begin getsubdir := true; option := '/SEEK '; option[6] := chr(0); leng := 72; CONCAT(filename,option,filename,leng,err); reset(sub,filename,,leng); if leng < 0 then begin getsubdir := false; filename[LEN(filename) - 4] := chr(0); {remove /SEEK} writefilenotfound; writestring(output,filename); writeln; end {then} else begin segnum := 1; curseg := 0; rd := true; blockcheck(rd); {read first segment of directory} seghigh := seg[highseg]; {save highest segment in use, highseg is updated in segment 1 only} end; {else} end; {getsubdir} procedure shiftdown(inold,segm:integer; var ind:integer); {shifts down all directory entries above i by one slot} var j,k,l :integer; begin l := inold; {save ptr for later} j := inold + 7 + seg[extrawords]; {adjust length of empty area} k := seg[inold + length] + seg[j + length]; {shift down} while seg[j] <> eoseg do begin seg[inold] := seg[j]; inold := inold + 1; j := j + 1; end; {while} seg[inold] := seg[j]; {now adjust indexptr of new file only if in same segment and old entry below new} seg[l + length] := k; if (segm = curseg) and (ind > l) then ind := ind - 7 - seg[extrawords]; end; {shiftdown} function killed(var fname:string; var ind,segm:integer):boolean; { searches subdirectory for permanent entry of fname and marks this entry empty } var rd : boolean; begin index := 6; startblock := seg[strtblk]; killed := false; if filefound(fname,index,startblock) then begin seg[index] := empty; {mark it empty, then test if following entry empty} if seg[index + 7 + seg[extrawords]] = empty then shiftdown(index,segm,ind); if seg[index + length] = 0 then shiftdown(index,segm,ind); {there is no sense in keeping an empty entry of length zero} index := index - 7 - seg[extrawords];{ previous entry empty ?} if (index >= 6) and (seg[index] = empty) then shiftdown(index,segm,ind); {write segment back} segnum := curseg; curseg := 0; rd := false; {force write} blockcheck(rd); killed := true; {it was actually killed} end; {then} end; {kill} function extend:boolean; { extends a directory by one segment if availlable. Puts half the entries into the new segment, while leaving the other half in the old } var offset,typ : integer; rd : boolean; begin if seghigh = seg[maxseg] then begin {no more segments availlable} writeln('?SUP-F-Directory overflow'); extend := false; end {then} else begin index := 6; startblock := seg[strtblk]; typ := permanent; while entry(typ,index,startblock) and (index < half) do; {get first permanent entry after half segment} seg[index] := eoseg; {cut off segment in the middle} seghigh := seghigh + 1; seg[nextseg] := seghigh; {set link to next segment} segnum := curseg; curseg := 0; rd := false; {force write of shortened segment} blockcheck(rd); {fill in new segment} seg[strtblk] := startblock; seg[nextseg] := 0; seg[index] := permanent; {restore state of file} {move down remaining entries} offset := index - 6; repeat seg[index - offset] := seg[index]; index := index + 1; until seg[index] = eoseg; {write this new segment} segnum := seghigh; {curseg = previous segment, rd still false} blockcheck(rd); {read in segment number 1} segnum := 1; curseg := 0; rd := true; blockcheck(rd); seg[highseg] := seghigh; {update highest seg in use} curseg := 0; {write it back}; rd := false; blockcheck(rd); {on exit segment 1 is in memory, index = 6, startblock ok} extend := true; end; {else} end; {extend} procedure xtract(var subsys,subfile,mainsys:string); { copies a file (filespec in subfile) from a subsystem (name: subsys) to the main system (name in mainsys) } var leng :integer; begin if getsubdir(subsys) then {no error occurred during open} if filefound(subfile,index,startblock) then begin leng := seg[index + length]; rewrite(main,mainsys,,leng); {open outputfile of necessary length} if (leng = 0) then leng := seg[index + length]; { leng = 0 if non file structered device, e.g. LP:} if (leng = seg[index + length]) then begin seek(sub,startblock); copyblocks(sub,main,leng); writeln('File copied:'); writespecs(subsys,subfile); write(' to '); writestring(output,mainsys); end {then} else begin { here if rewrite returned an error} write('?SUP-F-Can''t create '); writestring(output,mainsys); end; {else} writeln; close(main); end {then} else begin writefilenotfound; writespecs(subsys,subfile); writeln; end; {else} close(sub); end; {xtract} procedure help; { types the contents of a file called SY:SUPHLP.TXT to the console. } label 10; var leng,s : integer; inp : text; c : char; jsw origin 44B :integer; function ITTINR:integer;fortran; {SYSLIB - routine, gets a character from console terminal. See ITTINR. } begin {help} reset(inp,'SY:SUPHLP.TXT',,leng); if leng <= 0 then begin writefilenotfound; writeln('SY:SUPHLP.TXT'); end {then} else while not eof(inp) do begin {copy a line} while not eoln(inp) do begin read(inp,c); if c = chr(12) then begin write ('Type to continue or to stop...'); jsw := jsw or 10000B; {special mode} repeat s := ITTINR until s > 0; jsw := jsw and 167777B; s := s and 177B; {lower byte} if s = 15B then begin s := ITTINR;{get LF } goto 10; end; end; {if} write(c); end; {while eoln} readln(inp); writeln; end; {while eof} 10: close(inp); end; {help} procedure insert(var mainsys,subsys,subfile:string); { inserts a file from the main system into the subsystem } label 5,10; var aux : temp50; typ,leng,j : integer; rd,found : boolean; begin if getsubdir(subsys) then begin {no error occurred during open} reset(main,mainsys,,leng); if leng <= 0 then begin {file not found} { <= 0 inhibits insert operation from nonfilestructured device} writefilenotfound; writestring(output,mainsys); writeln; goto 10; end; {if leng} segnum := 1; rd := true; blockcheck(rd); {makes sure correct directory segment is in memory} 5: typ := empty; {find empty area of fitting size} found := entry(typ,index,startblock); if found then begin if seg[index + length] < leng then begin startblock := startblock + seg[index + length]; index := index + 7 + seg[extrawords]; goto 5; end; {if seg[]} end {found} else begin if seg[nextseg] <> 0 then begin nexblock; goto 5 end else begin write('?SUP-F-No room on '); writestring(output,subsys); writeln; goto 10; end; {else seg[]} end; {else} if seg[index + length] <> leng then begin {that means it is greater than leng. Therefore it is necessary to create a nethen begin startblock := startblock + seg[index + length]; index := index + 7 + seg[extrawords]; goto 5; end; {if seg[]} end {found} else begin if seg[nextseg] <> 0 then begin nexblock; goto 5 end else begin rt insert operation} else goto 10 {no extension possible} else begin repeat {shift up all entries} seg[j] := seg[j - 7 - seg[extrawords]]; j := j - 1; until j = index + 7 + seg[extrawords]; seg[j] := seg[j - 7 - seg[extrawords]]; {index points to new entry, j to rest of unused area} seg[j + length] := seg[j + length] - leng; {adjust length of unused area} end; {else full} end; {if <> leng} {fill in new entry, index points there} seg[index] := tentative; convert50(subfile,aux); seg[index + namea] := aux[1]; seg[index + nameb] := aux[2]; seg[index + extension] := aux[3]; seg[index + length] := leng; seg[index + channel] := 0; {$C .MCALL .DATE .DATE ;GET CURRENT DATE FROM SYSTEM MOV %0,J(SP) ;SAVE IN J } seg[index + date] := j; for j := 1 to seg[extrawords] do seg[index + date + j] := 0; {write back subdirectory} j := index; {save index and curseg} typ := curseg; segnum := curseg; curseg := 0; rd := false; {force a write} blockcheck(rd); {copy blocks from mainfile to subfile} seek(sub,startblock); copyblocks(main,sub,leng); writeln('File copied:'); writestring(output,mainsys); write(' to '); writespecs(subsys,subfile); writeln; {now delete file of same name in subsystem, if present} segnum := 1; rd := true; blockcheck(rd); {make sure first directory segment is in memory} rd := killed(subfile,j,typ); {rd serves only as a dummy to receive return value of function killed } segnum := typ; {get back curseg} rd := true; blockcheck(rd); {read in old segment} index := j; {restore old index} seg[index] := permanent; {write back segment} curseg := 0; rd := false; blockcheck(rd); 10: close(main); end; {then getsubdir} close(sub); end; {insert} procedure initialize(var fname:string); { creates a new subsystemfile of specified length and initializes the directory with specified number of segments } var leng,numseg,i : integer; opt : string; err : boolean; function decode(var number:string; var ptr,a:integer):boolean; { takes the ASCII representation of a signed integer which is stored in the string 'number' and pointed to by ptr and converts it to its binary form. The conversion stops if a non-digit or a conversion error is encountered. If the first characters are anything else than ,+,- or a digit the function returns false. It also returns false, if the number is larger than +-32767 } label 1; {error exit} const zero = 60B; {chr(0)} var s,b : integer; begin decode := true; skipblanks(number,ptr); if number[ptr] = '-' then begin s := -1er which is stored in the string 'number' and pointed to by ptr and converts it to its binary form. The conversion stops if a non-digit or a conversion error is encountered. If the first characters are anything else than ,+,- or a digit the function returns false. It also returns false, if the number is larger than +-32767 } label 1; {error exit} const zero = 60Bint-b)/10) then a := 10 * a + b else begin {a would be larger than maxint} decode := false; goto 1 end; {else} ptr := ptr + 1; until not(number[ptr] in ['0'..'9']); a := a * s; {make a signed number} 1: end; {decode} begin {initialize} repeat write('How many blocks (256-1024) [1024]? '); getline(inbuf); if inbuf[1] = chr(0) then leng := 1024 else begin curptr := 1; if not decode(inbuf,curptr,leng) then leng := 0; end; {else} until leng > 0; repeat write('How many directory segments (1-4) [1]? '); getline(inbuf); if inbuf[1] = chr(0) then numseg := 1 else begin curptr := 1; if not decode(inbuf,curptr,numseg) then numseg := 0; end; {else} until numseg > 0; opt := '/SEEK '; opt[6] := chr(0); i := 72; CONCAT(fname,opt,fname,i,err); i := leng; rewrite(main,fname,,leng); if i = leng then begin {file of desired length is open} for i := 1 to half do main^[i] := 0; {zero buffer} main^[234] := 1; { default pack cluster size } main^[235] := 6; { block # of first dir segment } for i := 1 to 6 do put(main); {zero first six blocks} {now initialize first directory segment} main^[maxseg] := numseg;{max. number of segments availlable} main^[highseg] := 1; {highest segment currently in use} main^[strtblk] := numseg * 2 + 6; index := 6; main^[index] := empty; {first entry is empty} main^[index + length] := leng - main^[strtblk]; {empty entry has length of rest of file} main^[index + 7 + main^[extrawords]] := eoseg; {next entry is eoseg} put(main); {write out} for i := 1 to half do main^[i] := 0; {zero buffer} put(main); {write second half of segment #1} for i := 2 to numseg do begin {for the remaining segments} main^[maxseg] := numseg; put(main); main^[maxseg] := 0; put(main); end; {for} seek(main,leng); put(main); {make sure that file will have specified number of blocks at close} end { if i = leng } else begin fname[LEN(fname) - 4] := chr(0); { remove /SEEK } write('?SUP-F-Can''t create '); writestring(output,fname); writeln; end; {else} close(main); end; {initialize} procedure boot(var subsys,sub1,version,sub2:string); { copies bootstrap information from monitorfile in subsystemfile to blocks 2 to 5 and the primary driver from the system device handler to block 0 of the subsystemfile. If V3 (RT11 V3.0) is specified in the call the primary driver is taken from block 0 of the monitor file } label 10; var aux : buffer; temp : temp50; rd : boolean; bootloc,bootlen,blk,offs,i,j : integer; begin if getsubdir(subsys) then begin if version[5] = '4' then {this is the RT11V4 boot} if filefound(sub2,index,startblock) then begin {system device handler found} seek(sub,startblock); {handler block 0} bootloc := sub^[26]; {location of primary driver = 62} bootlen := sub^[27] div 2; {length of pr. dr. = 64 } if (bootlen > half) or (bootloc = 0) then begin writeln('SUP-F-Invalid system device'); goto 10; end; blk := bootloc div 512 + startblock; {compute relative startblock of pr. driver} offs := (bootloc mod 512) div 2; {compute relative word of start of pr. driver} seek(sub,blk); i := 1; repeat {put primary driver into aux buffer} aux[i] := sub^[i + offs]; i := i + 1; until (i = bootlen + 1) or ((i + offs) = half +1); if i < bootlen then begin get(sub); {get next block} j := i; i := 1; repeat aux[j] := sub^[i]; i := i + 1; j := j + 1; until j = bootlen + 1; end; {if}; blk := 1; seek(sub,blk); {goto block 0} for i := 1 to half do sub^[i] := aux[i]; put(sub); {put primary driver into block 0} end {if filefound} else begin writefilenotfound; writespecs(subsys,sub2); writeln; goto 10; end; {else} segnum := 1; rd := true; blockcheck(rd); {make sure dirseg # 1 is in memory} index := 6; startblock := seg[strtblk] + 1; if filefound(sub1,index,startblock) then begin {look up monitor file} if version[5] = '4' then begin {copy blocks 1 - 4 of monitor file to blocks 2 - 5 of subsystemfile} startblock := startblock + 1; for blk := 3 to 6 do begin seek(sub,startblock); {get block 1 of monitor file} for i := 1 to half do aux[i] := sub^[i];{save it} seek(sub,blk); {goto block 3 of subsystemfile} if blk = 6 then begin {put monitor name in last block} convert50(sub1,temp); aux[235] := temp[1]; aux[236] := temp[2]; end; {if} for i := 1 to half do sub^[i] := aux[i]; {fill in buffer} put(sub); {and put to blocks 3 - 6} startblock := startblock + 1; end; {for blk} end {if version 4} else begin {older versions of RT11} {copy monitor blocks 0 to 4 to blocks 0 and 2 to 5 of subsystemfile} if version[5] <> '3' then begin { boot copies are implemented for V3 and V4 only} writeln('?SUP-F-Wrong version number.'); goto 10 end; {if version} j := 1; for blk := 1 to 5 do begin seek(sub,startblock); {get block 0 of monitorfile} for i := 1 to half do aux[i] := sub^[i]; {save it} if j = 2 then j := j + 1; seek(sub,j); for i:= 1 to half do sub^[i] := aux[i]; {fill in buffer} put(sub); startblock := startblock + 1; j := j + 1; end; {for blk} end; {else older versions} end {if filefound} else begin writefilenotfound; writespecs(subsys,sub1); writeln; end; {else} end; {if getsubdir} 10: close(sub); end; {boot} procedure transfer(var subsy1,subfl1,subsy2,subfl2:string); { copies a file from one subsystem to another by using the procedures xtract and insert. The file is xtract'ed from subsy1 to a temporary file on the main system disk. Then the temporary file is insert'ed in subsy2 and subsequently deleted . } var temp : string; begin temp := 'SY:TRANSF.TMP '; temp[14] := chr(0); xtract(subsy1,subfl1,temp); insert(temp,subsy2,subfl2); rewrite(main,temp); {make transfer file contain zero blocks} close(main); end; {transfer} procedure delete(var subsys,subfile:string); { deletes a filename from subsys after checking subfilename with the user } var indx,segmn : integer; {dummy parameters for function kill} begin write('Delete '); writespecs(subsys,subfile); write(' - Are you sure? '); getline(inbuf); if inbuf[1] = 'Y' then begin if getsubdir(subsys) then {no error occurred during open} if killed(subfile,indx,segnum) then writeln('?SUP-I-File deleted.') else begin writefilenotfound; writespecs(subsys,subfile); writeln; end; {else} close(sub); end; {if inbuf[]} end; {delete} procedure rename(var subsy1,oldspec,subsy2,newspec:string); { searches subdirectory of subsy1 for oldspec and if found replaces oldspec with newspec } var newR50 : temp50; rd : boolean; begin if getsubdir(subsy1) then begin {no error occurred during open} if filefound(oldspec,index,startblock) then begin convert50(newspec,newR50); seg[index + namea] := newR50[1]; seg[index + nameb] := newR50[2]; seg[index + extension] := newR50[3]; segnum := curseg; {force a write-back of segment} curseg := 0; rd := false; blockcheck(rd); {print done message} writeln('File renamed:'); writespecs(subsy1,oldspec); write(' to '); writespecs(subsy1,newspec); writeln; end {then} else begin writefilenotfound; writespecs(subsy1,oldspec); writeln; end; {else} end; {if getsubdir} close(sub); end; {rename} procedure directory(var subsys,subfile:string); { displays the files and if specified the unused areas of subsys including size and creation date if present. Also prints total number of files, blocks and unused areas. } label 1; const maxzone = 2; tab = 9; var files,blocks,free,zonecntr,i : integer; month,day,year : integer; aux : array [1..3] of char; begin if getsubdir(subsys) then begin {no error occurred during open} files := 0; blocks := 0; free := 0; zonecntr := 0; writeln; write('Directory of '); writestring(output,subsys); writeln; writeln; 1: while seg[index] <> eoseg do begin if (seg[index] = empty) or (seg[index] = tentative) then begin if sub1th and (subfile[1] = 'F') then begin write('< UNUSED >',seg[index+length]:10, chr(tab),chr(tab),chr(tab)); zonecntr := zonecntr + 1; end; {if sub1th} free := free +seg[index + length]; end {then} else begin {here for permanent and protected areas} i := 9; {number of chars to convert} R50ASC(i,seg[index+namea],inbuf); for i := 9 downto 7 do inbuf[i+1] := inbuf[i]; inbuf[7] := '.'; inbuf[11] := chr(0); writestring(output,inbuf); write(seg[index + length]:10); blocks := blocks + seg[index + length]; files := files + 1; if seg[index + date] <> 0 then begin {convert date} month := (seg[index+date] and 76000B)div 1024; day := (seg[index+date] and 1740B)div 32; year := (seg[index+date] and 37B) +110B; case month of 1: aux := 'Jan'; 2: aux := 'Feb'; 3: aux := 'Mar'; 4: aux := 'Apr'; 5: aux := 'May'; 6: aux := 'Jun'; 7: aux := 'Jul'; 8: aux := 'Aug'; 9: aux := 'Sep'; 10: aux:= 'Oct'; 11: aux:= 'Nov'; 12: aux:= 'Dec'; end; {case} write(day:5,'-',aux:3,'-',year:2,chr(tab)); end {if date <> 0} else write(chr(tab),chr(tab),chr(tab)); zonecntr := zonecntr + 1; end; {else seg[index]} if zonecntr = maxzone then begin writeln; zonecntr := 0; end; index := index + 7 + seg[extrawords]; end; {while} if seg[nextseg] <> 0 then begin nexblock; goto 1; end else begin writeln; writeln(files:5,' Files,',blocks:5,' Blocks'); writeln(free:5,' free Blocks'); end; end; {if getsubdir} close(sub); end; {directory} begin {sup} 1: writeln('SUP V1.0'); writeln('For instructions type: HELP'); 5: write('?'); getline(inbuf); curptr := 1; infile[1] := chr(0); outfile[1] := chr(0); subf1[1] := chr(0); subf2[1] := chr(0); inthere := false; outhere := false; sub1th := false; sub2th := false; {get command} skipblanks(inbuf,curptr); hack(cmnd); {check if valid command; if so get filespecs} case cmnd[1] of '' : goto 1; 'H' : begin help; writeln; goto 5; end; 'E' : goto 10; 'C','D','K','R','I','B' : xtrfspec(infile,subf1,inthere,sub1th); else begin Writeln('?SUP-F-Illegal command'); goto 5; end; {else} end; {case} if cmnd[1] in ['C','R','B'] then xtrfspec(outfile,subf2,outhere,sub2th); if not inthere then begin {we havn't got an input filespec} repeat write('File?:'); getline(inbuf); until inbuf[1] <> chr(0); curptr := 1; xtrfspec(infile,subf1,inthere,sub1th); end; {if} if (cmnd[1] in ['C','R','B']) and not outhere then begin repeat write('to: '); getline(inbuf); until inbuf[1] <> chr(0); curptr := 1; xtrfspec(outfile,subf2,outhere,sub2th); end; {if} { at this point all filespecs should be collected, now go and check them for correctness. } fsperr := false; mn := true; fsperr := checkspec(infile,mn); if outhere then fsperr := fsperr or checkspec(outfile,mn); mn := false; if sub1th then fsperr := fsperr or checkspec(subf1,mn); if sub2th then fsperr := fsperr or checkspec(subf2,mn); if fsperr then begin writeln('?SUP-F-Illegal filespec'); goto 5; end; {if} { filespecs should be o.k. now,exept for missing subfilespecs } case cmnd[1] of 'C' : if sub1th and not sub2th then xtract(infile,subf1,outfile) else if not sub1th and sub2th then insert(infile,outfile,subf2) else if sub1th and sub2th then transfer(infile,subf1,outfile,subf2) else fsperr := true; 'K' : if sub1th then delete(infile,subf1) else fsperr := true; 'R' : if sub1th and sub2th then rename(infile,subf1,outfile,subf2) else fsperr := true; 'D' : directory(infile,subf1); 'I' : initialize(infile); 'B' : if sub1th and sub2th then boot(infile,subf1,outfile,subf2) else fsperr := true; end; {case} if fsperr then writeln('?SUP-F-Missing subfilename'); goto 5; {loop back to prompt} 10: end.