Spracherkennung für: .g vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]
#############################################################################
##
#W openmath.g The SCSCP package Olexandr Konovalov
#W Steve Linton
##
#############################################################################
SCSCP_UNBIND_MODE := false;
SCSCP_STORE_SESSION_MODE := true;
#############################################################################
#
# SCSCPtransientCDs stores information about transient CDs,
# namely description and signatures of installed procedures
#
BindGlobal( "SCSCPtransientCDs", rec() );
MakeReadWriteGlobal( "SCSCPtransientCDs" );
##############################################################################
#
# SCSCP_RETRIEVE( <varnameasstring> )
#
InstallGlobalFunction( SCSCP_RETRIEVE, x -> x[1] );
##############################################################################
#
# SCSCP_STORE_SESSION( <obj> )
# SCSCP_STORE_PERSISTENT( <obj> )
#
# These are dummy functions since the magic is done in RunSCSCPserver
#
InstallGlobalFunction( SCSCP_STORE_SESSION, x -> x[1] );
InstallGlobalFunction( SCSCP_STORE_PERSISTENT, x -> x[1] );
##############################################################################
#
# SCSCP_UNBIND( <varnameasstring> )
#
InstallGlobalFunction( SCSCP_UNBIND,
function( varnameasstring )
UnbindGlobal( varnameasstring[1] );
return not IsBoundGlobal( varnameasstring[1] );
end);
##############################################################################
#
# SCSCP_GET_ALLOWED_HEADS( [ ] )
#
InstallGlobalFunction( SCSCP_GET_ALLOWED_HEADS,
function( x )
# the function should have an argument, which in this case will be an
# empty list, since 'get_allowed_heads' has no arguments
local range, cd, name, omstr;
if x <> [] then
Print( "WARNING: get_allowed_heads has no arguments, but called with argument ", x,
" which will be ignored!\n");
fi;
omstr:="<OMA>\n";
Append( omstr, "<OMS cd=\"scscp2\" name=\"symbol_set\"/>\n" );
# we may eventually have more than one transient CD, then the loop will be uncommented
if SCSCPserverAcceptsOnlyTransientCD then
range := [ "scscp_transient_1" ];
else
range := RecNames(OMsymRecord);
fi;
for cd in range do
for name in RecNames(OMsymRecord.(cd)) do
if OMsymRecord.(cd).(name) <> fail then
Append( omstr, Concatenation( "<OMS cd=\"", cd, "\" name=\"", name, "\"/>\n" ) );
fi;
od;
od;
Append( omstr, "</OMA>" );
return OMPlainString( omstr );
end);
##############################################################################
#
# SCSCP_IS_ALLOWED_HEAD( <openmathsymbol> )
#
InstallGlobalFunction( SCSCP_IS_ALLOWED_HEAD,
function( x )
local tran, s, symb, t;
if IsBound( OMsymRecord.(x[1]) ) then
if IsBound( OMsymRecord.(x[1]).(x[2]) ) then
if OMsymRecord.(x[1]).(x[2]) <> fail then
return true;
fi;
fi;
fi;
return false;
end);
##############################################################################
#
# SCSCP_GET_SERVICE_DESCRIPTION( [ ] )
#
InstallGlobalFunction( SCSCP_GET_SERVICE_DESCRIPTION,
function( x )
local omstr;
# the function should have an argument, which in this case will be an
# empty list, since 'get_allowed_heads' has no arguments
if x <> [] then
Print( "WARNING: get_service_description has no arguments, but called with argument ", x,
" which will be ignored!\n");
fi;
omstr:="<OMA>\n<OMS cd=\"scscp2\" name=\"service_description\"/>\n";
Append( omstr, Concatenation("<OMSTR>", SCSCPserviceName, "</OMSTR>\n" ) );
Append( omstr, Concatenation("<OMSTR>", SCSCPserviceVersion, "</OMSTR>\n" ) );
Append( omstr, Concatenation("<OMSTR>", SCSCPserviceDescription, "</OMSTR>\n" ) );
Append( omstr, "</OMA>" );
return OMPlainString( omstr );
end);
##############################################################################
#
# SCSCP_GET_TRANSIENT_CD( <x> )
#
InstallGlobalFunction( SCSCP_GET_TRANSIENT_CD,
function( x )
local omstr, procname;
if not IsBound( OMsymRecord.(x[1]) ) then
Error("no_such_transient_cd");
else
omstr:="<CD>\n<CDName>scscp_transient_1</CDName>\n";
Append( omstr, Concatenation( "<CDReviewDate>", DateISO8601(), "</CDReviewDate>\n" ) );
Append( omstr, Concatenation( "<CDDate>", DateISO8601(), "</CDDate>\n" ) );
Append( omstr, Concatenation( "<CDVersion>", "0", "</CDVersion>\n" ) );
Append( omstr, Concatenation( "<CDRevision>", "0", "</CDRevision>\n" ) );
Append( omstr, "<CDStatus>private</CDStatus>\n" );
Append( omstr, "<Description>This is a transient CD for the GAP SCSCP service</Description>\n" );
for procname in RecNames( OMsymRecord.(x[1]) ) do
Append( omstr, Concatenation( "<CDDefinition>\n", "<Name>", procname, "</Name>\n" ) );
Append( omstr, Concatenation( "<Description>",
SCSCPtransientCDs.(x[1]).(procname).Description,
"</Description>\n</CDDefinition>\n" ) );
od;
fi;
Append( omstr, "</CD>" );
return OMPlainString( omstr );
end);
##############################################################################
#
# SCSCP_GET_SIGNATURE( <openmathsymbol> )
#
InstallGlobalFunction( SCSCP_GET_SIGNATURE,
function( x )
local omstr;
if not IsBound( OMsymRecord.(x[1]) ) then
Error("no_such_transient_cd");
else
if not IsBound( OMsymRecord.(x[1]).(x[2]) ) then
Error("no_such_symbol");
else
omstr:="<OMA>\n<OMS cd=\"scscp2\" name=\"signature\"/>\n";
Append( omstr, Concatenation( "<OMS cd=\"", x[1], "\" name=\"", x[2], "\"/>\n" ) );
Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Minarg : noomobj ), "\n" ) );
Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Maxarg : noomobj ), "\n" ) );
Append( omstr, "<OMS cd=\"scscp2\" name=\"symbol_set_all\"/>\n" );
Append( omstr, "</OMA>" );
return OMPlainString( omstr );
fi;
fi;
end);
#############################################################################
##
## Extending global record OMsymRecord previously created in OpenMath package
##
OMsymRecord.scscp1 := rec(
procedure_call := x -> x[1], # x is already converted from OM to GAP
procedure_completed :=
function(x);
if IsBound(x[1]) then
return x[1];
else # when no object is returned
return "procedure completed";
fi;
end,
procedure_terminated := x -> x[1],
call_id := "call_id",
info_memory := "info_memory",
info_message := "info_message",
info_runtime := "info_runtime",
option_debuglevel := "option_debuglevel",
option_max_memory := "option_max_memory",
option_min_memory := "option_min_memory",
option_return_cookie := "option_return_cookie",
option_return_object := "option_return_object",
option_return_nothing := "option_return_nothing",
option_return_deferred := "option_return_deferred",
option_runtime := "option_runtime",
error_CAS := "error_CAS"
);
OMsymRecord.scscp2 := rec(
store_session := SCSCP_STORE_SESSION,
store_persistent := SCSCP_STORE_PERSISTENT,
retrieve := SCSCP_RETRIEVE,
unbind := SCSCP_UNBIND,
get_allowed_heads := SCSCP_GET_ALLOWED_HEADS,
is_allowed_head := SCSCP_IS_ALLOWED_HEAD,
get_service_description := SCSCP_GET_SERVICE_DESCRIPTION,
get_transient_cd := SCSCP_GET_TRANSIENT_CD,
get_signature := SCSCP_GET_SIGNATURE
);
OMsymRecord.meta := rec(
CDName := x -> x[1]
);
#############################################################################
##
#F OMGetObjectWithAttributes( <stream> )
##
## <stream> is an input stream with an OpenMath object on it.
## Takes precisely one object off <stream> (using PipeOpenMathObject)
## and puts it into a string.
## From there the OpenMath object is turned into a record r with fields
## r.object, containing the corresponding GAP object, and r.attributes,
## which is a list of pairs [ name, value ], for example
## [ ["call_id", "user007" ], ["option_runtime", 300000] ]
## This is a counterpart of the function OMGetObject from OpenMath package .
##
InstallGlobalFunction( OMGetObjectWithAttributes,
function( stream )
local return_tree,
fromgap, # string
firstbyte,
gap_obj,
success, # whether PipeOpenMathObject worked
readline;
if IsClosedStream( stream ) then
Error( "closed stream" );
elif IsEndOfStream( stream ) then
Error( "end of stream" );
fi;
if ValueOption("return_tree") <> fail then
return_tree := true;
else
return_tree := false;
fi;
# read new line until <?scscp start ?>
repeat
readline:=ReadLine(stream);
if readline=fail then
return fail;
fi;
NormalizeWhitespace( readline );
if Length( readline ) > 0 then
Info( InfoSCSCP, 2, readline );
fi;
until readline= "<?scscp start ?>";
firstbyte := ReadByte(stream);
if firstbyte = 24 then
# Reading binary encoding => set reply mode to binary
IN_SCSCP_BINARY_MODE:=true;
gap_obj := GetNextObject( stream, firstbyte );
gap_obj := OMParseXmlObj( gap_obj.content[1] );
return rec( object := gap_obj, attributes := OMParseXmlObj( OMTempVars.OMATTR ) );
else
if firstbyte = fail then
Info( InfoSCSCP, 2, "OpenMath object not retrieved by PipeOpenMathObject" );
return fail;
fi;
# Reading XML encoding => set reply mode to XML
IN_SCSCP_BINARY_MODE:=false;
fromgap := "";
# Get one OpenMath object from 'stream' and put into 'fromgap',
# using PipeOpenMathObject
success := PipeOpenMathObject( stream, fromgap, firstbyte );
if success <> true then
Info( InfoSCSCP, 2, "OpenMath object not retrieved by PipeOpenMathObject" );
return fail;
fi;
# Now 'fromgap' is the string with OpenMath encoding
if InfoLevel( InfoSCSCP ) > 2 then
Print("#I Received message: \n");
Print( fromgap );
Print( "\n" );
fi;
# read new line until <?scscp end ?>
repeat
readline:=ReadLine(stream);
if readline=fail then
return fail;
fi;
NormalizeWhitespace( readline );
if Length( readline ) > 0 then
Info( InfoSCSCP, 2, readline );
fi;
until readline= "<?scscp end ?>";
# convert the OpenMath string into a Gap object using an appropriate
# function
if return_tree then
return OMgetObjectXMLTreeWithAttributes( fromgap : return_tree );
else
return OMgetObjectXMLTreeWithAttributes( fromgap );
fi;
fi;
end );
#############################################################################
##
#F OMgetObjectXMLTreeWithAttributes(string)
##
## This is a counterpart of the OpenMath function OMgetObjectXMLTree
##
InstallGlobalFunction( OMgetObjectXMLTreeWithAttributes,
function(string)
local return_tree, return_deferred, node, attrs, t, obj, pos, name;
if ValueOption("return_tree") <> fail then
return_tree := true;
else
return_tree := false;
fi;
OMTempVars.OMBIND := rec( );
OMTempVars.OMREF := rec( );
# This is the difference from OMgetObjectXMLTree
OMTempVars.OMATTR := rec( );
node := ParseTreeXMLString( string ).content[1];
node.content := Filtered( node.content, OMIsNotDummyLeaf );
# Print( "ParseTreeXMLString( string ) = ", node.content, "\n" );
attrs := List( Filtered( node.content[1].content, t -> t.name = "OMATP" ), OMParseXmlObj );
if Length(attrs)=1 then
attrs:=attrs[1];
fi;
# At this point we already know attributes BEFORE the the real computation is started.
# This allows us to know in advance which kind of return (object/cookie/tree)
# is expected, and which runtime and memory limits were specified, if any.
# Now we will check that this is really procedure_call message and that
# the procedure is allowed, that is, it is from scscp{1,2} or scscp_transient_X CD
if SCSCPserverMode then
SCSCP_UNBIND_MODE := false;
SCSCP_STORE_SESSION_MODE := true;
pos:=PositionProperty( node.content[1].content, r -> r.name="OMA"); # expected scscp1.procedure_call
if pos=fail then
return rec( object := [ "Message rejected: it must be a proper scscp1.procedure_call" ],
attributes := attrs, is_error:=true );
else
node.content[1].content[pos].content :=
Filtered( node.content[1].content[pos].content, OMIsNotDummyLeaf );
if not IsBound( node.content[1].content[pos].content[1] ) or
not IsBound( node.content[1].content[pos].content[1].attributes ) or
not node.content[1].content[pos].content[1].attributes in
[ rec( name := "procedure_call", cd := "scscp1" ),
rec( name := "procedure_completed", cd := "scscp1" ),
rec( name := "procedure_terminated", cd := "scscp1") ]
then
return rec( object := [ "Message rejected because it is not a proper scscp1.procedure_call" ],
attributes := attrs, is_error:=true );
else
node.content[1].content[pos].content[2].content :=
Filtered( node.content[1].content[pos].content[2].content, OMIsNotDummyLeaf );
if not IsBound( node.content[1].content[pos].content[2].content[1] ) or
not IsBound( node.content[1].content[pos].content[2].content[1].attributes ) or
not IsBound( node.content[1].content[pos].content[2].content[1].attributes.cd ) then
return rec( object := [ "Message rejected because it is not properly formatted" ],
attributes := attrs, is_error:=true );
elif SCSCPserverAcceptsOnlyTransientCD and
# check that we are not parsing procedure_completed message
# while resolving a reference to a remote object
not node.content[1].content[pos].content[1].attributes =
rec( name := "procedure_completed", cd := "scscp1" ) and
( Length( node.content[1].content[pos].content[2].content[1].attributes.cd ) < 5 or
not node.content[1].content[pos].content[2].content[1].attributes.cd{[1..5]} = "scscp" ) then
return rec( object := [
"Message rejected because the procedure ",
node.content[1].content[pos].content[2].content[1].attributes.cd, ".",
node.content[1].content[pos].content[2].content[1].attributes.name,
" is not allowed"],
attributes := attrs, is_error:=true );
else
# some checks for some particular special procedures might be here
if node.content[1].content[pos].content[2].content[1].attributes.cd = "scscp2" then
name := node.content[1].content[pos].content[2].content[1].attributes.name;
if name = "unbind" then
SCSCP_UNBIND_MODE := true;
elif name = "store_persistent" then
SCSCP_STORE_SESSION_MODE := false;
fi;
fi;
fi;
fi;
fi;
fi;
# if the security check is done, we may proceed
if ForAny( attrs, t -> t[1]="option_return_deferred" ) then
return_deferred := true;
else
return_deferred := false;
fi;
if return_tree or return_deferred then
obj := node.content[1];
else
obj := OMParseXmlObj( node.content[1] );
fi;
# the next check was is a temporary measure to verify that
# attributes were identified properly
#if OMTempVars.OMATTR <> rec() then
# if OMParseXmlObj( OMTempVars.OMATTR ) <> attrs then
# Error("Attributes were not properly identified:\n",
# "OMParseXmlObj( OMTempVars.OMATTR ) = ", OMParseXmlObj( OMTempVars.OMATTR ), "\n",
# "attrs = ", attrs );
# fi;
#fi;
return rec( object:=obj, attributes:=attrs );
end );
#############################################################################
##
## OMObjects.OMATTR( node )
##
## we overwrite the OpenMath function OMObjects.OMATTR with our definition
## (if OMObjects.OMATTR will be called from OpenMath, the OMTempWars.OMATTR
## will be ignored)
##
OMObjects.OMATTR := function ( node )
OMTempVars.OMATTR:=Filtered( node.content,
function ( x )
return x.name = "OMATP";
end )[1];
node.content := Filtered( node.content,
function ( x )
return x.name <> "OMATP";
end );
return OMParseXmlObj( node.content[1] );
end;
#############################################################################
##
## OMObjects.OMATP( node )
##
## We add OMObjects.OMATP function to the list of functions OMObjects
## defined as a global variable in the OpenMath package
##
OMObjects.OMATP := function ( node )
local i;
#DisplayXMLStructure(node);
return List( [1,3..Length(node.content)-1], i ->
[ OMParseXmlObj(node.content[i]), OMParseXmlObj(node.content[i+1]) ] );
end;
#############################################################################
##
## OMObjects.OMR( node )
##
## This overwrites OMObjects.OMR defined in OpenMath package as
## return OMTempVars.OMREF.(node.attributes.href);
##
OMObjects.OMR := function ( node )
local ref, pos1, pos2, pos3, name, server, port;
if IsBound( node.attributes.href ) then
ref := node.attributes.href;
pos1:=PositionSublist( ref, "://" );
pos2:=PositionNthOccurrence( ref, ':', 2);
if pos1=fail then
# reference to an object within the same OpenMath document
if ref[1]=CHAR_INT(35) then
return OMTempVars.OMREF.(ref{[2..Length(ref)]});
else
Error( "OpenMath reference: the first symbol must be ", CHAR_INT(35), "\n" );
fi;
elif pos2=fail then
# reference to an object in a file
Error("References to files are not implemented yet");
else
# reference to a remote object
if not ref{[1..pos1+2]} = "scscp://" then
Error("Can not parse the reference ", ref, "\n");
fi;
pos3 := PositionNthOccurrence( ref, '/', 3);
server:=ref{[pos1+3..pos2-1]};
port:=Int(ref{[pos2+1..pos3-1]});
name := ref{[pos3+1..Length(ref)]};
if SCSCPserverMode then
# check that the object is on the same server
if [server,port]=[SCSCPserverAddress,SCSCPserverPort] then
if IsBoundGlobal( name ) and
Length( name ) > 12 and
StartsWith( name, "TEMPVarSCSCP" ) then
if SCSCP_UNBIND_MODE then
SCSCP_UNBIND_MODE := false;
return name;
else
return EvalString( name );
fi;
else
Error( "Client request refers to an unbound variable ", node.attributes.href, "\n");
fi;
else # for a "foreign" object
return EvaluateBySCSCP( "retrieve", [ RemoteObject(name,server,port) ], server, port ).object;
fi;
else # in the client's mode
return RemoteObject( node.attributes.href, server, port );
fi;
fi;
else
Error( "OpenMath reference: only href is supported !\n");
fi;
end;
#############################################################################
##
## OMPutProcedureCall ( stream, proc_name, objrec : cd:=cdname )
##
## The first argument is a stream
## The second argument is procedure name as a string.
## The third is a record similar to those returned by
## OMGetObjectWithAttributes, but the objrec.object a list
## of arguments, for example:
## rec ( object := [ SmallGroup(24,12) ],
## attributes := [ [ "option_runtime", 1000 ],
## [ "call_id", "user007" ] ] )
##
InstallGlobalFunction( OMPutProcedureCall,
function( stream, proc_name, objrec )
local writer, cdname, debug_option, has_attributes, attr, nameandargs;
if IN_SCSCP_BINARY_MODE then
writer:=OpenMathBinaryWriter(stream);
else
writer:=OpenMathXMLWriter(stream);
fi;
if IsClosedStream( stream ) then
Error( "OMPutProcedureCall: the 1st argument <proc_name> must be an open stream \n" );
fi;
if IsBound( objrec.object ) and not IsList( objrec.object ) then
Error( "OMPutProcedureCall: in the 3rd argument <objrec.object> must be a list \n" );
fi;
if IsOutputTextStream( stream ) then
SetPrintFormattingStatus( stream, false );
fi;
if ValueOption("cd") <> fail then
cdname := ValueOption("cd");
if cdname="" then
cdname := "scscp_transient_1";
fi;
else
cdname := "scscp_transient_1";
fi;
if ValueOption("debuglevel") <> fail then
debug_option := ValueOption("debuglevel");
else
debug_option := 0;
fi;
OMIndent := 0;
if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage( stream![3][1] ); fi;
WriteLine( stream, "<?scscp start ?>" );
OMPutOMOBJ( writer );
if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then
has_attributes:=true;
OMPutOMATTR( writer );
OMPutOMATP( writer );
for attr in objrec.attributes do
OMPutSymbol( writer, "scscp1", attr[1] );
if attr[1] in [ "call_id", "option_min_memory", "option_max_memory",
"option_runtime", "option_debuglevel" ] then
OMPut( writer, attr[2] );
elif attr[1] in [ "option_return_object",
"option_return_cookie",
"option_return_nothing",
"option_return_deferred" ] then
OMPut( writer, "" );
else
Error("Unsupported option : ", attr[1], "\n" );
fi;
od;
OMPutEndOMATP( writer );
else
has_attributes:=false;
fi;
OMPutOMA( writer );
OMPutSymbol( writer, "scscp1", "procedure_call" );
if proc_name in [ "get_allowed_heads",
"get_service_description",
"get_signature",
"get_transient_cd",
"is_allowed_head",
"retrieve",
"store_session",
"store_persistent",
"unbind" ] then
OMPutApplication( writer, "scscp2", proc_name, objrec.object );
else
OMPutApplication( writer, cdname, proc_name, objrec.object );
fi;
OMPutEndOMA( writer );
if has_attributes then
OMPutEndOMATTR( writer );
fi;
OMPutEndOMOBJ( writer );
WriteLine( stream, "<?scscp end ?>" );
if IsInputOutputTCPStream( stream ) then
IO_Flush( stream![1] );
fi;
return true;
end);
#############################################################################
##
## OMPutProcedureCompleted ( stream, objrec )
##
## The first argument is a stream
## The second argument is a record like the one returned by
## OMGetObjectWithAttributes, for example:
## rec ( object := 120,
## attributes := [ [ "info_runtime", 1000 ],
## [ "info_memory", 2048 ],
## [ "call_id", "user007" ] ] )
##
InstallGlobalFunction( OMPutProcedureCompleted,
function( stream, objrec )
local writer, has_attributes, attr;
if IN_SCSCP_BINARY_MODE then
writer:=OpenMathBinaryWriter(stream);
else
writer:=OpenMathXMLWriter(stream);
fi;
if IsClosedStream( stream ) then
Error( "closed stream" );
fi;
if IsOutputTextStream( stream ) then
SetPrintFormattingStatus( stream, false );
fi;
OMIndent := 0;
if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi;
WriteLine( stream, "<?scscp start ?>" );
OMPutOMOBJ( writer );
if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then
has_attributes:=true;
OMPutOMATTR( writer );
OMPutOMATP( writer );
for attr in objrec.attributes do
if attr[1] in [ "call_id", "info_memory", "info_message", "info_runtime" ] then
OMPutSymbol( writer, "scscp1", attr[1] );
OMPut( writer, attr[2] );
else
Error("Unsupported attribute : ", attr[1], "\n" );
fi;
od;
OMPutEndOMATP( writer );
else
has_attributes:=false;
fi;
if IsBound(objrec.object) then
OMPutApplication( writer, "scscp1", "procedure_completed", [ objrec.object ] );
else
OMPutApplication( writer, "scscp1", "procedure_completed", [ ] );
fi;
if has_attributes then
OMPutEndOMATTR( writer );
fi;
OMPutEndOMOBJ( writer );
WriteLine( stream, "<?scscp end ?>" );
if IsInputOutputTCPStream( stream ) then
IO_Flush( stream![1] );
fi;
return true;
end);
#############################################################################
##
## OMPutProcedureTerminated( stream, objrec, error_cd, error_type )
##
## The first argument is a stream
## The second argument is a record like the one returned by
## OMGetObjectWithAttributes, for example:
## rec ( attributes := [ [ "info_runtime", 1000 ],
## [ "info_memory", 2048 ],
## [ "call_id", "user007" ] ],
## object := "localhost:26133 reports : Rational operations: <divisor> must not be zero")
## The third argument is a string with CD name for the fourth argument.
## The fourth argument is a string with error type, for example
## "error_memory", "error_runtime", "error_system_specific" as defined
## in the 'scscp1' OM CD.
##
InstallGlobalFunction( OMPutProcedureTerminated,
function( stream, objrec, error_cd, error_type )
local writer, has_attributes, attr;
if IN_SCSCP_BINARY_MODE then
writer:=OpenMathBinaryWriter(stream);
else
writer:=OpenMathXMLWriter(stream);
fi;
if IsClosedStream( stream ) then
Error( "closed stream" );
fi;
if IsOutputTextStream( stream ) then
SetPrintFormattingStatus( stream, false );
fi;
OMIndent := 0;
if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi;
WriteLine( stream, "<?scscp start ?>" );
OMPutOMOBJ( writer );
if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then
has_attributes:=true;
OMPutOMATTR( writer );
OMPutOMATP( writer );
for attr in objrec.attributes do
if attr[1] in [ "call_id", "info_memory", "info_runtime" ] then
OMPutSymbol( writer, "scscp1", attr[1] );
OMPut( writer, attr[2] );
else
Error("Unsupported attribute : ", attr[1], "\n" );
fi;
od;
OMPutEndOMATP( writer );
else
has_attributes:=false;
fi;
OMPutOMA( writer );
OMPutSymbol( writer, "scscp1", "procedure_terminated" );
OMPutError( writer, error_cd, error_type, [ objrec.object ] );
OMPutEndOMA( writer );
if has_attributes then
OMPutEndOMATTR( writer );
fi;
OMPutEndOMOBJ( writer );
WriteLine( stream, "<?scscp end ?>" );
if IsInputOutputTCPStream( stream ) then
IO_Flush( stream![1] );
fi;
return true;
end);
###########################################################################
##
#E
##
