%externalroutine CREATECON %alias "C#CREATECON" !******************************************************************************* ! ! Undergraduate Control Program Writer ! ------------------------------------ ! This program is designed to help student course supervisors write the ! controlling routines for their student subsystem. It can be used to write ! all the control software that is needed in the simplest case or it can be ! used as a basis for more complicated routines if necessary. ! The program is written in the form of a command to make its use as simple ! and as quick as possible. ! Since it is written using PAM ,full online help ( should ) be available. ! ! Note that it will be neccessary to change the 'HelpFile' constant if the ! program is renamed or moved to another file area. ! ! ( Paul Clenahan August 1986 ) ! !******************************************************************************* !------------------------------------------------------------------------------- %externalroutinespec EMAS3 ( %stringname Command,Params, %integername Flag ) %externalroutinespec EMAS3EXIST( %stringname File, %integername Flag ) %externalroutinespec EMAS3PROMPT ( %stringname Text ) %externalroutinespec EMAS3SETFNAME( %stringname FName ) %externalroutinespec EMAS3SETRETURNCODE ( %integer %name Flag ) %externalroutinespec EMAS3STRING ( %stringname Vector,Value ) %externalroutinespec EMAS3UCSTRING ( %stringname S ) !------------------------------------------------------------------------------- %conststring(255) HelpFile="ECSLIB:COMMANDS.CREATECON.HELPFILE" %constinteger CR=13,EM=25, { Control Characters } Screen = 1, { The channel nos for all } KeyBoard = 2, { the i/o } SpecFileChan = 3, ObjFileChan = 4, SourceFileChan = 5, NewSpecChan = 6, NoErrors=0, { Error Codes } OwnError = 100, FileAlreadyExists = 219, MaxTutors=50, { Array bounding values } MaxCommands=100, MaxOwners=50, MaxFiles=50, DeclPos=28 { Line no where the decl. } { are to be inserted. } !------------------------------------------------------------------------------- ! This next array contains the main bulk of the program to be written. Note ! that it is a simple matter to modify the program : Add,alter or remove the ! required lines, ensuring that they are enclosed in quotes and seperated by ! a comma. Alter the constant 'NoProgramLines' if neccessary. Also check that ! the declarations are still to be inserted in the same place. If this requires ! changing then alter the constant 'DeclPos' above. If any changes are to be ! made to the declarations then alter the array 'Declaration' accordingly. !------------------------------------------------------------------------------- %constinteger NoProgramLines = 145 %conststring(90) %array Program( 1:NoProgramLines )= %c "!****************************************************************************", "! ", "! Student Subsystem Control Routines ", "! ---------------------------------- ", "! ", "! This file contains the entry points for the routines used in student ", "! subsystem. These are :- S#ALLOWCOMMAND, S#ALLOWCONNECT and S#CSUPINT. ", "! ", "! ( Paul Clenahan August 1986) ", "! ", "!****************************************************************************", " ", "%externalroutinespec EMAS3( %stringname Command,Params, %integername Flag ) ", "%externalroutinespec EMAS3H( %stringname Command,Params, %integername Flag ) ", " ", "%externalintegerfnspec UINFI %alias ""S#UINFI"" ( %integer Entry ) ", "%externalintegerfnspec DSFI ( %stringname Index, %c ", " %integername Fsys,Type,Set, %c ", " %stringname S, %integerarrayname I ) ", " ", "!****************************************************************************", "! ", "! Under normal year to year changes it should only be neccessary to change ", "! the following constant arrays, constant integers and constant strings :- ", "! ", "!****************************************************************************", " ", " ", " ", "%constinteger NoMessageLines=9 ", "%conststring(90) %array TerminalMessage( 1:NoMessageLines )= %c ", " "" "", ", " ""***********************************************************************"",", " ""* EMAS-A doesnt know what kind of TERMINAL you are logged onto at the *"",", " ""* moment. Please answer the following query. You should find the make *"",", " ""* and MODEL of this terminal CLEARLY VISIBLE in front of you. If you *"",", " ""* are in any doubt then respond with 0, otherwise enter the NUMBER *"",", " ""* which corresponds with the terminal you are using. *"",", " ""***********************************************************************"",", " "" "" ", " ", "!****************************************************************************", " ", "%integerfn Search( %stringarrayname Table, %integer Lolim,Hilim, %c ", " %string( 30 ) Queried ) ", " ", " %integer Pos ", " ", " Hilim = Hilim + 1 ", " ", " %while Hilim-Lolim-1 > 0 %cycle ", " Pos = ( Lolim+Hilim )//2 ", " %result=1 %if Table( Pos )=Queried ", " %if Queried < Table(Pos) %thenstart ", " Hilim=Pos ", " %finishelsestart ", " Lolim=Pos ", " %finish ", " %repeat ", " %result=0 ", " ", "%end { of Search }", " ", "!****************************************************************************", " ", "%externalroutine CSUPINIT %alias ""S#CSUPINIT""( %stringname Caller,Date, %c ", " Time, %integername Flag ) ", " ", " %integer TerminalType,I,Status ", " %string(6) Supervisor ", " %integerarray Dummy(1:1) ", " ", " Status=DSFI( Caller,-1,44,0,Supervisor,Dummy ) ", " Status=0 ", " EMAS3( ""PERMIT"","".ALL,"".Supervisor,Status ) ", " %if Status#0 %then -> fail ", " %if Search( Tutors,0,TutorLimit,Caller ) = 0 %then %start ", " %for I=1,1,TutorLimit %cycle ", " EMAS3( ""PERMIT"","".ALL,"".Tutors(I),Status ) ", " %if Status#0 %then %exit ", " %repeat ", " %finish ", " %if Status#0 %then -> fail ", " ", " TerminalType = UINFI( 23 ) ", " %if ( TerminalType=0 %or TerminalType=4 ) %then %start ", " printstring( TerminalMessage(I) ) %and newline %for I=1,1,NoMessageLines", " EMAS3H( ""TERMINALTYPE"","""",Status ) ", " %if Status#0 %then -> fail ", " %finish ", " ", " %if AlertFile#"""" %then %start ", " EMAS3( ""LIST"",AlertFile,Status ) ", " %if Status#0 %then -> fail ", " EMAS3( ""DISCONNECT"",AlertFile,Status ) ", " %if Status#0 %then ->fail ", " %finish ", " ", " %if InitialiseRoutine#"""" %then %start ", " EMAS3( InitialiseRoutine,Caller."","".Date."","".Time,Status ) ", " %if Status#0 %then -> fail ", " %finish ", " ", " fail : %if Status#0 %then Flag=1 %else Flag=0 ", " ", "%end { of CSUPINIT }", " ", "!****************************************************************************", " ", "%externalroutine ALLOWCONNECT %alias ""S#ALLOWCONNECT"" %c ", " (%stringname Caller,FileOwner,FileName, %integername Mode,Flag ) ", " ", " ! Caller is only allowed to connect the FileName if : ", " ! - the file belongs to the Caller or ", " ! - the Caller is a tutor or ", " ! - the FileOwner is in the list of allowed owners or ", " ! - the FileName is in the list of allowed filenames. ", " ", " %if FileOwner=Caller %then Flag=0 %else %c ", " %if Search( Tutors,0,Tutorlimit,Caller ) = 1 %then Flag=0 %else %c ", " %if Search( Owners,0,OwnerLimit,FileOwner )= 1 %then Flag=0 %else %c ", " %if Search(Files,0,FileLimit,FileOwner."":"".FileName)=1 %c ", " %then Flag=0 %else %c ", " Flag=1 ", " ", "%end { of AllowConnect }", " ", "!****************************************************************************", " ", "%externalroutine ALLOWCOMMAND %alias ""S#ALLOWCOMMAND"" %c ", " ( %stringname Caller,CommandName,Parameters, %integername Flag )", " ", " ! The CommandName is allowed to be called only if : ", " ! - the Caller is a tutor or ", " ! - the CommandName is on the list of allowed commands. ", " ", " %if Search( Tutors,0,TutorLimit,Caller ) = 1 %then Flag=0 %else %c ", " %if Search(Commands,0,CommandLimit,CommandName)=1 %then Flag=0 %else %c ", " Flag = 1 ", " ", "%end { of Allowcommand }", " ", "!****************************************************************************", " ", "%endoffile " !------------------------------------------------------------------------------- { Part of the declarations for the constants to be used in the new program } { are contained in this array. The rest of the declarations come from the } { control specification input file. } %constinteger NoDeclLines = 10 %conststring(90) %array Declaration( 1:NoDeclLines ) = %c "%conststring(30) InitialiseRoutine= ", "%conststring(30) AlertFile= ", "%conststring(6)%array Tutors(1:)= %c { All the tutor user nos } ", "%constinteger TutorLimit= { Number of tutors } ", "%conststring(30)%array Commands(1:)= %c { All the allowed commands } ", "%constinteger CommandLimit= { Number of allowed commands } ", "%conststring(6) %array Owners(1:)= %c { Allowed connect owners } ", "%constinteger OwnerLimit= { Number of owners } ", "%conststring(30) %array Files(1:)= %c { Allowed connect files } ", "%constinteger FileLimit= { Number of files } " !******************************************************************************* %string( 255 ) SpecFile, { Names for the various i/o } SourceName, { files. } ObjName, NewSpecFile, InitialiseCommand, { The control spec names } AlertFile %string(255) %array Tutors(1:MaxTutors), Commands(1:MaxCommands), Owners(1:MaxOwners), Files(1:MaxFiles) %integer TutorCount, CommandCount, OwnerCount, FileCount !******************************************************************************* ! The Routines............... !******************************************************************************* %routine UserMessage( %string(255) Message ) selectoutput( Screen ) newline printstring( Message ); newline %end !******************************************************************************* %routine Error( %integer ErrorNo,%string(255) ErrorMessage ) { Sets the error flag before exiting the command. Note if the error flag } { is equal to OwnError then the ErrorMessage is passed to the subsystem, } { otherwise the error message is ignored and the subsystem error message } { will be used. } selectoutput( Screen ) %if ErrorNo=OwnError %then EMAS3SETFNAME( ErrorMessage ) EMAS3SETRETURNCODE( ErrorNo ) UserMessage( "Use VIEW ".HelpFile." for information on CREATECON" ) %stop %end { of Error } !******************************************************************************* %routine EMAS( %string(255) Command,Params ) { Used to call the EMAS3 routine. Once the routine has been called it } { then checks if the command was executed successfully. If it wasnt then } { it calls the error routine. } %integer Flag EMAS3( Command,Params,Flag ) Error( Flag,"" ) %if Flag#NoErrors %end { of EMAS } !******************************************************************************* %routine ReadLine ( %string( 255 ) %name Line ,%integername Flag ) { Read a line from the current input stream into 'Line' ,Flag is set } { to 1 if the EM ( End of Message ) character is encoutered. } %integer Ch %if Flag=1 %then %c Error( OwnError,"Unexpected End of Message character in input" ) Line="" %cycle readch( Ch ) %until Ch#' ' %if Ch=NL %or Ch=EM %or Ch=CR %then %exit Line=Line.tostring( Ch ) %repeat EMAS3UCSTRING( Line ) %if Ch = EM %then Flag=1 %end { of ReadLine } !******************************************************************************* %routine Initialise { Set the initial values for various variables and sets up the basic } { i/o channels. } InitialiseCommand="U" { Label these as Unassigned } AlertFile="U" Tutors(1)="U" Commands(1)="U" Owners(1)="U" Files(1)="U" EMAS( "DEFINE", tostring( '0'+Screen ).",.out" ) { Setup basic channels } EMAS( "DEFINE", tostring( '0'+KeyBoard ).",.in" ) %end { of Initialise } !******************************************************************************* %routine GetCommandParams { Get the command parameters from the user and check that they are OK } !----------------------------------------------------------------------------- %routine CheckFileName( %string(255) File, ParamName ) { Check to see if a file to be written to already exists. If it does } { then ckeck with user that it is OK to overwrite the file. If that } { is the case then get rid of the current file with that name. } %integer Value , Flag %string(255) Answer Flag = 0 %if File#"" %then %start EMAS3EXIST( File,Value ) %if Value=1 %then %start newline printstring( " - The ".ParamName." ".File." already exists. " ) newline EMAS3PROMPT( " Are you happy to overwrite it ( Y/N ) ? " ) ReadLine( Answer,Flag ) %if Answer = "Y" %or Answer = "YES" %then %start EMAS( "DESTROY",File ) %finish %else Error( FileAlreadyExists,"" ) %finish %finish %end { of CheckFileName } !----------------------------------------------------------------------------- selectinput( KeyBoard ) EMAS3STRING( "SpecFile ; fileormem,read,char ;?;". %c "call pamhelp(".HelpFile.")", SpecFile ) EMAS3STRING( "SourceName ; fileormem ;?;". %c "call pamhelp(".HelpFile.")", SourceName) EMAS3STRING( "ObjName ; fileormem,ornull ;;". %c "call pamhelp(".HelpFile.")", ObjName ) EMAS3STRING( "NewSpecFile ; fileormem,ornull ;;". %c "call pamhelp(".HelpFile.")", NewSpecFile ) CheckFileName( SourceName ,"Source file name" ) CheckFileName( ObjName ,"Object file name" ) CheckFileName( NewSpecFile,"New spec file" ) %end { of GetCommandParams }{ !******************************************************************************* %routine SetupChannels { defines the channels and files to be used for the i/o } %string(2) SpecString, SourceString, ObjString, NewSpecString SpecString = tostring( '0' + SpecFileChan ) SourceString = tostring( '0' + SourceFileChan ) ObjString = tostring( '0' + ObjFileChan ) NewSpecString = tostring( '0' + NewSpecChan ) EMAS( "DEFINE", SpecString.",".SpecFile ) EMAS( "DEFINE",SourceString.",".SourceName ) EMAS( "DEFINE",ObjString.",".ObjName ) %if ObjName # "" EMAS( "DEFINE",NewSpecString.",".NewSpecFile ) %if NewSpecFile # "" %end { of Setup Channels } !******************************************************************************* %routine ReadSpecFile { Reads the control specification from 'SpecFile' into arrays and } { variables. Note that the reading routine allows for relaxed ordering } { of the control specifications and is case independant. } %string( 255 ) Line, { Current input line } Front,Back { Sub parts of current line } %integer EOFFlag, { 1 if EOF is true } LineNo { Holds the current line no. } { } !----------------------------------------------------------------------------- %routine SyntaxError( %integer LineNo ) newline printstring( "*******************************************************") newline printstring( "Syntax error in line " ) write(LineNo,3) printstring( " of ".SpecFile ) newline printstring( "*******************************************************") newline %end !----------------------------------------------------------------------------- %routine SetConst( %string(255) %name Variable ) %if Variable # "U" %thenstart { Check if already assigned } SyntaxError( LineNo ) ERROR( OwnError,"Multiple assignment of control specification parameter") %finishelsestart Variable = Back %finish %end { of setconst } !----------------------------------------------------------------------------- %routine SetList( %string(255) %arrayname List ,%integername Count ) %if List(1) # "U" %thenstart { Check if already assigned } SyntaxError( LineNo ) ERROR( OwnError,"Multiple assignment of control specifiction parameter") %finish %else %start List(1)="" Count=0 %cycle %if EOFFlag=1 %then %exit ReadLine(Line,EOFFlag) %and LineNo=LineNo+1 %until Line#"" %or EOFFlag=1 %if Line = "*" %or EOFFlag=1 %then %start %if EOFFlag=1 %then %start SyntaxError( LineNo ) ERROR( OwnError,"Unexpected end of file in ".SpecFile ) %finish %exit %finish %else %start Count = Count + 1 List( Count ) = Line %finish %repeat %finish %end { of SetList } !----------------------------------------------------------------------------- %integerfn AllAssigned %if InitialiseCommand="U" %then %result=0 %else %c %if AlertFile="U" %then %result=0 %else %c %if Tutors(1)="U" %then %result=0 %else %c %if Commands(1)="U" %then %result=0 %else %c %if Owners(1)="U" %then %result=0 %else %c %if Files(1)="U" %then %result=0 %else %c %result=1 %end { of allassigned } !----------------------------------------------------------------------------- UserMessage( "Reading the control program specifictions from ".SpecFile ) selectinput( SpecFileChan ) EOFFlag=0 LineNo=0 %cycle ReadLine( Line,EOFFLag ) %and LineNo=LineNo+1 %until Line#"" %or EOFFlag=1 %if Line -> Front.("=").Back %thenstart %if Front = "INITIALISECOMMAND" %then SetConst( InitialiseCommand ) %else %c %if Front="ALERTFILE" %then SetConst( AlertFile ) %else %c %if Front="TUTORS" %then SetList( Tutors,TutorCount ) %else %c %if Front="COMMANDS" %then SetList( Commands,CommandCount ) %else %c %if Front="OWNERS" %then SetList( Owners,OwnerCount ) %else %c %if Front="FILES" %then SetList( Files,FileCount ) %else %start SyntaxError( LineNo ) ERROR( OwnError,"Unknown Keyword in ".SpecFile ) %finish %else %if Line # "" %then %start SyntaxError( LineNo ) ERROR( OwnError,"Cannot Parse ".SpecFile ) %finish %finish %repeat %until EOFFlag=1 Error(OwnError,"Unassigned control parameter in ".SpecFile ) %if AllAssigned=0 %end { of ReadSpecFile } !******************************************************************************* %routine SortLists { Ensures that the lists are in correct alphabetic ordering. } !----------------------------------------------------------------------------- %routine Sort( %string(255) %arrayname List, %integername NumberofItems ) { Uses Bubble Sort. Not the quickest, but the time overhead is not } { important in this application. } %integer I,J %string(255) Temp %for I = NumberofItems,-1,2 %cycle %for J = 1,1,I-1 %cycle %if List(J)>List(J+1) %then %start Temp = List(J) List(J) = List(J+1) List(J+1) = Temp %finish %repeat %repeat %end { of Sort } !----------------------------------------------------------------------------- Sort( Tutors ,TutorCount ) Sort( Commands ,CommandCount ) Sort( Files,FileCount ) Sort( Owners, OwnerCount ) %end { of Sort Lists } !******************************************************************************* %routine WriteSpecFile { Writes out the tidied up version of the control specification file. } { ie writes out the lists after they have been sorted etc. } !----------------------------------------------------------------------------- %routine PrintSpecList( %string(255) Heading, %c %string(255) %arrayname List, %integer Count ) %integer I printstring( Heading ) ; newline %for I=1,1,Count %cycle printstring( " ".List(I) ) ; newline %repeat printstring( " *" ) ; newline %end { of PrintSpecList } !----------------------------------------------------------------------------- selectoutput( NewSpecChan ) printstring( "INITIALISECOMMAND = ".InitialiseCommand ) ; newline printstring( "ALERTFILE = ".AlertFile ) ;newline PrintSpecList( "TUTORS =",Tutors,TutorCount ) PrintSpecList( "COMMANDS =",Commands,CommandCount ) PrintSpecList( "OWNERS =",Owners,OwnerCount ) PrintSpecList( "FILES =",Files,FileCount ) %end { WriteSpecFile } !******************************************************************************* %routine GenerateSource { Generates the source code for the control program ( in imp ) . } { Basically, the routine prints out the 'Program' array verbatim until } { it reaches the line given in 'DeclPos'. At this point it then inserts } { the declarations. These come partly from the 'Declaration' array and } { partly from the arrays constructed from user input. Once this is done } { the routine then continues to output 'Program' from one line after } { 'DeclPos'. } %integer I, DeclLine !----------------------------------------------------------------------------- %routine printline( %integer LineNo,Flag %string(255) Value,%integer IntValue) { The Flag is used to signify if it is an integer or a string that is to } { be printed. } %string(255) Front,Back %if Declaration( LineNo ) -> Front.("=").Back %then %start %if Flag=0 %then %start printstring( Front."=" ) write( IntValue,3 ) printstring( Back ) %else printstring( Front."= """.Value."""".Back) %finish newline %else ERROR( OwnError,"Constants setup wrong in main prog" ) %finish %end { of PrintLine } !----------------------------------------------------------------------------- %routine printlist ( %integer LineNo,%string(255) %arrayname List, %c %integer Count ) %string(255) Front,Back %integer I newline %if Declaration( LineNo ) -> Front.(":").Back %then %start printstring( Front.":" ) write( Count+1,3 ) printstring( Back ) newline %for I=1,1,Count %cycle printstring( " """.List(I)."""," ) newline %repeat printstring( " """"(*)") newline %else Error( OwnError,"Constants setup wrong in program writer" ) %finish %end { of printlist } !----------------------------------------------------------------------------- UserMessage( "Creating the imp source file ".SourceName ) selectoutput( SourceFileChan ) printstring( Program(I) ) %and newline %for I=1,1,DeclPos DeclLine=1 printline( DeclLine, 1,InitialiseCommand,0 ) ; DeclLine=DeclLine+1 printline( DeclLine, 1,AlertFile,0 ) ; DeclLine=DeclLine+1 printlist( DeclLine, Tutors ,TutorCount ) ; DeclLine=DeclLine+1 printline( DeclLine, 0,"",TutorCount ) ; DeclLine=DeclLine+1 printlist( DeclLine, Commands ,CommandCount ) ; DeclLine=DeclLine+1 printline( DeclLine, 0,"",CommandCount ) ; DeclLine=DeclLine+1 printlist( DeclLine, Owners ,OwnerCount ) ; DeclLine=DeclLine+1 printline( DeclLine, 0,"",OwnerCount ) ; DeclLine=DeclLine+1 printlist( DeclLine, Files ,FileCount ) ; DeclLine=DeclLine+1 printline( DeclLine, 0,"",FileCount ) printstring( Program(I) ) %and newline %for I=DeclPos+1,1,NoProgramLines selectoutput( Screen ) closestream( SourceFileChan ) %end { of Generate Source } !******************************************************************************* %routine GenerateObject UserMessage( "Calling IMP on ".SourceName." to create ".ObjName ) selectoutput( Screen ) EMAS( "IMP", SourceName.",".ObjName ) UserMessage( "Allowing all users read access to ".ObjName ) EMAS( "PERMIT", ObjName.",.ALL,R" ) %end { of generate object } !******************************************************************************* %routine Finish UserMessage("Use VIEW ".HelpFile." for information on CREATECON." ) UserMessage( "Command executed successfully" ) EMAS3SETRETURNCODE( NoErrors ) %stop %end !******************************************************************************* ! NOW WE HAVE THE MAIN PROGRAM..... !******************************************************************************* Initialise GetCommandParams SetupChannels ReadSpecFile SortLists WriteSpecFile %if NewSpecFile#"" GenerateSource GenerateObject %if ObjName#"" Finish %end { of program body } %endoffile