!TITLE Editing the configuration file
!
! %externalroutine modftrans ( %string(31) FILE )
!
! To use modftrans, type modftrans <filename> ,where <filename> is the name of a
!new file, or a configuration file previously created with this program. If a
!file that was not created with this program is supplied, the program will
!terminate saying so.
! You will be told if the file is a new file ( <filename> is a new file ); if
!it isn't, ignore the message
! CONFIG#WORK is a copy of <filename>
!This is output by the routine that copies the original file to a workfile
!CONFIG#WORK.
! The program then prints out the first descriptor in the file ( see the
!description of the command P for Print ), and gives the prompt
! Config :
!to which you reply with a command.
!
!
!
!
!< Commands
!< Help
!? ( for help )
!--------------
!
! Type ? for help information. This gives a list of the commands available,
!along with a ( very ) brief description of what they do. It also gives the legal
!commands when inserting a descriptor ( more about this under the commands I and
!C ).
!
!
!>
!< Defaults
!! ( to print out the defaults for a descriptor )
!------------------------------------------------
!
! The command ! prints out a list of the default settings for a descriptor.
!The command takes no parameters.
!
!
!>
!< Move
!M ( for Move )
!--------------
!
! M moves to the next descriptor. Note that you can only move, insert,
!delete etc in whole descriptors, not parameter by parameter.
!If M is not followed by any parameters, the movement is forward by 1 descriptor.
!However it is possible to suffix the command by an integer ( non-zero, but
!negative numbers are allowed; they move backwards ). Instead of using a number,
!you can suffix the command with * ( or -* ), meaning a very large number - to
!the end ( or beginning ) of the file. If the move would take you off either
!end of the file, you stop at the end.
! This command causes the position in the file to be printed out after the
!command line has been executed.
!>
!< Print
!P ( for Print )
!---------------
!
! P prints out descriptors in the file. The same notes and comments apply as for
!M: you can print out n, -n, '*' or '-*' descriptors, and you can't print out off
!either end of the file. Also, the program tells you if you are at the
!beginning or the end of the file, with the message
! ** First station ** or
! ** Last station **
!Note that to get the latter message, you must be AFTER the last descriptor,
!which will be a blank descriptor ( no parameters ).
!
!
!>
!< Insert
!I ( for Insert )
!----------------
!
! I allows you to insert descriptors into the file. You follow the command with
!with the number of descriptors you want to insert ( not zero or negative, 1 by
!default ). You can't have more than 512 stations, so if you try to insert a
!number that would give a total of more than this, the number is trimmed, and
!you are told how many may be input.
! For each parameter of a descriptor, you are told the default, if one exists.
!You are then prompted for the value or setting of the parameter. Legal replies
!are : <return> means leave as defaulted ( if there is no default, the program
! asks for another reply )
! * means leave this and all the other parameters as defaulted
! ( if either this parameter or any following ones have no
! default, the program asks for another reply );
! ? means 'help' - the program supplies a brief description of the
! parameter, and perhaps possible settings;
! <text> means set the parameter to <text>.
!PAGE
!
! If either the descriptor is longer than 4096 bytes, or the total file length
!with the new descriptor is longer than 200 Kbytes, the insertion is aborted with
!the message
! Descriptor too large
!
!
!>
!< Delete
!D ( for Delete )
!----------------
!
! You can delete descriptors from the file with the command D. Legal parameters
!are n or * ( or 1 by default ); you can't delete backwards. The best way to
!delete -n descriptors is to set up the macro 'M-D' ( see under command U ) and
!then give the command Xn ( Execute macro n times ); DON'T use M-nDn, since if
!you hit the top of the section prematurely, you will still delete n descriptors,
!which will be more than intended.
! This command causes the position in the file to be printed out when the
!command line has been executed.
!>
!< Change
!C ( for Change )
!----------------
!
! Using the command C allows you to edit ( change ) a descriptor parameter by
!parameter, instead of having to use DI. The parameters are the same as for
!D : n or *, or 1 by default. This is the only command that doesn't strictly work
!in whole descriptors, but in parameters.
! For each parameter, the program displays the current setting, then prompts you
!with the name of the parameter. The legal replies are :
! <return>, meaning 'leave this parameter as it is',
! <*>, meaning 'leave the rest of the descriptor as it is',
! and <text>, meaning 'set this parameter to <text>'.
! Again, like I, if either the descriptor is longer than 4 Kbytes, or the total
!file length longer than 200 Kbytes, the change is aborted with the message
! Descriptor too large.
! To simulate the command C-n, set up the macro M-CM- ( move backwards 2 since
!the command C moves you onto the next descriptor after changing one ), then give
!the command Xn.
! This command is one that causes the position in the file to be printed out
!when the command line has been executed.
!>
!< Find
!F ( for Find )
!______________
!
! F allows you to move to the first descriptor ( in either direction ) that
!contains a certain string. The legal formats of the command are :
! F/text/ means search for the first occurrence of the string 'text' in
! the file and stops at the beginning of the descriptor
! containing it ( remember the program only works in whole
! descriptors ),
! F-/text/ searches backwards for the last occurrence of 'text' in the
! same manner,
! F and F- search forwards and backwards respectively for the last used
! text ( which must have been defined ),
! F? prints out the current search text, or 'Not defined' if not
! defined.
!In any format, if the text is not found, the message
! String not found
!is output and the position in the file is not changed.
!PAGE
!
! The search is carried out case-independantly. To include the character / in
!the search string, it needs to be included twice : F/ABC//DEF/ searches for the
!string 'ABC/DEF'.
! F is another command that prints out the position in the file after the
!command line has been executed.
!
!
!>
!< Change Top
!T ( to change Top of file )
!---------------------------
! The first four lines of the file contain parameters for MAILER. These are
!IPL discs, Update, This host and Dead Letters. The command T changes these,
!exactly like changing a descriptor - replies are *, null or <text>.
!>
!< Repeat
!R ( to repeat a descriptor )
!----------------------------
! The command R must be followed by the name of a station, in delimiters.
!The program takes a copy of the station with the given name, placing it in
!front of the current descriptor.
!>
!< List
! L ( to list file to a character file to be sent to a printer, for example )
!----------------------------------------------------------------------------
! The command L lists the defaults, followed by the file itself, to a
!character file. The name of this file can be specified after the command,
!inside delimiters ( "/"'s ). If none is specified, the default name is used
!instead. This is the name of the input file, followed by an "L". If the list
!file already exists, you are asked whether it is ok to overwrite it. If it
!is not ok, the program returns to editing without doing anything.
!>
!< Compile
!K ( to Kompile the file )
!-------------------------
! The parameter for the command K is similar to that for L(ist). If it is
!followed by a file name in delimiters, that name is used. Otherwise the default
!name ( the input file name suffixed with "Y" ) is used. If a name is specified,
!the default file name is set to it too, so if the compilation fails, the name
!need only be given once. If the output file so found already exists, you are
!asked whether it is ok to overwrite it. If it is, the program tries to compile
!the configuration file. If it fails, it returns to the editor. If it succeeds,
!the program terminates.
!>
!< Set up macro
!U ( to set up User-defined macro )
!-----------------------------------
!
! U allows you to set up a macro, which can be repeatedly executed. For example,
!the macro F/XYZ/PM, followed by the command X10 ( execute macro 10 times ),
!will find and print out the next 10 descriptors containing 'XYZ'.
! To set the macro, reply to the prompt
! Macro defn:
!with the command(s) you want, just as you would to the prompt
! Config :
! If the command following U is ?, or the reply to the prompt Macro defn: is ?,
!the current macro is displayed instead.
! The macro can't contain the commands U, X, A(bort), E(nd) or K(ompile)
!
!
!>
!< Execute macro
!X ( for Execute macro )
!-----------------------
!
! The command X executes the current user-defined macro a certain number of
!times - the number following the command ( not zero or negative ), 1 by default.
! The macro cannot contain the commands U, X, A(bort) or E(nd); trying to use
!any of these results in the messages
! Can't use U ( or whatever ) in a macro and
! Illegal macro,
!the execution of the command line is stopped and the macro is deleted. The same
!happens if the macro contains an illegal command ( eg Z, or P0 ), except that
!the error messages are
! Illegal command or
! Illegal parameter for PRINT ( or whatever )
!followed by Illegal macro
!respectively. If a command like F/ABCD/ fails, the execution of the macro and
!the command line ceases, but the macro isn't destroyed.
!>
!< Abort
!A ( for Abort )
!---------------
!
! The command A aborts the editing session, without changing the input file, if,
!for example, you delete all the stations by mistake.
! The program gives you the prompt
! Abort :
!to which you reply
! A ( abort ) or
! Y ( yes )
!to abort the editing, and anything else to return to the program without losing
!anything.
!
!
!>
!< End
!E ( for End )
!-------------
!
! The command E ends the editing session, saving all the changes made in the
!input file.
!
!>
!>
!< Name formats
! The NRS requires that hosts can each be called by several names. The
!system used in this program for this is as follows.
!
! a character is either a letter, a digit or a dash "-"
! a word is one or more characters
! an item is a word or null ""
! a list of alternatives is a left bracket "(",
! followed by one or more items separated by commas,
! followed by a right bracket ")"
! a piece is either a word or a list of alternatives
! a component is one or pieces separated by dots
! a name is then one or more components separated by commas
!
! eg "uk.ac.(edinburgh,ed,rco),edinburgh,ed,rco" is legal.
!
! The host so named can then be accessed by any of the alternatives.
!In the above example, for instance, there are 6 choices : uk.ac.edinburgh,
!uk.ac.ed, uk.ac.rco, edinburgh, ed and rco, with the first of these being
!the preferred name.
!PAGE
! If any of these 6 alternatives is then included as the first part of another
!name, all are considered included. For instance, if the above example were
!followed by a host with the name uk.ac.edinburgh.(emas,2972), this host
!could be accessed by 12 different names - any of the above 6 followed by
!".emas", or any followed by ".2972". Again, it is the first choice that is
!the preferred name : uk.ac.edinburgh { the preferred name for the first}
!example } .emas
! If an entry is just for a directory rather than a host ( eg uk.ac.edinburgh
!rather than uk.ac.edinburgh.emas ) reply BASE to parameter Address type. This
!implies that all parameters except Name and Description are irrelevant, so you
!won't get prompted for them.
!>
external routine modftrans(string (31) file)
!-------------------------------------------------------------------------------------------------------------------!
! MODFTRANS
! by Jeremy Gibbons
! Version No : 4
! Creates a spooler configuration file, ready to be analysed.
! Only non-standard ( not default ) parts of a description are included.
!-------------------------------------------------------------------------------------------------------------------!
record format rf(integer conad, filetype, datastart, dataend)
system routine spec change file size(string (31) file, integer newsize, integer name flag)
external routine spec copy(string (255) s)
external routine spec define(string (255) s)
external integer fn spec exist(string (31) file)
system routine spec trim(string (31) file, integer name flag)
system routine spec connect(string (31) file, integer mode, hole, prot, record (rf) name r,
integer name flag)
system routine spec outfile(string (31) file, integer filesize, hole, prot, integer name conad, flag)
system routine spec disconnect(string (31) file, integer name flag)
system routine spec destroy(string (31) file, integer name flag)
system routine spec newgen(string (31) file, newfile, integer name flag)
system routine spec rename(string (31) file, newfile, integer name flag)
system string fn spec failure message(integer return code)
system string fn spec itos(integer i)
system routine spec move(integer length, from, to)
system integer fn spec pack date and time(string (8) date, time)
external routine spec prompt(string (15) s)
system integer fn spec pstoi(string (63) s)
external integer fn spec return code
external string fn spec ucstring(string (255) s)
external string fn spec uinfs(integer type)
!-------------------------------------------------------------------------------------------------------------------!
const integer forwards= 1, backwards = -1
const integer already exists= 219
const byte integer delimiter= '/'; ! Delimiter for search string
const byte integer ignore= B'00001000', multiple= B'00000100',exit = B'00000010',default = B'00000001'
! Masks for TEMPLATE data
const integer ext file header size= 48
const integer n parameters= 15; ! Number of parameters
const integer max desc size= 4096; ! Maximum descriptor size ( arbitrary - only used when creating INSERTFILE )
const integer no of commands= 16
const integer read and write= 3; ! Mode to connect files in
const integer ok= 0, not ok = 1
constbyteinteger file service = x'01'
constbyteinteger mail service = x'02'
const integer worksize=128000
const integer hash length=1023; !must be 2**n -1
const integer max fsys=99
const integer update flag=1
const integer update copy flag=2
const integer route flag=4
const integer this auth flag=8
const integer this host flag=16
constinteger local host flag = 32
const integer found=1, not found = 0, yes = 1, no = 0
constinteger closed = no
const string (1) snl= "
"; ! Newline string
const string (11) workfile= "CONFIG#WORK"; ! Name of file all work is done in
const string (11) insertfile= "CONFIG#NEW"; ! Name of file where new descriptor is built up
const string name date= X'80C0003F', time = X'80C0004B'
const byte integer array command(1:no of commands)= c
'?','P','M','F','I','D','C','U','X','!','A','E','K','L','R','T'
! All the legal commands
const byte integer array template(1:2, 1:n parameters)= c
{ NSI } { TS }
B'00000000', B'00000000',
B'00000000', B'00000000',
B'00000001', B'00000001',
B'00000001', B'00000001',
B'00000000', B'00110100',
B'00000000', B'00000000',
B'00000011', B'00000011',
B'00000011', B'00001000',
B'00001000', B'00000011',
B'00001000', B'00000011',
B'00000011', B'00000011',
B'00000011', B'00000011',
B'00000011', B'00000011',
B'00000011', B'00000011',
B'00000011', B'00000011'
! Template B'abcdefgh'
!
! abcd : Maximum no of multiple inputs - 1, if allowed ( ignored if not ) - ie B'0000' means max 1
! ( so it is possible to represent 16 in 4 bits, since 0 is redundant )
!
! e = 1 : Ignore this parameter ( it has to be NA )
!
! f = 0 : Only single input
! f = 1 : Multiple inputs allowed
!
! g = 0 : Can't exit from here ( this or later parms have no default )
! g = 1 : Can exit from here ( this and later parms all have defaults )
!
! h = 0 : No default for this parm
! h = 1 : This parm has a default
const integer max stations= 512; ! Max. number of stations
const string (11) array parameter names(1:n parameters)= c
"Name","Description","Addr type","Short name","Address","FEP","Services",
"PSS No","FTP","Mail Suffix","Limit","Lines","Status", "M route", "M update"
const string (255) array descriptor defaults(1:n parameters)= c
"","","TS","chosen by the Kompiler.","","","FILE&MAIL","NA","FTP","MAIL","5000","1","0", "NA", "No"
const string (255) array help info(1:n parameters)= c
"Name of this station",
"Description of station",
"TS or NSI, or BASE if descriptor is just for a directory",
"Shortest acceptable name, if different from logical one",
"Station network address or PSS network base ( .END to stop adding addresses )",
"The front end we wish ( for the time being ) to confine the activity to",
"What services are available at the Station (ie FILE MAIL )",
"PSS table entry if relevant",
"The FTP 'called' field for the station ( TS only )",
"The Mail 'called' field extender ( TS only )",
"Default limit",
"Default lines",
"Station status ( 0 is full service, 1 is test station )",
"Route to host",
"Whether to send directory info to host ( reply No, Yes or All )"
! Help info for each parameter
string (6) owner
string (11) output file, default output file, list file, default list file
string (20) this full host
string (31) filename
string (255) find1, find string, line, line1, macro string, save string, dummy, dummy1
integer address, conad, count, current position, flag, flag1, flag2, i, j, len, pdesc, sign, temp cp, value,
work conad, macro, addr type, base type
byte integer name l
integer start position, end position
record format efhf(integer end, start, size, type, sp1, datetime, sp2, sp3, checkword, stations, sp4, sp5)
! EXT File header format
record (rf) r
record (efhf) name ext file header
!-------------------------------------------------------------------------------------------------------------------!
byte integer fn print out(integer type, string (255) line, integer address)
! Copies the string LINE to destination which is
!
! CONAD + ADDRESS if TYPE = 0
!
! WORK CONAD + ADDRESS otherwise
!
! Returns length of LINE as result.
! Sets FLAG = 1 if LINE won't fit into the insertfile and TYPE isn't 0
integer i, conad1
if type=0 then conad1 = conad else conad1 = work conad; ! Set absolute address
if address+length(line)>max desc size and type#0 then flag = 1 else start
! Check if LINE is too long - only if copying LINE to insertfile: LINE can't be too long otherwise
flag = 0
byteinteger(conad1+address+i-1) = charno(line, i) for i = 1, 1, length(line)
! Copy line
finish
result = length(line)
end ; ! of byteintegerfn PRINT OUT
!-------------------------------------------------------------------------------------------------------------------!
routine change no of devices
! Changes the first line ( the one that reads "Stations = 1 " or whatever ) to
! reflect the number of stations
integer dummy
string (3) temp
temp = itos(ext file header_stations); ! Convert to a string
temp = temp." " while length(temp)<3; ! Pad out to 3 characters in length
dummy = print out(0, temp, start position-5); ! Output to file
! START POSITION points to here ___
! |
! _________________|
! |
! V
! Stations = 1 **STATION = ... ( where * represents a NEWLINE character )
! A
! |___________________________________
! |
! so START POSITION - 5 points to here _________|
end ; ! of routine CHANGE NO OF DEVICES
!--------------------------------------------------------------------------------------------------------------!
routine change end position(integer by)
! Moves END POSITIOn and EXT FILE HEADER_END up or down by BY.
end position = end position+by
ext file header_end = ext file header_end+by
end ; ! of routine CHANGE END POSITION
!-------------------------------------------------------------------------------------------------------------------!
string fn padout(string (255) s, byte integer l)
s = s." " while length(s)<l
result = s
end { of padout }
!--------------------------------------------------------------------------------------------------------------!
byte integer fn upper(integer ch)
! Result is CH, unless CH is the code for a lower case character, in which case the result is
! the code for the equivalent upper case character.
if 'a'<=ch<='z' then result = ch-32 else result = ch
end ; ! of byteintegerfn UPPER
!-------------------------------------------------------------------------------------------------------------------!
routine print desc(integer address)
! Prints out a descriptor starting at CONAD + ADDRESS, and finishing on the next double newline
! ( which is also printed out ).
! Also informs the user if this is the first and/or the last descriptor .
integer i, ch, last ch
printstring("** First station **".snl.snl) if address=start position
! Inform user if this the first descriptor of a type.
address = conad+address; ! Change ADDRESS to absolute, instead of relative to the start of the file.
if byteinteger(address)=nl and byteinteger(address+1)=nl then c
printstring("** Last station **".snl.snl) else start
! Inform user if this is the last station. If not, print it out.
i = 0; ! Pointer
ch = ' '; ! Simulate 'last character'
cycle
last ch = ch
ch = byteinteger(address+i); ! Get next character
i = i+1
printsymbol(ch)
repeat until (ch=nl and last ch=nl) or address+i>=conad+ext file header_end
! Exit after printing a double newline, or off end of file
finish
end ; ! of routine PRINT DESC
!-------------------------------------------------------------------------------------------------------------------!
integer fn locate(integer direction, start, end, string (255) text)
! Searches for an occurrence of TEXT totally within the range START to END - 1, independant of case.
! If DIRECTION = 1, the search is conducted forwards ( finding the first occurrence ),
! if DIRECTION = -1, the search is conducted backwards ( finding the last occurrence ).
! If the length of TEXT is 0, a result of START is returned if DIRECTION = 1, or END if DIRECTION = -1.
! If END - START < length of TEXT, or DIRECTION isn't 1 or -1, or no match is found, the result
! returned is zero, otherwise the result is the ( absolute ) address of the first byte of the image.
integer len, address, i
len = length(text); ! Length of pattern
address = addr(text)+1; ! Start of pattern
end = end-len; ! From now on END represents the first byte of the last possible match of TEXT in the range.
i = 0; ! Pointer to which character of TEXT is being checked - 0 means the first, LEN-1 means the last.
if direction=1 start ; ! Forwards search
while i<len and start<=end cycle ; ! Exit if off end of TEXT ( match found ) or range ( no match ).
i = i+1 while upper(byteinteger(start+i))=byteinteger(address+i) and i<len
! Try to match TEXT - cycle through TEXT until a character doesn't fit, or there are no more to try.
start = start+1 and i = 0 if i<len; ! I < LEN implies no match found, so reset I ( search for first
! character again ) and increment START ( for next address ).
repeat
if i<len then result = 0 else result = start; ! I < LEN implies no match found ( result = 0 ),
! otherwise the result is the start of the image.
finish else start ; ! Backwards search
result = 0 unless direction=-1; ! Check DIRECTION was legal.
while i<len and start<=end cycle ; ! as above
i = i+1 while upper(byteinteger(end+i))=byteinteger(address+i) and i<len
! Match starts at END of range instead of START.
end = end-1 and i = 0 if i<len; ! Reset I and decrement END ( for next try ) if no match found.
repeat
if i<len then result = 0 else result = end
finish
end ; ! of integerfn LOCATE
!-------------------------------------------------------------------------------------------------------------------!
byte integer fn ch
! Result is code of last character of LINE, unless length of LINE is 0, in which case the result is 0.
if l=0 then result = 0 else result = charno(line, l)
end ; ! of byteintegerfn CH
!-------------------------------------------------------------------------------------------------------------------!
routine read value
! Reads a number off the end of LINE. If the first character ( last character of LINE ) is a '-', SIGN is
! set to -1, otherwise SIGN is set to 1. If the next character is '*' ( meaning "as much as possible" ),
! VALUE is set to the maximum number of devices for the current type. If the next character
! is non-numeric, a default of 1 is assumed, otherwise an integer value ( up to 4 digits ) is
! read off the end of LINE into VALUE.
string (4) temp
if ch='-' then l = l-1 and sign = -1 else sign = 1; ! Sign of value
if ch='*' then l = l-1 and value = max stations else start
temp = ""
while l>0 and '0'<=ch<='9' and length(temp)<5 cycle ; ! Exit if off the end
! of LINE, next character isn't a digit, or TEMP is too long.
temp = temp.tostring(ch); ! Add character to TEMP.
l = l-1; ! Decrement length of LINE
repeat
temp = "1" if temp=""; ! Default is 1
value = pstoi(temp); ! Convert to integer
finish
end ; ! of routine READ VALUE
!-------------------------------------------------------------------------------------------------------------------!
routine read command(string (255) name s)
! Reads a line from the terminal, and stores it back to front in S ( this makes it easier to change the
! line after executing one command : all that is needed is L = L - 1 instead of
! LINE = SUBSTRING ( LINE, 2, L - 1 )
! Ignores spaces unless inside delimiters ("/").
! Line stops at NEWLINE ( and doesn't include it ) or when its length is 255.
! All characters are converted to upper case, even those in delimiters since any search is case independant.
! If a line ends after an odd number of delimiters, it is rejected and another is entered.
! NB 2 delimiters in a row ( ...//... ) would be included as one delimiter in the search string,
! and also this doesn't change the parity of the number of delimiters, so only the parity of
! DELIMIT needs to be checked.
integer symbol, delimit
start:
s = ""
delimit = 0; ! No delimiters yet
cycle
readsymbol(symbol)
exit if symbol=nl; ! Newline terminates command.
delimit = delimit!!1 if symbol=delimiter; ! Change parity of DELIMIT if a delimiter is found.
continue if symbol=' ' and delimit=0; ! Ignore a space unless inside delimiters.
s = tostring(upper(symbol)).s; ! Add to beginning of line.
repeat until l=255; ! Exit if S maximum length.
printstring("Must be an even number of delimiters ( / )".snl) and ->start unless delimit=0
! S must have an even number of delimiters.
end ; ! of routine READ COMMAND
!-------------------------------------------------------------------------------------------------------------------!
routine read line
! Inputs LINE1 from terminal, ignoring any spaces.
! LINE1 is terminated by a newline ( which isn't included ) or when its length is 200.
integer ch
line1 = ""
cycle
readsymbol(ch)
exit if ch=nl
line1 = line1.tostring(ch); ! Add to line
repeat until length(line1)=200
end ; ! of routine READ LINE
!--------------------------------------------------------------------------------------------------------------!
integer fn parm(integer param no, string (255) in, string (*) name out)
! Sets string OUT to a valid parameter to be put into file. IN is the response typed to a prompt
! ( eg Name: ), PARAM NO is the number of the parameter ( 1-13 )
out = ucstring(parameter names(param no))." = ".in.snl
result = length(out)
end ; ! of integerfn PARM
!--------------------------------------------------------------------------------------------------------------!
string fn get a param(integer param no, integer name flag)
! Gets a parameter input from the terminal. Prints out the default for the parameter if there is one,
! then prompts with the name of the parameter. If the response is ?, prints out some help info
! then asks for another input. If parameter can take multiple inputs ( eg Address: )
! inputs several parameters and concatenates them, till the response
! .END is reached, or 16 inputs have been entered. If a null line is entered, and this
! parameter has a default, the result is null and FLAG is set to 1. If a * is entered, and this
! and all the following parameters have defaults, the result is null and FLAG is set to 2
! ( leave rest of descriptor as defaulted ). If a null line or * is entered, and these conditions
! aren't satisfied, another input is requested. If neither of these has been input, the line is
! PARMed ( with fn PARM ).
! If .END is entered when multiple inputs aren't allowed, the line is taken as a null line.
string (255) dummy
integer limit
string (*) fn no spaces(string (255) s)
string (255) one, two
s = one.two while s->one.(" ").two
result = s
end { of NO SPACES }
dummy = ""
flag = 0
limit = 1+template(addr type, param no)>>4; ! Max no of multiple inputs if allowed
prompt(parameter names(param no).":")
count = 0; ! for multiple inputs
cycle
printstring("Default for ".parameter names(param no)." is ".descriptor defaults(param no).snl) unless c
template(addr type, param no)&default=0
! Print default if there is one
read line
if line1="?" start ; ! Help info
printstring(help info(param no).snl)
continue ; ! Get more input
finish
if ucstring(line1)=".END" start
if count=0 then line1 = "" else exit
! Simulate "accept default" if this is first input
finish
printstring(parameter names(param no)." does not have a default".snl) and continue if c
(line1="" or line1="*") and template(addr type, param no)&default=0
! User tried to use default when there wasn't one.
printstring("More obligatory parameters to come".snl) and continue if c
line1="*" and template(addr type, param no)&exit=0
! User tried to exit from this descriptor when there were more obligatory descriptors to come
if line1="" then flag = 1 and exit
if line1="*" then flag = 2 and exit
printstring("Parameter too long".snl) and continue if length(dummy)+parm(param no, line1, dummy1)>255
! Check parameter won't overflow ( especially with multiple inputs )
if param no=3 start
if ucstring(no spaces(line1))="NSI" then addr type = 1 else if c
ucstring(nospaces(line1))="BASE" then base type = yes
finish
dummy = dummy.dummy1; ! DUMMY1 set by PARM
exit if template(addr type, param no)&multiple=0 or count=limit-1; ! if only single input allowed
! or if maximum number of inputs reached.
count = count+1; ! Increment number of inputs so far
repeat
result = dummy
end ; ! of stringfn GET A PARAM
!------------------------------------------------------------------------------------------------------------!
integer fn compile config(string (11) output file)
!***********************************************************************
!* *
!* Purpose of this routine is to read in a spooler configuration file *
!* which is in text format and create a file for passing on to the *
!* spooler process as a data base. If result = 0 then the read was *
!* successful, if not it wasn't. *
!* *
!***********************************************************************
const string (0) null= ""
const integer max lines= 25
const integer pointer size= 19*4 + max fsys+1 + 2*64 + 4 + 4*(1+hash length)
! Size of POINTERS record
const integer file header size= 32
const integer read permission= 1
const integer link list entries= 1000
const integer link list entry size= 32
const integer displacement= file header size + pointer size + link list entries *link list entry size
! Displacement of Stations from start of file
const integer stream entry size= 192; !Number of bytes in a stream descriptor
const integer queue entry size= 148
const integer station entry size= 512; ! Number of bytes in a station descriptor
const integer string space size= 376
const integer expanded addresses size= 20
const integer ftp table entry size= 618
const string (11) temp output file= "T#CFILE"; ! Name of temporary file created
const string (15) array stnd(1:n parameters)= c
"NAME=",
"DESCRIPTION=",
"ADDRTYPE=",
"SHORTNAME=",
"ADDRESS=",
"FEP=",
"SERVICES=",
"PSSNO=",
"FTP=",
"MAILSUFFIX=",
"LIMIT=",
"LINES=",
"STATUS=",
"MROUTE=",
"MUPDATE="
const byte integer array stndt(1:n parameters)= c
255, 255, 4, 15, 255, 0, 255, 0, 255, 255, 0, 0, 0, 255, 3
const string (27) mr legal chars 1= "ABCDEFGHIJKLMNOPQRSTUVWXYZ*"
const string (40) mr legal chars 2= "ABCDEFGHIJKLMNOPQRSTUVWXYZ*0123456789-.%"
record format pointers f(integer link list displ, ftp table displ, queues, queue entry size, queue displ,
queue name displ, streams, stream entry size, stream displ, hash len, spare1, spare2,
spare3, stations, station entry size, station displ, control entry,
station addresses displ, guest entry, byte integer array discs(0:max fsys), string (63) dead letters,
this full host, integer expanded address displ, integer array hash t(0:hash length))
! Format of pointers record at start of file
record format fhf(integer end, start, size, type, spare, datetime, half integer queues, remotes, streams,
stations)
record format pe(integer dest, srce, p1, p2, p3, p4, p5, p6)
!
recordformat line f(string (15) name, string (7) unit name,
string (6) user, byteinteger parity,
integer status, bytes sent, bytes to go, block, part blocks,
document, integer bin offset, byteinteger service, user abort, unit size, fep,
integer abort retry count, offset, station ptr,
integerarray ispare(0:2),
integer data transfer start {for timing the transfer},account,
integer in comms stream, out comms stream,
integer in stream ident, out stream ident,
integer transfer status, tcc subtype,
in block addr, out block addr,
byteinteger activity, station type, spb2, suspend,
in stream status, out stream status,
timer, output buffer status, output transfer pending,
new FTP data record, byteintegerarray bspare(0:9),
integer aux document, pre abort status, bytes transferred,
record (pe) output transfer record)
!*
!*
!*
!*
record format queuef(string (15) name, (half integer array ftp lines(0:15) or c
half integer array lines(0:15)), string (7) default user, string (31) default delivery,
integer default start, default priority, default time, default output limit, default forms, default mode,
default copies, default rerun, length, head, max length, maxacr, half integer q by, general access,
integer resource limit, amount)
record format station f(byte integer max lines , byte integer status,
byte integer service , byte integer connect retry ptr, fep, address type, services,
byte integer q lines , integer limit , integer last call, last response,
system loaded, connect attempts,
connect retry time, integer array ispare(0:4), integer seconds, bytes, integer last q response by us,
p transfers, q transfers, p kb, q kb, p mail, q mail, integer name, shortest name,
integer array address(1:4), integer pss entry, mail, ftp, description, route, integer flags,
byte integer array string space(0:string space size-1))
record format compf(integer link, host entry, alt, string (63) c)
record format name f(integer link, host entry, string (255) name)
record format exp addr f(integer type, integer array ad(1:4))
byte integer array x(1:worksize)
record (compf) name comp
record (name f) name name entry
string (63) this authority, this host
integer freetop, top level, alt link, end comp
integer worktop, size, n pt
system routine spec permit(string (31) file, string (6) user, integer mode, integer name flag)
record (exp addr f) array format exp addr af(1:max stations)
record (exp addr f) array name expanded address
record (fhf) name file header
record (line f) name stream entry
record (queue f) name queue entry
record (station f) name station entry
record (line f) default stream entry
record (station f) default station entry
record (pointers f) name pointers
string (255) line, temps, temp1, temp2
own string (255) ns1
integer text pointer, text end, flag, i, j, k, value, o f conad, config size, stations, result, address pt,
string pt, default string pt
switch stnswt(1:n parameters)
!--------------------------------------------------------------------------------------------------------------!
routine ftf(string (255) s)
printstring("Failed to find ".s.snl)
return
end { of ftf }
!--------------------------------------------------------------------------------------------------------------!
string fn station string(integer d)
result = string(addr(station entry_string space(d)))
{ empty strings mapped onto first byte of space which is zero, so = "" }
end { of station string }
!--------------------------------------------------------------------------------------------------------------!
integer fn set string(string (255) s)
integer res
res = string pt
string(addr(station entry_string space(string pt))) = s
string pt = string pt+1+length(s)
if string pt>string space size then printstring("String space exceeded".snl) and result = 1
result = res
end { of set string }
!--------------------------------------------------------------------------------------------------------------!
routine read line(integer parm no)
!***********************************************************************
!* *
!* Reads a line of text terminated by a newline. Returns a newline *
!* if first character is newline ( blank line ). Skips leading *
!* newlines and spaces after this ( any number of blank lines is *
!* interpreted as just one ). Ignores spaces except in comments. *
!* Exits if text pointer = text end ( end of file ). Returns a *
!* null line if at end of file. Ignores rest of line if length > *
!* 255 characters. FLAG must be 1 on entry ( 'last line has been *
!* used' ). Sets FLAG to 0 ( 'line not yet used' ). *
!* *
!***********************************************************************
integer sym, uc
return if flag=0; ! If last line not yet used
uc = 0
line = null
flag = 0; ! This line not yet used
line = snl if byteinteger(text pointer)=nl and text pointer<text end; ! Return SNL
! if this is a blank line ( to distinguish against 'end of file' )
text pointer = text pointer+1 while c
text pointer<text end and (byteinteger(text pointer)=' ' or byteinteger(text pointer)=nl)
! Skip leading newlines and spaces
return if text pointer=text end or line=snl; ! If end of file reached, or this line is blank
sym = byteinteger(text pointer); !Read a symbol
text pointer = text pointer+1; ! And skip over it
while sym#nl and text pointer<text end cycle ; ! until end of line or file
if sym='=' and parm no=2 then uc = 1 { ie in DESCRIPTION parameter, and after '=' }
sym = sym-32 if 'a'<=sym<='z' and uc<2; ! Convert to upper case
line = line.to string(sym) unless (sym=' ' and uc<2) or length(line)=255
! No spaces except within description . Make sure line doesn't overflow
if sym=' ' and uc=1 then uc = 2
sym = byteinteger(text pointer); ! Get a symbol
text pointer = text pointer+1; ! and skip over it
repeat
end ; ! Of routine READ LINE
!--------------------------------------------------------------------------------------------------------------!
string fn expand address(string (127) original)
string (127) new string, workstring
integer fn all numeric(string (127) s)
integer i
cycle i = 1, 1, length(s)
result = no unless '0'<=charno(s, i)<='9'
repeat
result = yes
end
newstring = ""
cycle
exit if original=""
unless original->workstring.(".").original then workstring = original and original = ""
if newstring#"" then newstring = newstring."."
newstring = newstring.workstring and continue if all numeric(workstring)=no
if length(workstring)=12 then newstring = newstring.workstring."00" and continue
if length(workstring)<12 start
workstring = "0".workstring while length(workstring)#12
workstring = workstring."00"
finish
newstring = newstring.workstring
repeat
result = newstring
end
!--------------------------------------------------------------------------------------------------------------!
string fn shortest name(integer host entry)
integer min comps, i, j, link
record (name f) name name entry
string (63) sh name
string (63) array component(1:20, 1:2)
integer fn n comps(string (63) name)
integer i
string (63) s1, s2
i = 1
i = i+1 and name = s1.s2 while name->s1.(".").s2
result = i
end { of n comps }
routine get comps(string (63) name, integer dim)
integer i
cycle i = 1, 1, 20
exit if name=""
unless name->component(i, dim).(".").name start
component(i, dim) = name
name = ""
finish
repeat
end { of get comps }
min comps = 21
sh name = ""
cycle i = 0, 1, hash length
link = pointers_hash t(i)
while link#-1 cycle
name entry == record(o f conad+link)
if name entry_host entry=host entry start
if n comps(name entry_name)<min comps start
sh name = name entry_name
min comps = n comps(sh name)
get comps(sh name, 1)
finish else if n comps(name entry_name)=min comps start
get comps(name entry_name, 2)
cycle j = 1, 1, min comps
if length(component(j, 2))>length(component(j, 1)) then exit
if length(component(j, 2))<length(component(j, 1)) start
sh name = name entry_name
get comps(sh name, 1)
exit
finish
repeat
finish
finish
link = name entry_link
repeat
repeat
result = sh name
end { of shortest name }
!--------------------------------------------------------------------------------------------------------------!
routine fail(string (255) s)
printstring("Fails - ".s.snl)
result = 1
end ; !of fail
integer fn new comp rec
record (compf) name comp
integer ad
ad = freetop
freetop = freetop+76
if freetop>worktop then fail("Work space exceeded") and result = top level
comp == record(ad)
comp = 0
result = ad
end { of new comp rec }
integer fn hashed(string (63) name)
integer i, pt, n, h
byte integer array x(0:15)
const byte integer array prime(1:7)= 23, 19, 11, 7, 5, 13, 17
pt = (addr(x(7))>>3)<<3
longinteger(pt) = 0
n = addr(name)
byteinteger(pt+i&7) = byteinteger(pt+i&7)!!byteinteger(n+i) for i = 0, 1, length(name)
h = length(name)*29
h = h+prime(i)*byteinteger(pt+i) for i = 1, 1, 7
result = h&hashlength
end ; !of hashed
routine add hash(integer host entry, string (63) name)
integer ad, h
name -> (".").name
if charno(name,length(name))='.' then length(name) = length(name)-1
h = hashed(name)
ad = n pt
n pt = (n pt+8+1+length(name)+3)&(¬3)
name entry == record(ad)
name entry_link = pointers_hash t(h)
pointers_hash t(h) = ad-o f conad
name entry_host entry = host entry
name entry_name = name
{***}printstring(name." Host=".itos(host entry).snl)
end { of add hash }
routine generate names(integer link, string (63) h)
record (compf) name comp
if link#0 start
comp == record(link)
while comp_alt#0 cycle
if comp_host entry#0 then add hash(comp_host entry, h.".".comp_c)
generate names(comp_link, h.".".comp_c)
comp == record(comp_alt)
repeat
finish
end { of generate names }
integer fn process name(string (255) hname, integer host entry)
integer type, pt, end, act
string (63) str, extra, c, pref name
byte integer array t(1:20)
string (63) array tv(1:20)
integer tokens, tok
switch sw(1:9)
const integer single comp=3
const integer alt start=4
const integer next alt=7
const integer alt end=6
const integer error=8
const integer part complete=5
const integer all complete=2
integer fn last component
integer i
for i = tok+1, 1, tokens cycle
if t(i)=single comp or t(i)=alt start then result = no
if t(i)=part complete or t(i)=all complete then result = yes
repeat
result = 0
end ; !of last component
routine add name(string (63) c)
comp == record(comp_alt) while comp_alt#0
comp_c = c
comp_alt = new comp rec
if last component=yes then comp_host entry = host entry
end { of add name }
integer fn search(string (63) c)
cycle
if comp_c=c then result = found
if comp_alt=0 then result = not found
comp == record(comp_alt)
repeat
end { of search }
integer fn next token
integer cl, char
switch ac(0:9)
const byte integer array class(0:127)= c
7(32), 5, 7(7), 2, 3, 7(2), 4, 1, 6, 7, 1(10), 7(7), 0(26), 7(37)
const byte integer array actionstate(0:8, 0:5)= c
16_11, 16_11, 16_42, 16_8f, 16_8f, 16_00, 16_8f, 16_8f, 16_20, {scanning}
16_11, 16_11, 16_8f, 16_8f, 16_35, 16_01, 16_30, 16_8f, 16_30, {building name}
16_13, 16_13, 16_8f, 16_74, 16_72, 16_02, 16_8f, 16_8f, 16_8f, {scanning alt}
16_13, 16_13, 16_8f, 16_74, 16_72, 16_03, 16_8f, 16_8f, 16_8f, {building alt}
16_8f, 16_8f, 16_8f, 16_8f, 16_65, 16_04, 16_60, 16_8f, 16_60, {end alt}
16_90, 16_90, 16_90, 16_90, 16_90, 16_90, 16_90, 16_90, 16_90 {after end alt}
! letter dig- ( ) , sp . rest end
! elements 1,0 & 1,2 changed from 8f to allow numerics (like 2972) meantime
str = ""
cycle
pt = pt+1
if pt>end then cl = 8 else char = byteinteger(pt)&255 and cl = class(char)
act = actionstate(cl, act&15)
->ac(act>>4)
ac(0):
!do nothing
continue
ac(1):
!start building name
str = str.tostring(char)
continue
ac(2):
!return end of line
ac(3):
!return name
ac(4):
!return construct
ac(5):
!return end of name
ac(6):
!end of alternatives
ac(7):
!return alternative
ac(8):
!error
result = act>>4
ac(9):
!rescan char
pt = pt-1
result = 5
repeat
end ; !of next token
cycle
extra = ""
type = 0; act = 0
pt = addr(hname)
end = pt+length(hname)
tokens = 0
cycle
tokens = tokens+1
t(tokens) = next token
tv(tokens) = str
if t(tokens)=error or t(tokens)=all complete then exit
repeat
tok = 0
end comp = 0
cycle
pref name = ""
comp == record(top level)
cycle
tok = tok+1
c = tv(tok)
->sw(t(tok))
sw(single comp):
pref name = pref name.".".c
if search(c)=found start
if last component=yes then fail("Duplicate name ".pref name) and result = not ok
comp == record(comp_link)
finish else start
add name(c)
if last component=yes and 0#endcomp#addr(comp) then comp_link = end comp c
else comp_link = new comp rec
comp == record(comp_link)
finish
continue
sw(alt start):
comp == record(comp_alt) while comp_alt#0
alt link = new comp rec
if tv(tok+1)#"" then pref name = pref name.".".tv(tok+1)
continue
sw(next alt):
add name(c)
comp_link = alt link
comp == record(comp_alt)
continue
sw(alt end):
comp == record(alt link)
continue
sw(error):
fail("Parsing error in ".hname)
result = not ok
sw(part complete):
end comp = addr(comp)
sw(all complete):
if station entry_name=0 start
station entry_name = set string(substring(pref name, 2, length(pref name)))
finish
exit
repeat
if pref name->(this authority.".").hname and hname#"" start
if extra#"" then extra = extra.","
extra = extra.hname
finish
if t(tok)=all complete then exit
repeat
if extra="" then exit
hname = extra
repeat
result = ok
end ; !of process name
routine set flags(string (255) name, integer flag)
integer i
integer fn lookup hasht(string (63) name)
record (name f) name name entry
integer h
h = hashed(name)
if pointers_hasht(h)#-1 start
name entry == record(of conad+pointers_hasht(h))
cycle
if name=name entry_name then result = name entry_host entry
exit if name entry_link=-1
name entry == record(of conad+name entry_link)
repeat
finish
result = 0
end ; !of lookup hasht
i = lookup hasht(name)
if i=0 then fail("No match for auth/host ".name) else start
station entry == record(of conad+pointers_station displ+(i-1)*station entry size)
station entry_flags = station entry_flags!flag!local host flag
finish
end ; !of set flags
!--------------------------------------------------------------------------------------------------------------!
result = 2; ! Not successful ( or unsuccessful ) as yet
stations = 0
default stream entry = 0; ! Clear to zeroes
station entry == default station entry
string pt = 1
station entry = 0; ! Clear to zeroes
station entry_address type = 2 { TS }; ! Defaults for stations
station entry_services = file service ! mail service
station entry_ftp = set string("FTP")
station entry_mail = set string("MAIL")
station entry_limit = 5000
station entry_last response = -1
station entry_last q response by us = -1
station entry_max lines = 1
default string pt = string pt
text pointer = conad+ext file header size; !Addr of first byte (used by read line)
text end = conad+end position; !Addr of last byte + 1 (used by read line)
config size = displacement+queue entry size+max lines*stream entry size+max stations* c
(station entry size+expanded addresses size)+(max lines+1)*ftp table entry size+128000
{ for names of stations from hash table }
! Max possible size
if exist(temp output file)#0 start
disconnect(temp output file, flag)
destroy(temp output file, flag)
finish else flag = 0
if flag=0 start
outfile(temp output file, config size, 0, 0, o f conad, flag)
if flag=0 start ; !Successfully created config file
freetop = (addr(x(1))+3)&(¬3)
worktop = freetop+work size
top level = new comp rec
this host = this full host
size = 0
cycle i = 1, 1, length(this host)
if charno(this host, i)='.' start
size = size+1
if size=3 then this authority = substring(this host, 1, i-1) and exit
finish
repeat
if size#3 then fail("Bad value for this host")
file header == record(o f conad); ! Map file header
pointers == record(o f conad+file header size); ! and POINTERS record
pointers_link list displ = file header size+pointer size
pointers_hash len = hash length
flag = 1 and read line(0)
result = 1 and ftf("IPL discs") and ->error unless line->("IPLDISCS=").temps
pointers_discs(i) = 0 for i = 0, 1, max fsys
while temps#null cycle
temp1 = temps and temps = null unless temps->temp1.(",").temps
j = pstoi(temp1)
result = 1 and printstring("Illegal IPL disc ".temp1.snl) and ->error unless 0<=j<=max fsys
pointers_discs(j) = 1
repeat
flag = 1 and read line(0)
if line->("UPDATE=").temps start
while temps#null cycle
temp1 = temps and temps = null unless temps->temp1.(",").temps
j = pstoi(temp1)
if 0<=j<=max fsys then pointers_discs(j) = pointers_discs(j)!2 else c
result = 1 and printstring("Illegal disc for update : ".temp1.snl) and ->error
repeat
finish else ftf("update") and ->error
flag = 1 and read line(0)
if line->("THISHOST=").temps then pointers_this full host <- temps else ftf("This host") and ->error
flag = 1 and read line(0)
if line->("DEADLETTERS=").temps then pointers_dead letters <- temps else c
ftf("Dead letters") and ->error
!MAKE THE QUEUE SPACE.
pointers_queue displ = displacement
queue entry == record(o f conad+pointers_queue displ)
queue entry_default user = "FTRANS"
queue entry_default delivery = "SPOOLED File Transfer"
queue entry_default start = 32
queue entry_default priority = 3
queue entry_max length = 1000
queue entry_max acr = 15
queue entry_resource limit = 1000
!* stream input section
pointers_streams = max lines
pointers_stream displ = pointers_queue displ+queue entry size
pointers_stream entry size = stream entry size
cycle i = 1, 1, max lines; ! Round each stream
stream entry == record(o f conad+pointers_stream displ+(i-1)*stream entry size)
! Map stream entry
stream entry = default stream entry; ! Set defaults
stream entry_name = "FT".itos(i)
repeat
!* Station input section
flag = 1 and read line(0) until line->ns1.("STATIONS=").temps or line=null
! Read lines til no of stations found or end of file reached
flag = 1; ! This line now used
if line#null and ns1=null start ; ! Is it no of stations ?
temps = temp1 if temps->temp1.("!").temp2; ! Remove comments
stations = pstoi(temps)
if 1<=stations<=max stations start ; ! Valid no of stations ?
pointers_stations = stations+2 { for guest and operational control }
pointers_station displ = (pointers_stream displ+max lines*stream entry size+511)&(~(511))
pointers_expanded address displ = pointers_station displ+pointers_stations*station entry size
pointers_station addresses displ = pointers_expanded address displ+pointers_stations*expanded addr c
esses size
! Set POINTERS entries
pointers_station entry size = station entry size
address pt = 1
expanded address == array(o f conad+pointers_expanded address displ, exp addr af)
cycle i = 1, 1, stations; ! Round each station
string pt = default string pt
station entry == record(o f conad+pointers_station displ+(i-1)*station entry size)
expanded address(i)_type = station entry_address type { default }
! Map station entry
station entry = default station entry; ! Set defaults
cycle j = 1, 1, n parameters; ! For each parameter
read line(j)
flag = 1 and read line(j) while j=1 and line=snl; ! Remove blanks before descriptor
flag = 1 and exit if line=null or line=snl; ! End of file or this descriptor ?
if line->ns1.(stnd(j)).temps and ns1=null start ; ! For this param ?
temp2 = null unless temps->temps.("!").temp2; ! Remove comments
->nextstn if temps="NA" or temps="NOTAPPLICABLE"; ! Ignore if NA
if stndt(j)=0 start ; ! Numeric
value = pstoi(temps)
printstring("Invalid parameter".snl) and ->failstn if value<0
finish else start
printstring("String wrong size".snl) and ->failstn unless 1<=length(temps)<=stndt(j)
finish
->stnswt(j)
stnswt(1):
! Name of station
->failstn unless process name(temps, i)=ok
->nextstn
stnswt(2):
! The description of the station.
if temps->("!").temp2 then temps = temp2
station entry_description = set string(temps)
->nextstn
stnswt(3):
! The type of addressing for this FTP station, ie TS or NSI access
! If temps is "BASE", this descriptor is not a host, but a directory
if temps="BASE" then station entry_status = 9 C
and station entry_services = 0 and station entry_address type = 3 else c
if temps="TS" then station entry_address type = 2 else station entry_address type = 1
expanded address(i)_type = station entry_address type
->nextstn
stnswt(4):
! Shortest name
station entry_shortest name = set string(temps)
->nextstn
stnswt(5):
! Station network address or PSS network base
cycle
cycle k = 1, 1, 4; ! Try to find an empty member of ADDRESS
if station entry_address(k)=0 then ->stn out
! Found a space
repeat ; ! If this comment is reached, ADDRESS array is full
printstring("Too many address ( 4 max )".snl)
->failstn
stn out:
station entry_address(k) = address pt
string(o f conad+pointers_station addresses displ+address pt) = temps
address pt = address pt+1+length(temps)
temps = expand address(temps)
expanded address(i)_ad(k) = address pt
string(o f conad+pointers_station addresses displ+address pt) = temps
address pt = address pt+1+length(temps)
! Check for multiple addresses
flag = 1
read line(j); ! Get next line
exit unless line->ns1.(stnd(j)).temps and ns1=null
! ie unless there is another address
temps = temp1 if temps->temp1.("!").temp2; ! Remove comments
repeat ; ! Now go back to STN SWT ( 5 ) to do next address
exit if line=null or line=snl; ! ie if out of this station or of file
->nextstn1; ! Don't set FLAG to 1, since next line has already been read
stnswt(6):
! The front end we wish ( for the time being ) to confine the activity to
station entry_fep = value
->nextstn
stnswt(7):
!The services offered by the external station.
station entry_services = 0
if temps -> temp1.("FILE").temp2 then station entry_services = file service
if temps -> temp1.("MAIL").temp2 then station entry_services = c
station entry_services ! mail service
->nextstn
stnswt(8):
! The PSS table entry if relevant
station entry_pss entry = value
->nextstn
stnswt(9):
! The FTP 'called' field for the station ( TS only )
station entry_ftp = set string(temps) unless station entry_address type=1
->nextstn
stnswt(10):
! The MAIL 'called' field extender ( TS only )
station entry_mail = set string(temps) unless station entry_address type=1
->nextstn
stnswt(11):
! Default limit
station entry_limit = value
->nextstn
stnswt(12):
! Default lines
if value>255 then printstring("Value must be <= 255".snl) and ->failstn else c
station entry_max lines = value
->nextstn
stnswt(13):
! The station status ( 0 is full service, 1 is test station )
station entry_status = value
->nextstn
stnswt(14):
! Route
->failstn unless mr legal chars 1->(substring(temps, 1, 1))
cycle k = 2, 1, length(temps)
->failstn unless mr legal chars 2->(substring(temps, k, k))
repeat
station entry_route = set string(temps)
station entry_flags = station entry_flags!route flag
->nextstn
stnswt(15):
! update
if temps="YES" then station entry_flags = station entry_flags!update flag else if c
temps="ALL" then station entry_flags = station entry_flags!update copy flag else c
unless temps="NO" then ->failstn
->nextstn
finish
continue unless j=n parameters; ! Not for this parm. Try next if any left
failstn:
result = 1; ! Definitely unsuccessful
printstring("Descriptor ".itos(i)." ".station string(station entry_name)." Parameter ".stnd c
(j)." wrong : ".line.snl)
nextstn:
flag = 1; ! This line now dealt with
nextstn1:
repeat ; ! Each parameter
exit if line=null; ! End of file
repeat ; ! Each descriptor
pointers_guest entry = pointers_stations-1
pointers_control entry = pointers_stations
station entry == record(o f conad+pointers_station displ+stations*station entry size)
station entry = default station entry
string pt = 1
station entry_name = set string("GUEST")
station entry_shortest name = set string(station string(station entry_name))
station entry_max lines = 4
station entry_status = 6
station entry == record(o f conad+pointers_station displ+(stations+1)*station entry size)
station entry = default station entry
string pt = 1
station entry_name = set string("CONTROL DUMMY")
station entry_shortest name = set string(station string(station entry_name))
station entry_max lines = 2
station entry_q lines = 1
station entry_limit = 128
station entry_service = closed
station entry_status = 6
{ put in GUEST and operational control record }
error:
finish else printstring("Invalid no of stations :".line.snl)
finish else printstring("Failed to find no of stations".snl)
!* at this point a config file is created
pointers_hash t(i) = -1 for i = 0, 1, hash length
pointers_ftp table displ = pointers_station addresses displ+address pt
n pt = o f conad+pointers_ftp table displ+(max lines+1)*ftp table entry size
generate names(top level, "")
cycle i = 1, 1, pointers_stations
station entry == record(o f conad+pointers_station displ+(i-1)*station entry size)
string pt = 1
string pt = string pt+1+byteinteger(addr(station entry_string space(string pt))) while c
byteinteger(addr(station entry_string space(string pt)))#0
if station string(station entry_name) -> (this authority).temps then c
station entry_flags = station entry_flags!local host flag
if station entry_shortest name = 0 start
temp1 = shortest name(i)
if length(temp1) > 15 then printstring("SHORTEST NAME too long : ".temp1.snl) and result = 1
station entry_shortest name = set string(temp1)
finish
repeat
set flags(this authority, this auth flag)
set flags(this host, this host flag)
file header_end = n pt-o f conad
! Actual size
file header_type = 0
disconnect(temp output file, flag)
if flag=0 start
if stations>0 start ; ! Make sure something in it
trim(temp output file, flag)
if flag=0 start ; ! Successfully trimmed
rename(temp output file, output file, flag)
newgen(temp output file, output file, flag) if flag=already exists
if flag=0 start ; ! Rename / Newgen successful
permit(output file, null, read permission, flag)
if flag=0 start
result = 0 if result=2; ! ie if it has not been set as 'unsuccessful'
finish else print string("Set EEP on ".output file." fails ".failure message(flag).snl)
finish else start
print string("Rename/Newgen ".output file." fails ".failure message(flag).snl)
destroy(temp output file, flag); ! To tidy up
print string("Destroy ".temp output file." fails ".failure message(flag).snl) unless flag=0
finish
finish else print string("Trim ".temp output file." fails ".failure message(flag).snl)
finish else print string("No Stations in configuration file".snl)
finish else print string("Disconnect ".temp output file." fails ".failure message(flag).snl)
finish else printstring("Create and connect ".temp output file." fails ".failure message(flag).snl)
finish else printstring("Disconnect/Destroy ".temp output file."fails ".failure message(flag).snl)
print string("Failed to compile config".snl) unless result=0; ! unless got to 'centre' of this section
result = result
end ; ! Of integerfn COMPILE CONFIG
!--------------------------------------------------------------------------------------------------------------!
routine print defaults
integer i, j
cycle i = 1, 1, 2
printstring("Defaults for ")
if i=1 then printstring("NSI are :".snl) else printstring("TS ( the default address type ) are :".snl)
cycle j = 1, 1, n parameters
if template(i, j)&ignore=0 and j#3 start
printstring(parameter names(j)." : ")
if template(i, j)&default=0 then printstring("No default".snl) else c
printstring(descriptor defaults(j).snl)
finish
repeat
newline
repeat
end { of PRINT DEFAULTS }
!--------------------------------------------------------------------------------------------------------------!
integer fn execute command
! Executes COMMAND ( I ). If command was a successful END command, result is 1,
! ABORT gives result = 2. Illegal command ( eg X-1 ) gives result of -1, unsuccessful
! command ( eg String not found with F, or Insert got a Descriptor too large or No more devices )
! gives -2, otherwise result is 0.
integer i1, j1, a of p, rel a of p, old l of p, new l of p, old len, limit, ign
switch command swt(1:no of commands)
->command swt(i)
command swt(1):
! Help
printstring(snl." ? = Help, at any time F/text/ = Find 'text' ( forwards ),".snl)
printstring("U? = Display current macro, F-/text/ = Find 'text' ( backwards ),".snl)
printstring(" U = Set up user-defined macro F = Find last used 'text',".snl)
printstring(" ( can't contain U,X,A,E,K ) F- = Find last 'text' backwards,".snl)
printstring("Xn = Execute macro n times, F? = Display current 'text',".snl)
printstring(" ! = Print out defaults, Mn = Move by n descriptors,".snl)
printstring("In = Insert n descriptors, K/file/ = Kompile to file, end if OK,".snl)
printstring("Dn = Delete n descriptors, A = Abort,".snl)
printstring("Cn = Change n descriptors, E = End,".snl)
printstring("Pn = Print n descriptors, L/file/ = List to file,".snl)
printstring(" T = Change top of file ( for mailer ).".snl.snl)
printstring("When inserting, <return> leaves this parameter as defaulted,".snl)
printstring(" * leaves this and all following parameters as defaulted.".snl)
printstring("When changing, <return> leaves this parameter as set,".snl)
printstring(" * leaves this and all following parameters as set,".snl)
printstring(" ! sets this parameter to the default.".snl)
result = 0
command swt(2):
! Print out n descriptors
read value; ! Get number to print out
printstring("Invalid parameter for Print".snl) and result = -1 if value=0; ! Can't print out 0 descriptors
temp cp = current position; ! Take a copy of CURRENT POSITION to work with
if sign<0 start ; ! To print out last n descriptors, move back n descriptors, then print out n.
cycle i1 = 1, 1, value; ! Same as Move backwards
address = locate(backwards, conad+start position-2, conad+temp cp-2, snl.snl)
value = i1-1 and exit if address=0; ! Change number to print out if found top of list prematurely
temp cp = (address-conad)+2; ! Change to relative address and skip over double newline
repeat
finish
cycle i1 = 1, 1, value
print desc(temp cp)
address = locate(forwards, conad+temp cp, conad+end position, snl.snl)
! Find next descriptor
exit if address=0; ! Exit if there isn't one
temp cp = (address-conad)+2; ! Convert to a relative address and skip over double newline
repeat
result = 0
command swt(3):
! Move
read value; ! Get amount to move by
result = 0 if value=0; ! Ignore command if specified move was 0
if sign=1 start ; ! Move forwards
cycle i1 = 1, 1, value
address = locate(forwards, conad+current position, conad+end position, snl.snl)
! Find address of next double newline before end
exit if address=0; ! Don't try to find any more if this was the last one
current position = address-conad+2; ! Convert to relative address, and move over double newline
repeat
finish else start ; ! Move backwards
cycle i1 = 1, 1, value
address = locate(backwards, conad+start position-2, conad+current position-2, snl.snl)
! Find last double newline between here and start, ignoring the one just before CURRENT POSITION
! ( end of last descriptor )
exit if address=0; ! Don't try to find any more if there aren't any
current position = address-conad+2; ! Change to relative address, skip over this double newline
repeat
finish
pdesc = 1; ! Print out descriptor
result = 0
command swt(4):
! Find
if ch='?' start ; ! Enquire
l = l-1
if find string="" then printstring("Not defined".snl) else printstring(find string.snl)
result = 0
finish
if l>0 and ch='-' then l = l-1 and sign = -1 else sign = 1; ! Set direction of search
if l>0 and ch=delimiter start ; ! Read in string
l = l-1; ! Remove this character
find1 = ""; ! Clear temporary string
cycle
if ch=delimiter start ; ! Found a delimiter
l = l-1; ! Remove it from command line
exit unless ch=delimiter; ! End of search string unless next character is also a
! delimiter, in which case ...
finish
find1 = find1.tostring(ch); ! Add character to string
l = l-1; ! Remove it
repeat
printstring("Invalid string".snl) and result = -1 if find1=""; ! Can't search for a null string
find string = find1; ! Copy to search string if string legal
finish ; ! ( else search for last used search string )
! Can't use last used search string if it has not been defined
printstring("No string set up for Find".snl) and result = -1 if find string=""
if sign=1 then address = locate(forwards, conad+current position, conad+end position, find string) else c
address = locate(backwards, conad+start position, conad+current position, find string)
! Find occurrence of string
printstring("String not found.".snl) and result = -2 if address=0
address = locate(backwards, conad+start position, address, snl.snl)
if address=0 then current position = start position else current position = (address-conad)+2
! Go back to beginning of the descriptor
pdesc = 1; ! Print out descriptor
result = 0
command swt(5):
! Insert n descriptors before the current one
read value; ! Get number of descriptors to insert
printstring("Invalid parameter for Insert".snl) and result = -1 if value=0 or sign=-1
! Can't insert 0 or a negative number of descriptors
if ext file header_stations+value>max stations start
! If maximum reached, adjust VALUE down to fit in
value = max stations-ext file header_stations
printstring("No more devices".snl) and result = -2 if value=0; ! Unsuccessful command if no room left
printstring("Only ".itos(value)." devices may be inserted".snl)
finish
cycle i1 = 1, 1, value
len = 0; ! Descriptor is 0 length as yet
addr type = 2 { TS }
base type = no
cycle j1 = 1, 1, n parameters; ! For each parameter
continue unless template(addr type, j1)&ignore=0
dummy = get a param(j1, flag); ! Get parameter
flag = 0 and exit if flag=2 { "*" }
len = len+printout(1, dummy, len); ! Output to file
flag = 0 and exit if base type=yes
exit unless flag=0; ! if parameter makes descriptor too large
repeat ; ! ( for each parameter )
len = len+print out(1, snl, len) if flag=0; ! Add newline to descriptor if it isn't already too large
! Unsuccessful command if descriptor too large
printstring("Descriptor too large.".snl) and result = -2 unless flag=0
move(ext file header_end-current position, conad+current position, conad+current position+len)
! Shift data after CURRENT POSITION up to make room
move(len, work conad, conad+current position); ! Move work area into correct place
change end position(len)
current position = current position+len; ! and CURRENT POSITION
ext file header_stations = ext file header_stations+1; ! Increase number of devices
change no of devices; ! and change entry at start of text
repeat ; ! ( for each descriptor )
result = 0
command swt(6):
! Delete descriptors from here on
read value; ! Get number to delete
printstring("Invalid parameter for Delete".snl) and result = -1 if value=0 or sign=-1
! Can't delete 0 or a negative number of descriptors
cycle i1 = 1, 1, value
exit if ext file header_stations=0; ! If no more devices left to delete
address = locate(forwards, conad+current position, conad+end position, snl.snl)
! Find end of this descriptor
if address=0 then address = end position else address = (address-conad)+2
! If double newline not found, set ADDRESS to end
! Change address to relative and skip over double newline
move(ext file header_end-address, conad+address, conad+current position)
! Shift data down over this descriptor
change end position(current position-address); ! Shift pointers down by ADDRESS - CP
ext file header_stations = ext file header_stations-1; ! Decrease number of devices
change no of devices; ! and change entry at start of text
repeat
pdesc = 1; ! Print out descriptor
result = 0
command swt(7):
! Change
read value
printstring("Invalid parameter for CHANGE".snl) and result = -1 if value=0 or sign=-1
pdesc = 1; ! Print out descriptor
cycle i1 = 1, 1, value
printstring("End of section reached".snl) and exit if current position=end position
! Not allowed to change last descriptor - it must remain empty
address = locate(forwards, conad+current position, conad+end position-2, snl.snl)
! Find end of this descriptor
if address=0 then address = end position else address = address-conad+2
! Change to relative address and skip over double newline. Set address to end of this section
! section if end of this descriptor not found ( shouldn't happen ! )
old len = address-current position; ! Old length of this descriptor
len = old len; ! New length same as old one to start with
move(len, conad+current position, work conad); ! Copy descriptor to work area
rel a of p = 0; ! Address of current ( first ) parameter, relative to start of work area
addr type = 2 { TS }
base type = no
cycle j1 = 1, 1, n parameters; ! Round each parameter
if base type=yes then ign = 1 else ign = (template(addr type, j1)&ignore)
! If IGN # 0, this parameter is to be removed from descriptor
old l of p = 0; ! Initialise length
printstring("Current setting of parameter ".ucstring(parameter names(j1))." : ") if ign=0
a of p = locate(forwards, work conad+rel a of p, work conad+len, ucstring(parameter names(j1)))
! Try to find current parameter
if a of p#work conad+rel a of p start
{ If param doesn't start straight away, it is as defaulted }
a of p = work conad+rel a of p
printstring("As defaulted - ".descriptor defaults(j1).snl) if ign=0
finish else start { work out what param is set to }
old l of p = old l of p+1 until byteinteger(a of p+old l of p)='='
! Count and skip over characters til '=' reached
old l of p = old l of p+2; ! Skip over '=' and following space
dummy = ""
while byteinteger(a of p+old l of p)#nl cycle
dummy = dummy.tostring(byteinteger(a of p+old l of p))
old l of p = old l of p+1
repeat
printstring(dummy) if ign=0
! Print out and count characters in this parameter
if j1=3 start
if ucstring(dummy)="NSI" then addr type = 1 else if ucstring(dummy)="BASE" then base type = yes
finish
{ Presumably, if J1 = 3, IGN = 0 for either ADDR TYPE so no need to reassign IGN }
old l of p = old l of p+1; ! Skip over newline
unless template(addr type, j1)&multiple=0 start ; ! Find multiple params if there are any
cycle
address = locate(forwards, a of p+old l of p, work conad+len, ucstring(parameter names(j1)))
! Try to find parameter name again
exit unless address=a of p+old l of p; ! Ignore it unless it starts immediately
printstring(" and ") if ign=0
old l of p = old l of p+1 until byteinteger(a of p+old l of p)='='
! Count and skip over chars til '=' found
old l of p = old l of p+2; ! Skip over '=' and following space
while byteinteger(a of p+old l of p)#nl cycle
printch(byteinteger(a of p+old l of p)) if ign=0
old l of p = old l of p+1
repeat
! Count and print out characters in rest of parameter
old l of p = old l of p+1; ! Skip over newline
repeat ; ! Get all parts of multiple parameter
finish
newline
finish
prompt(parameter names(j1).":")
dummy = ""
count = 0; ! No of parameters input so far
limit = 1+template(addr type, j1)>>4; ! Max no of multiple inputs ( if allowed )
if ign#0 then dummy = "" else start
cycle
read line
if line1="?" start ; ! Help needed
printstring(help info(j1).snl)
printstring("Legal replies are : * to exit,
! to leave this parameter as defaulted,
<return> to leave this parameter as set,
<text> to set this parameter to 'text' ".snl)
continue ; ! and get another input
finish
dummy = line1 and exit if (line1="*" or line1="") and count=0
! Leave parameter as it is ( and maybe rest of descriptor too )
if ucstring(line1)=".END" and count=0 then printstring(".END not legal here".snl) and continue
! Can't use .END as first input - only to end multiple inputs after at least one has been entered
if line1="!" start
printstring(parameter names(j1)." does not have a default".snl) and continue if c
template(addr type, j1)&default=0
base type = no and addr type = 2 if j1=3 { set default address type }
dummy = ""
ign = 1 { this parameter now to be ignored, ie removed from descriptor }
exit
finish
if length(dummy)+parm(j1, line1, dummy1)>255 and ucstring(line1)#".END" then c
printstring("Parameter too long".snl) and dummy = "" and count = 0 and continue
! Adding this parameter to what we already have would make DUMMY longer than 255 chars
if j1=3 start
base type = no
if ucstring(line1)="NSI" then addr type = 1 else if ucstring(line1)="TS" then c
addr type = 2 else if ucstring(line1)="BASE" then base type = yes
finish
if template(addr type, j1)&multiple=0 then dummy = dummy1 and exit else start
! DUMMY1 is output from PARM - exit if only single inputs allowed
count = count+1; ! One more input has been added
exit if ucstring(line1)=".END"; ! Finished inputting
dummy = dummy.dummy1; ! otherwise add to parameter
continue ; ! and get next part
finish
repeat until count=limit; ! Maximum of LIMIT parts for multiple parameters
finish
rel a of p = rel a of p+old l of p and continue if dummy="" and ign=0
! Skip over this parameter if it is to be left
exit if dummy="*"; ! Quit changing this descriptor if * typed
if len-old l of p+length(dummy)>max desc size then c
printstring("Descriptor too large".snl) and exit else start
move(len-old l of p-rel a of p, a of p+old l of p, a of p+length(dummy))
! Make room for this parameter in work area
new l of p = printout(1, dummy, rel a of p); ! Copy parameter to work area
len = len-old l of p+new l of p; ! Adjust length of this descriptor
rel a of p = rel a of p+new l of p; ! and skip over to next one
finish
repeat ; ! For each parameter of this descriptor
move(ext file header_end-current position-old len, conad+current position+old len,
conad+current position+len)
! Make room in main file for it
move(len, work conad, conad+current position); ! Copy descriptor to main file
change end position(len-old len); ! Adjust pointers by difference in descriptor lengths
current position = current position+len; ! And skip over this descriptor to next one
repeat ; ! For each descriptor to be CHANGEd
result = 0
command swt(8):
! Set up User-defined macro
printstring("Can't use U within a macro.".snl) and result = -1 unless macro=0
! Set 'illegal command' flag if user tried to define a macro within a macro
if ch='?' start ; ! Enquire
l = l-1; ! Remove ? from LINE
enquire:
if macro string="" then printstring("Not defined".snl) else start
printch(charno(macro string, i1)) for i1 = length(macro string), -1, 1
! Print out macro ( it is stored backwards like command line )
newline
finish
result = 0; ! And return
finish
prompt("Macro defn : ")
read command(dummy); ! Input macro definition
if dummy="?" then ->enquire else macro string = dummy; ! If response was ?, user wants to see current macro,
! otherwise response was new macro
result = 0
command swt(9):
! EXecute user-defined macro
printstring("Can't use X within a macro.".snl) and result = -1 unless macro=0
! Can't nest execution of macros, so give 'illegal command' result
printstring("Illegal parameter for EXECUTE".snl) and l = l-1 and result = -1 if ch='*'
! Can't X* ( might get caught in an endless loop )
read value; ! Get number of times to execute macro
printstring("Illegal parameter for EXECUTE".snl) and result = -1 if value<0 or sign=-1
! Can't execute macro zero or negative number of times
macro = 1; ! Now executing macro ( can't do things like defining macro )
save string = line; ! Save command line ...
cycle j = 1, 1, value; ! ... and for each execution of the macro ...
line = macro string; ! ... copy macro into it
while l>0 cycle ; ! ie while there is still some macro left to execute
flag = 3; ! Command not found yet
cycle i = 1, 1, no of commands; ! Check command against legal ones
flag = execute command and exit if ch=command(i); ! If found command
repeat ; ! for each legal command
printstring("Illegal command.".snl) if flag=3; ! ie if command wasn't found
exit if flag=-2; ! If, for example, got a 'String not found'
printstring("Illegal macro".snl) and macro string = "" and exit unless flag=0
! Abandon macro if illegal command found
repeat
exit unless flag=0; ! ie exit if anything untoward happened
repeat ; ! for each execution of macro
line = save string; ! Copy command line back
macro = 0; ! ... and reset flag
result = flag
command swt(10):
! Print out defaults
print defaults
result = 0
command swt(11):
! Abort
printstring("Can't use A within a macro.".snl) and result = -1 unless macro=0
! Set 'illegal command' if within a macro
printstring("A or Y to abort, anything else to return to program.".snl)
prompt("Abort : ")
read command(dummy); ! Find out if abort was intentional
if dummy="A" or dummy="Y" then result = 2 else result = 0; ! If it was, set result to
! successful abort, otherwise ignore command
command swt(12):
! End
printstring("Can't use E within a macro.".snl) and result = -1 unless macro=0
! Set 'illegal command' if tried to END from within a macro
printstring("No stations".snl) if ext file header_stations=0
! Inform user if any section of file is devoid of entries
result = 1; ! Successful END
command swt(13):
! Compile
printstring("Can't use K within a macro.".snl) and result = -1 unless macro=0
if ch=delimiter start
l = l-1
output file = ""
while ch<>delimiter and length(output file)<11 cycle
output file = output file.tostring(ch)
l = l-1
repeat
if ch<>delimiter or output file="" start
printstring("Illegal output file name".snl)
result = -1
finish else default output file = output file and l = l-1 { remove last delimiter }
finish else output file = default output file
if exist(output file)#0 start
printstring(output file." already exists and will be overwritten. Is this OK ?".snl)
prompt("Y/K to compile ")
read command(dummy)
result = 0 unless dummy="Y" or dummy="K"
finish
if compile config(output file)=0 start
printstring("Compiled config is in file ".output file.snl)
result = 1 { END }
finish else result = -2 { failed to compile so return to editor }
command swt(14):
! List
if ch=delimiter start
l = l-1
list file = ""
while ch<>delimiter and length(list file)<11 cycle
list file = list file.tostring(ch)
l = l-1
repeat
if ch<>delimiter or list file="" start
printstring("Illegal list file name".snl)
result = -1
finish else l = l-1
finish else list file = default list file
if exist(list file)#0 start
printstring(list file." already exists and will be overwritten. OK ?".snl)
prompt("Y / L to list")
read command(dummy)
result = 0 unless dummy="Y" or dummy="L"
finish
define("1,".list file)
if return code=0 start
select output(1)
if return code=0 start
print defaults
printch(byteinteger(conad+i1)) for i1 = ext file header_start, 1, ext file header_end
finish else printstring("Failed to select output stream :".failure message(return code).snl)
select output(0)
finish else printstring("Failed to define stream :".failure message(return code).snl)
if return code=0 then result = 0 else result = -2
command swt(15):
! Repeat
if ch=delimiter start
dummy = ""
l = l-1
cycle
if ch=delimiter start
l = l-1
exit unless ch=delimiter
finish
dummy = dummy.tostring(ch)
l = l-1
repeat
if dummy="" or length(dummy)>247 start
printstring("Illegal name to REPEAT".snl)
result = -1
finish
finish else start
printstring("REPEAT must be followed by a name".snl)
result = -1
finish
address = locate(forwards, conad+ext file header_start, conad+ext file header_end, "NAME = ".dummy.snl)
if address=0 start
printstring("Name ".dummy." not found".snl)
result = -2
finish
len = locate(forwards, address, conad+ext file header_end, snl.snl)+2-address
move(len, address, work conad)
move(ext file header_end-current position, conad+current position, conad+current position+len)
move(len, work conad, conad+current position)
change end position(len)
ext file header_stations = ext file header_stations+1
change no of devices
result = 0
command swt(16):
! Change top of file
address = conad+ext file header_start
cycle i1 = 0, 1, 3
dummy = ""
dummy = dummy.tostring(byteinteger(address+j1)) for j1 = 0, 1, 79
printstring(dummy)
prompt(substring(dummy, 1, 15))
read line
exit if line1="*"
if line1#"" start
length(line1) = 63 if length(line1)>63
line1 = line1." " while length(line1)<63
move(63, addr(line1)+1, address+15)
finish
address = address+80
repeat
result = 0
end ; ! of integerfn EXECUTE COMMAND
!-------------------------------------------------------------------------------------------------------------------!
filename = file unless file->owner.(".").filename
if length(filename)<11 then default output file = filename else default output file = substring(filename, 1, 10)
default list file = default output file."L"
default output file = default output file."Y"
this full host = uinfs(15).".".uinfs(16)
flag2 = 0; ! To force destroying workfile in case of crash
if exist(file)#0 start
copy(file.",".workfile)
if return code=0 start
change file size(workfile, x'44000', flag)
if flag=0 start
connect(workfile, read and write, 0, 0, r, flag)
if flag=0 then conad = r_conad else c
printstring("Failed to connect ".workfile." : ".failure message(flag).snl)
finish else printstring("Failed to change size of ".workfile." : ".failure message(flag).snl)
flag1 = 1 { Set flag for 'already existed' }
finish else printstring("Failed to copy ".file." : ".failure message(return code).snl) and flag = -1
finish else start { File doesn't exist }
outfile(workfile, x'44000', 0, X'80000000', conad, flag)
printstring("Failed to create and connect ".workfile." : ".failure message(flag).snl) unless flag=0
flag1 = 0 { new file }
finish
if flag=0 start ; ! If first section successfully completed
ext file header == record(conad); ! Map EXT FILE HEADER.
ext file header_datetime = pack date and time(date, time); ! Set date and time on file
if exist(insertfile)#0 then destroy(insertfile, flag) else flag = 0
! Destroy insertfile if it exists
if flag=0 start ; ! If insertfile ready to be created and connected
outfile(insertfile, max desc size, 0, X'80000000', work conad, flag)
if flag=0 start ; ! If successfully created and connected
if flag1=0 then start ; ! New file
printstring(file." is a new file".snl)
ext file header_checkword = X'18061966'; ! Random integer to check if file is really an modftrans file
ext file header_size = x'44000'; ! 200 Kbytes ( plus a bit )
ext file header_type = 4; ! Character file
ext file header_start = ext file header size
ext file header_stations = 0
current position = ext file header_start+print out(0, padout("IPL discs =",
79).snl.padout("Update = ", 79).snl, ext file header_start)
current position = current position+print out(0, padout("This host = ",
79).snl.padout("Dead letters = ", 79).snl."Stations = 0 ".snl.snl.snl.snl, current position)
start position = current position-2
end position = current position-2
ext file header_end = current position; ! End of file
finish else start ; ! File already exists
printstring(file." is not a modftrans file.".snl) and ->return unless c
ext file header_checkword=X'18061966'
! Check that file was created by this program ( EXT FILE HEADER_CHECKWORD is set if FILE is a new file )
address = locate(forwards, conad+ext file header_start, conad+ext file header_end, "STATIONS =")
unless address=0 start
address = locate(forwards, address, conad+ext file header_end, snl.snl)
start position = address+2-conad unless address=0
finish
if address=0 then printstring("Failed to find start of stations.".snl. c
"There must be a line containing 'Stations ='; the ' ' is necessary.".snl) and ->return
address = locate(forwards, address, conad+ext file header_end, snl.snl.snl.snl)
printstring("Failed to find end of stations.".snl) and ->return if address=0
end position = address+2-conad
finish
printstring("Type '?' for help info.".snl)
l == length(line)
l = 0
current position = start position
find string = ""; ! Clear Search string ...
macro string = ""; ! ... and macro
macro = 0; ! ie not executing macro as yet
pdesc = 0; ! Don't print out descriptor yet
cycle
pdesc = 0 and print desc(current position) if l=0 and pdesc=1
! Print out descriptor if PDESC is 1 and LINE is null ( finished )
prompt("Config : ")
read command(line) while l=0; ! Ignore null command
flag2 = 3; ! ie command not found yet
cycle i = 1, 1, no of commands; ! Go to appropriate routine
if ch=command(i) start
l = l-1
flag2 = execute command
exit
finish
repeat
exit if flag2=1 or flag2=2; ! if successful ABORT or END
printstring("Illegal command ".tostring(ch).snl) and l = 0 if flag2=3; ! Stop if illegal
l = 0 if flag2<0; ! Ignore rest of command line if a command failed for some reason
repeat
return:
disconnect(insertfile, flag); ! Disconnect insertfile
destroy(insertfile, flag) if flag=0
printstring("Disconnect/destroy insertfile ".insertfile." fails : ".failure message(flag).snl) unless c
flag=0
finish else printstring("Create and connect insertfile ".insertfile." fails : ".failure message(flag).snl)
finish else printstring("Destroy insertfile ".insertfile." fails : ".failure message(flag).snl)
ext file header_size = ((ext file header_end+4095)>>12)<<12; ! Set new size
disconnect(workfile, flag)
if flag=0 start ; ! If workfile successfully disconnected
if flag2=1 start ; ! Exited from program because user typed E
trim(workfile, flag)
printstring("Trim ".workfile." fails : ".failure message(flag).snl) unless flag=0
rename(workfile, file, flag); ! Rename workfile to FILE
newgen(workfile, file, flag) if flag=already exists; ! Newgen if FILE already exists
if flag=0 then printstring("modftrans ".file." completed.".snl) else start
printstring("Failed to copy ".workfile." to ".file." : ".failure message(flag).snl)
printstring("Editing is saved in file ".workfile.snl)
finish
finish else start ; ! Exited from program because user typed A
destroy(workfile, flag)
if flag=0 then printstring("modftrans ".file." aborted.".snl) else c
printstring("Failed to destroy ".workfile." : ".failure message(flag).snl)
finish
finish else printstring("Disconnect workfile ".workfile." fails : ".failure message(flag).snl)
finish
end ; ! of externalroutine modftrans
!--------------------------------------------------------------------------------------------------------------!
end of file