1############################################################################# 2## 3#W openmath.g The SCSCP package Alexander Konovalov 4#W Steve Linton 5## 6############################################################################# 7 8SCSCP_UNBIND_MODE := false; 9SCSCP_STORE_SESSION_MODE := true; 10 11############################################################################# 12# 13# SCSCPtransientCDs stores information about transient CDs, 14# namely description and signatures of installed procedures 15# 16BindGlobal( "SCSCPtransientCDs", rec() ); 17MakeReadWriteGlobal( "SCSCPtransientCDs" ); 18 19 20############################################################################## 21# 22# SCSCP_RETRIEVE( <varnameasstring> ) 23# 24InstallGlobalFunction( SCSCP_RETRIEVE, x -> x[1] ); 25 26 27############################################################################## 28# 29# SCSCP_STORE_SESSION( <obj> ) 30# SCSCP_STORE_PERSISTENT( <obj> ) 31# 32# These are dummy functions since the magic is done in RunSCSCPserver 33# 34InstallGlobalFunction( SCSCP_STORE_SESSION, x -> x[1] ); 35InstallGlobalFunction( SCSCP_STORE_PERSISTENT, x -> x[1] ); 36 37 38############################################################################## 39# 40# SCSCP_UNBIND( <varnameasstring> ) 41# 42InstallGlobalFunction( SCSCP_UNBIND, 43function( varnameasstring ) 44UnbindGlobal( varnameasstring[1] ); 45return not IsBoundGlobal( varnameasstring[1] ); 46end); 47 48 49############################################################################## 50# 51# SCSCP_GET_ALLOWED_HEADS( [ ] ) 52# 53InstallGlobalFunction( SCSCP_GET_ALLOWED_HEADS, 54function( x ) 55# the function should have an argument, which in this case will be an 56# empty list, since 'get_allowed_heads' has no arguments 57local range, cd, name, omstr; 58if x <> [] then 59 Print( "WARNING: get_allowed_heads has no arguments, but called with argument ", x, 60 " which will be ignored!\n"); 61fi; 62omstr:="<OMA>\n"; 63Append( omstr, "<OMS cd=\"scscp2\" name=\"symbol_set\"/>\n" ); 64# we may eventually have more than one transient CD, then the loop will be uncommented 65if SCSCPserverAcceptsOnlyTransientCD then 66 range := [ "scscp_transient_1" ]; 67else 68 range := RecNames(OMsymRecord); 69fi; 70for cd in range do 71 for name in RecNames(OMsymRecord.(cd)) do 72 if OMsymRecord.(cd).(name) <> fail then 73 Append( omstr, Concatenation( "<OMS cd=\"", cd, "\" name=\"", name, "\"/>\n" ) ); 74 fi; 75 od; 76od; 77Append( omstr, "</OMA>" ); 78return OMPlainString( omstr ); 79end); 80 81 82############################################################################## 83# 84# SCSCP_IS_ALLOWED_HEAD( <openmathsymbol> ) 85# 86InstallGlobalFunction( SCSCP_IS_ALLOWED_HEAD, 87function( x ) 88local tran, s, symb, t; 89if IsBound( OMsymRecord.(x[1]) ) then 90 if IsBound( OMsymRecord.(x[1]).(x[2]) ) then 91 if OMsymRecord.(x[1]).(x[2]) <> fail then 92 return true; 93 fi; 94 fi; 95fi; 96return false; 97end); 98 99 100############################################################################## 101# 102# SCSCP_GET_SERVICE_DESCRIPTION( [ ] ) 103# 104InstallGlobalFunction( SCSCP_GET_SERVICE_DESCRIPTION, 105function( x ) 106local omstr; 107# the function should have an argument, which in this case will be an 108# empty list, since 'get_allowed_heads' has no arguments 109if x <> [] then 110 Print( "WARNING: get_service_description has no arguments, but called with argument ", x, 111 " which will be ignored!\n"); 112fi; 113omstr:="<OMA>\n<OMS cd=\"scscp2\" name=\"service_description\"/>\n"; 114Append( omstr, Concatenation("<OMSTR>", SCSCPserviceName, "</OMSTR>\n" ) ); 115Append( omstr, Concatenation("<OMSTR>", SCSCPserviceVersion, "</OMSTR>\n" ) ); 116Append( omstr, Concatenation("<OMSTR>", SCSCPserviceDescription, "</OMSTR>\n" ) ); 117Append( omstr, "</OMA>" ); 118return OMPlainString( omstr ); 119end); 120 121 122############################################################################## 123# 124# SCSCP_GET_TRANSIENT_CD( <x> ) 125# 126InstallGlobalFunction( SCSCP_GET_TRANSIENT_CD, 127function( x ) 128local omstr, procname; 129if not IsBound( OMsymRecord.(x[1]) ) then 130 Error("no_such_transient_cd"); 131else 132 omstr:="<CD>\n<CDName>scscp_transient_1</CDName>\n"; 133 Append( omstr, Concatenation( "<CDReviewDate>", DateISO8601(), "</CDReviewDate>\n" ) ); 134 Append( omstr, Concatenation( "<CDDate>", DateISO8601(), "</CDDate>\n" ) ); 135 Append( omstr, Concatenation( "<CDVersion>", "0", "</CDVersion>\n" ) ); 136 Append( omstr, Concatenation( "<CDRevision>", "0", "</CDRevision>\n" ) ); 137 Append( omstr, "<CDStatus>private</CDStatus>\n" ); 138 Append( omstr, "<Description>This is a transient CD for the GAP SCSCP service</Description>\n" ); 139 for procname in RecNames( OMsymRecord.(x[1]) ) do 140 Append( omstr, Concatenation( "<CDDefinition>\n", "<Name>", procname, "</Name>\n" ) ); 141 Append( omstr, Concatenation( "<Description>", 142 SCSCPtransientCDs.(x[1]).(procname).Description, 143 "</Description>\n</CDDefinition>\n" ) ); 144 od; 145fi; 146Append( omstr, "</CD>" ); 147return OMPlainString( omstr ); 148end); 149 150 151############################################################################## 152# 153# SCSCP_GET_SIGNATURE( <openmathsymbol> ) 154# 155InstallGlobalFunction( SCSCP_GET_SIGNATURE, 156function( x ) 157local omstr; 158if not IsBound( OMsymRecord.(x[1]) ) then 159 Error("no_such_transient_cd"); 160else 161 if not IsBound( OMsymRecord.(x[1]).(x[2]) ) then 162 Error("no_such_symbol"); 163 else 164 omstr:="<OMA>\n<OMS cd=\"scscp2\" name=\"signature\"/>\n"; 165 Append( omstr, Concatenation( "<OMS cd=\"", x[1], "\" name=\"", x[2], "\"/>\n" ) ); 166 Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Minarg : noomobj ), "\n" ) ); 167 Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Maxarg : noomobj ), "\n" ) ); 168 Append( omstr, "<OMS cd=\"scscp2\" name=\"symbol_set_all\"/>\n" ); 169 Append( omstr, "</OMA>" ); 170 return OMPlainString( omstr ); 171 fi; 172fi; 173end); 174 175 176############################################################################# 177## 178## Extending global record OMsymRecord previously created in OpenMath package 179## 180OMsymRecord.scscp1 := rec( 181 procedure_call := x -> x[1], # x is already converted from OM to GAP 182 procedure_completed := 183 function(x); 184 if IsBound(x[1]) then 185 return x[1]; 186 else # when no object is returned 187 return "procedure completed"; 188 fi; 189 end, 190 procedure_terminated := x -> x[1], 191 call_id := "call_id", 192 info_memory := "info_memory", 193 info_message := "info_message", 194 info_runtime := "info_runtime", 195 option_debuglevel := "option_debuglevel", 196 option_max_memory := "option_max_memory", 197 option_min_memory := "option_min_memory", 198 option_return_cookie := "option_return_cookie", 199 option_return_object := "option_return_object", 200 option_return_nothing := "option_return_nothing", 201 option_return_deferred := "option_return_deferred", 202 option_runtime := "option_runtime", 203 error_CAS := "error_CAS" 204); 205 206OMsymRecord.scscp2 := rec( 207 store_session := SCSCP_STORE_SESSION, 208 store_persistent := SCSCP_STORE_PERSISTENT, 209 retrieve := SCSCP_RETRIEVE, 210 unbind := SCSCP_UNBIND, 211 get_allowed_heads := SCSCP_GET_ALLOWED_HEADS, 212 is_allowed_head := SCSCP_IS_ALLOWED_HEAD, 213 get_service_description := SCSCP_GET_SERVICE_DESCRIPTION, 214 get_transient_cd := SCSCP_GET_TRANSIENT_CD, 215 get_signature := SCSCP_GET_SIGNATURE 216); 217 218OMsymRecord.meta := rec( 219 CDName := x -> x[1] 220); 221 222 223############################################################################# 224## 225#F OMGetObjectWithAttributes( <stream> ) 226## 227## <stream> is an input stream with an OpenMath object on it. 228## Takes precisely one object off <stream> (using PipeOpenMathObject) 229## and puts it into a string. 230## From there the OpenMath object is turned into a record r with fields 231## r.object, containing the corresponding GAP object, and r.attributes, 232## which is a list of pairs [ name, value ], for example 233## [ ["call_id", "user007" ], ["option_runtime", 300000] ] 234## This is a counterpart of the function OMGetObject from OpenMath package . 235## 236InstallGlobalFunction( OMGetObjectWithAttributes, 237function( stream ) 238 local return_tree, 239 fromgap, # string 240 firstbyte, 241 gap_obj, 242 success, # whether PipeOpenMathObject worked 243 readline; 244 245 if IsClosedStream( stream ) then 246 Error( "closed stream" ); 247 elif IsEndOfStream( stream ) then 248 Error( "end of stream" ); 249 fi; 250 251 if ValueOption("return_tree") <> fail then 252 return_tree := true; 253 else 254 return_tree := false; 255 fi; 256 257 # read new line until <?scscp start ?> 258 repeat 259 readline:=ReadLine(stream); 260 if readline=fail then 261 return fail; 262 fi; 263 NormalizeWhitespace( readline ); 264 if Length( readline ) > 0 then 265 Info( InfoSCSCP, 2, readline ); 266 fi; 267 until readline= "<?scscp start ?>"; 268 269 firstbyte := ReadByte(stream); 270 271 if firstbyte = 24 then 272 # Reading binary encoding => set reply mode to binary 273 IN_SCSCP_BINARY_MODE:=true; 274 gap_obj := GetNextObject( stream, firstbyte ); 275 gap_obj := OMParseXmlObj( gap_obj.content[1] ); 276 return rec( object := gap_obj, attributes := OMParseXmlObj( OMTempVars.OMATTR ) ); 277 else 278 279 if firstbyte = fail then 280 Info( InfoSCSCP, 2, "OpenMath object not retrieved by PipeOpenMathObject" ); 281 return fail; 282 fi; 283 284 # Reading XML encoding => set reply mode to XML 285 IN_SCSCP_BINARY_MODE:=false; 286 fromgap := ""; 287 # Get one OpenMath object from 'stream' and put into 'fromgap', 288 # using PipeOpenMathObject 289 290 success := PipeOpenMathObject( stream, fromgap, firstbyte ); 291 292 if success <> true then 293 Info( InfoSCSCP, 2, "OpenMath object not retrieved by PipeOpenMathObject" ); 294 return fail; 295 fi; 296 297 # Now 'fromgap' is the string with OpenMath encoding 298 299 if InfoLevel( InfoSCSCP ) > 2 then 300 Print("#I Received message: \n"); 301 Print( fromgap ); 302 Print( "\n" ); 303 fi; 304 305 # read new line until <?scscp end ?> 306 repeat 307 readline:=ReadLine(stream); 308 if readline=fail then 309 return fail; 310 fi; 311 NormalizeWhitespace( readline ); 312 if Length( readline ) > 0 then 313 Info( InfoSCSCP, 2, readline ); 314 fi; 315 until readline= "<?scscp end ?>"; 316 317 # convert the OpenMath string into a Gap object using an appropriate 318 # function 319 320 if return_tree then 321 return OMgetObjectXMLTreeWithAttributes( fromgap : return_tree ); 322 else 323 return OMgetObjectXMLTreeWithAttributes( fromgap ); 324 fi; 325 fi; 326end ); 327 328 329############################################################################# 330## 331#F OMgetObjectXMLTreeWithAttributes(string) 332## 333## This is a counterpart of the OpenMath function OMgetObjectXMLTree 334## 335InstallGlobalFunction( OMgetObjectXMLTreeWithAttributes, 336function(string) 337 local return_tree, return_deferred, node, attrs, t, obj, pos, name; 338 339 if ValueOption("return_tree") <> fail then 340 return_tree := true; 341 else 342 return_tree := false; 343 fi; 344 345 OMTempVars.OMBIND := rec( ); 346 OMTempVars.OMREF := rec( ); 347 348 # This is the difference from OMgetObjectXMLTree 349 OMTempVars.OMATTR := rec( ); 350 351 node := ParseTreeXMLString( string ).content[1]; 352 353 node.content := Filtered( node.content, OMIsNotDummyLeaf ); 354 355 # Print( "ParseTreeXMLString( string ) = ", node.content, "\n" ); 356 357 attrs := List( Filtered( node.content[1].content, t -> t.name = "OMATP" ), OMParseXmlObj ); 358 359 if Length(attrs)=1 then 360 attrs:=attrs[1]; 361 fi; 362 363 # At this point we already know attributes BEFORE the the real computation is started. 364 # This allows us to know in advance which kind of return (object/cookie/tree) 365 # is expected, and which runtime and memory limits were specified, if any. 366 367 # Now we will check that this is really procedure_call message and that 368 # the procedure is allowed, that is, it is from scscp{1,2} or scscp_transient_X CD 369 370 if SCSCPserverMode then 371 372 SCSCP_UNBIND_MODE := false; 373 SCSCP_STORE_SESSION_MODE := true; 374 375 pos:=PositionProperty( node.content[1].content, r -> r.name="OMA"); # expected scscp1.procedure_call 376 if pos=fail then 377 return rec( object := [ "Message rejected: it must be a proper scscp1.procedure_call" ], 378 attributes := attrs, is_error:=true ); 379 else 380 node.content[1].content[pos].content := 381 Filtered( node.content[1].content[pos].content, OMIsNotDummyLeaf ); 382 if not IsBound( node.content[1].content[pos].content[1] ) or 383 not IsBound( node.content[1].content[pos].content[1].attributes ) or 384 not node.content[1].content[pos].content[1].attributes in 385 [ rec( name := "procedure_call", cd := "scscp1" ), 386 rec( name := "procedure_completed", cd := "scscp1" ), 387 rec( name := "procedure_terminated", cd := "scscp1") ] 388 then 389 return rec( object := [ "Message rejected because it is not a proper scscp1.procedure_call" ], 390 attributes := attrs, is_error:=true ); 391 else 392 node.content[1].content[pos].content[2].content := 393 Filtered( node.content[1].content[pos].content[2].content, OMIsNotDummyLeaf ); 394 if not IsBound( node.content[1].content[pos].content[2].content[1] ) or 395 not IsBound( node.content[1].content[pos].content[2].content[1].attributes ) or 396 not IsBound( node.content[1].content[pos].content[2].content[1].attributes.cd ) then 397 return rec( object := [ "Message rejected because it is not properly formatted" ], 398 attributes := attrs, is_error:=true ); 399 elif SCSCPserverAcceptsOnlyTransientCD and 400 # check that we are not parsing procedure_completed message 401 # while resolving a reference to a remote object 402 not node.content[1].content[pos].content[1].attributes = 403 rec( name := "procedure_completed", cd := "scscp1" ) and 404 ( Length( node.content[1].content[pos].content[2].content[1].attributes.cd ) < 5 or 405 not node.content[1].content[pos].content[2].content[1].attributes.cd{[1..5]} = "scscp" ) then 406 return rec( object := [ 407 "Message rejected because the procedure ", 408 node.content[1].content[pos].content[2].content[1].attributes.cd, ".", 409 node.content[1].content[pos].content[2].content[1].attributes.name, 410 " is not allowed"], 411 attributes := attrs, is_error:=true ); 412 else 413 # some checks for some particular special procedures might be here 414 if node.content[1].content[pos].content[2].content[1].attributes.cd = "scscp2" then 415 name := node.content[1].content[pos].content[2].content[1].attributes.name; 416 if name = "unbind" then 417 SCSCP_UNBIND_MODE := true; 418 elif name = "store_persistent" then 419 SCSCP_STORE_SESSION_MODE := false; 420 fi; 421 fi; 422 fi; 423 fi; 424 fi; 425 426 fi; 427 428 # if the security check is done, we may proceed 429 if ForAny( attrs, t -> t[1]="option_return_deferred" ) then 430 return_deferred := true; 431 else 432 return_deferred := false; 433 fi; 434 435 if return_tree or return_deferred then 436 obj := node.content[1]; 437 else 438 obj := OMParseXmlObj( node.content[1] ); 439 fi; 440 441 # the next check was is a temporary measure to verify that 442 # attributes were identified properly 443 444 #if OMTempVars.OMATTR <> rec() then 445 # if OMParseXmlObj( OMTempVars.OMATTR ) <> attrs then 446 # Error("Attributes were not properly identified:\n", 447 # "OMParseXmlObj( OMTempVars.OMATTR ) = ", OMParseXmlObj( OMTempVars.OMATTR ), "\n", 448 # "attrs = ", attrs ); 449 # fi; 450 #fi; 451 452 return rec( object:=obj, attributes:=attrs ); 453end ); 454 455 456############################################################################# 457## 458## OMObjects.OMATTR( node ) 459## 460## we overwrite the OpenMath function OMObjects.OMATTR with our definition 461## (if OMObjects.OMATTR will be called from OpenMath, the OMTempWars.OMATTR 462## will be ignored) 463## 464OMObjects.OMATTR := function ( node ) 465OMTempVars.OMATTR:=Filtered( node.content, 466 function ( x ) 467 return x.name = "OMATP"; 468 end )[1]; 469node.content := Filtered( node.content, 470 function ( x ) 471 return x.name <> "OMATP"; 472 end ); 473return OMParseXmlObj( node.content[1] ); 474end; 475 476 477############################################################################# 478## 479## OMObjects.OMATP( node ) 480## 481## We add OMObjects.OMATP function to the list of functions OMObjects 482## defined as a global variable in the OpenMath package 483## 484OMObjects.OMATP := function ( node ) 485local i; 486#DisplayXMLStructure(node); 487return List( [1,3..Length(node.content)-1], i -> 488 [ OMParseXmlObj(node.content[i]), OMParseXmlObj(node.content[i+1]) ] ); 489end; 490 491 492############################################################################# 493## 494## OMObjects.OMR( node ) 495## 496## This overwrites OMObjects.OMR defined in OpenMath package as 497## return OMTempVars.OMREF.(node.attributes.href); 498## 499OMObjects.OMR := function ( node ) 500local ref, pos1, pos2, pos3, name, server, port; 501if IsBound( node.attributes.href ) then 502 ref := node.attributes.href; 503 pos1:=PositionSublist( ref, "://" ); 504 pos2:=PositionNthOccurrence( ref, ':', 2); 505 if pos1=fail then 506 # reference to an object within the same OpenMath document 507 if ref[1]=CHAR_INT(35) then 508 return OMTempVars.OMREF.(ref{[2..Length(ref)]}); 509 else 510 Error( "OpenMath reference: the first symbol must be ", CHAR_INT(35), "\n" ); 511 fi; 512 elif pos2=fail then 513 # reference to an object in a file 514 Error("References to files are not implemented yet"); 515 else 516 # reference to a remote object 517 if not ref{[1..pos1+2]} = "scscp://" then 518 Error("Can not parse the reference ", ref, "\n"); 519 fi; 520 pos3 := PositionNthOccurrence( ref, '/', 3); 521 server:=ref{[pos1+3..pos2-1]}; 522 port:=Int(ref{[pos2+1..pos3-1]}); 523 name := ref{[pos3+1..Length(ref)]}; 524 if SCSCPserverMode then 525 # check that the object is on the same server 526 if [server,port]=[SCSCPserverAddress,SCSCPserverPort] then 527 if IsBoundGlobal( name ) and 528 Length( name ) > 12 and 529 StartsWith( name, "TEMPVarSCSCP" ) then 530 if SCSCP_UNBIND_MODE then 531 SCSCP_UNBIND_MODE := false; 532 return name; 533 else 534 return EvalString( name ); 535 fi; 536 else 537 Error( "Client request refers to an unbound variable ", node.attributes.href, "\n"); 538 fi; 539 else # for a "foreign" object 540 return EvaluateBySCSCP( "retrieve", [ RemoteObject(name,server,port) ], server, port ).object; 541 fi; 542 else # in the client's mode 543 return RemoteObject( node.attributes.href, server, port ); 544 fi; 545 fi; 546else 547 Error( "OpenMath reference: only href is supported !\n"); 548fi; 549end; 550 551 552############################################################################# 553## 554## OMPutProcedureCall ( stream, proc_name, objrec : cd:=cdname ) 555## 556## The first argument is a stream 557## The second argument is procedure name as a string. 558## The third is a record similar to those returned by 559## OMGetObjectWithAttributes, but the objrec.object a list 560## of arguments, for example: 561## rec ( object := [ SmallGroup(24,12) ], 562## attributes := [ [ "option_runtime", 1000 ], 563## [ "call_id", "user007" ] ] ) 564## 565InstallGlobalFunction( OMPutProcedureCall, 566function( stream, proc_name, objrec ) 567local writer, cdname, debug_option, has_attributes, attr, nameandargs; 568if IN_SCSCP_BINARY_MODE then 569 writer:=OpenMathBinaryWriter(stream); 570else 571 writer:=OpenMathXMLWriter(stream); 572fi; 573if IsClosedStream( stream ) then 574 Error( "OMPutProcedureCall: the 1st argument <proc_name> must be an open stream \n" ); 575fi; 576 577if IsBound( objrec.object ) and not IsList( objrec.object ) then 578 Error( "OMPutProcedureCall: in the 3nd argument <objrec.object> must be a list \n" ); 579fi; 580 581if IsOutputTextStream( stream ) then 582 SetPrintFormattingStatus( stream, false ); 583fi; 584 585if ValueOption("cd") <> fail then 586 cdname := ValueOption("cd"); 587 if cdname="" then 588 cdname := "scscp_transient_1"; 589 fi; 590else 591 cdname := "scscp_transient_1"; 592fi; 593 594if ValueOption("debuglevel") <> fail then 595 debug_option := ValueOption("debuglevel"); 596else 597 debug_option := 0; 598fi; 599 600OMIndent := 0; 601if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage( stream![3][1] ); fi; 602WriteLine( stream, "<?scscp start ?>" ); 603OMPutOMOBJ( writer ); 604if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then 605 has_attributes:=true; 606 OMPutOMATTR( writer ); 607 OMPutOMATP( writer ); 608 for attr in objrec.attributes do 609 OMPutSymbol( writer, "scscp1", attr[1] ); 610 if attr[1] in [ "call_id", "option_min_memory", "option_max_memory", 611 "option_runtime", "option_debuglevel" ] then 612 OMPut( writer, attr[2] ); 613 elif attr[1] in [ "option_return_object", 614 "option_return_cookie", 615 "option_return_nothing", 616 "option_return_deferred" ] then 617 OMPut( writer, "" ); 618 else 619 Error("Unsupported option : ", attr[1], "\n" ); 620 fi; 621 od; 622 OMPutEndOMATP( writer ); 623else 624 has_attributes:=false; 625fi; 626OMPutOMA( writer ); 627OMPutSymbol( writer, "scscp1", "procedure_call" ); 628if proc_name in [ "get_allowed_heads", 629 "get_service_description", 630 "get_signature", 631 "get_transient_cd", 632 "is_allowed_head", 633 "retrieve", 634 "store_session", 635 "store_persistent", 636 "unbind" ] then 637 OMPutApplication( writer, "scscp2", proc_name, objrec.object ); 638else 639 OMPutApplication( writer, cdname, proc_name, objrec.object ); 640fi; 641OMPutEndOMA( writer ); 642if has_attributes then 643 OMPutEndOMATTR( writer ); 644fi; 645OMPutEndOMOBJ( writer ); 646WriteLine( stream, "<?scscp end ?>" ); 647if IsInputOutputTCPStream( stream ) then 648 IO_Flush( stream![1] ); 649fi; 650return true; 651end); 652 653 654############################################################################# 655## 656## OMPutProcedureCompleted ( stream, objrec ) 657## 658## The first argument is a stream 659## The second argument is a record like the one returned by 660## OMGetObjectWithAttributes, for example: 661## rec ( object := 120, 662## attributes := [ [ "info_runtime", 1000 ], 663## [ "info_memory", 2048 ], 664## [ "call_id", "user007" ] ] ) 665## 666InstallGlobalFunction( OMPutProcedureCompleted, 667function( stream, objrec ) 668local writer, has_attributes, attr; 669if IN_SCSCP_BINARY_MODE then 670 writer:=OpenMathBinaryWriter(stream); 671else 672 writer:=OpenMathXMLWriter(stream); 673fi; 674if IsClosedStream( stream ) then 675 Error( "closed stream" ); 676fi; 677if IsOutputTextStream( stream ) then 678 SetPrintFormattingStatus( stream, false ); 679fi; 680OMIndent := 0; 681if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi; 682WriteLine( stream, "<?scscp start ?>" ); 683OMPutOMOBJ( writer ); 684if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then 685 has_attributes:=true; 686 OMPutOMATTR( writer ); 687 OMPutOMATP( writer ); 688 for attr in objrec.attributes do 689 if attr[1] in [ "call_id", "info_memory", "info_message", "info_runtime" ] then 690 OMPutSymbol( writer, "scscp1", attr[1] ); 691 OMPut( writer, attr[2] ); 692 else 693 Error("Unsupported attribute : ", attr[1], "\n" ); 694 fi; 695 od; 696 OMPutEndOMATP( writer ); 697else 698 has_attributes:=false; 699fi; 700if IsBound(objrec.object) then 701 OMPutApplication( writer, "scscp1", "procedure_completed", [ objrec.object ] ); 702else 703 OMPutApplication( writer, "scscp1", "procedure_completed", [ ] ); 704fi; 705if has_attributes then 706 OMPutEndOMATTR( writer ); 707fi; 708OMPutEndOMOBJ( writer ); 709WriteLine( stream, "<?scscp end ?>" ); 710if IsInputOutputTCPStream( stream ) then 711 IO_Flush( stream![1] ); 712fi; 713return true; 714end); 715 716 717############################################################################# 718## 719## OMPutProcedureTerminated( stream, objrec, error_cd, error_type ) 720## 721## The first argument is a stream 722## The second argument is a record like the one returned by 723## OMGetObjectWithAttributes, for example: 724## rec ( attributes := [ [ "info_runtime", 1000 ], 725## [ "info_memory", 2048 ], 726## [ "call_id", "user007" ] ], 727## object := "localhost:26133 reports : Rational operations: <divisor> must not be zero") 728## The third argument is a string with CD name for the fourth argument. 729## The fourth argument is a string with error type, for example 730## "error_memory", "error_runtime", "error_system_specific" as defined 731## in the 'scscp1' OM CD. 732## 733InstallGlobalFunction( OMPutProcedureTerminated, 734function( stream, objrec, error_cd, error_type ) 735local writer, has_attributes, attr; 736if IN_SCSCP_BINARY_MODE then 737 writer:=OpenMathBinaryWriter(stream); 738else 739 writer:=OpenMathXMLWriter(stream); 740fi; 741if IsClosedStream( stream ) then 742 Error( "closed stream" ); 743fi; 744if IsOutputTextStream( stream ) then 745 SetPrintFormattingStatus( stream, false ); 746fi; 747OMIndent := 0; 748if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi; 749WriteLine( stream, "<?scscp start ?>" ); 750OMPutOMOBJ( writer ); 751if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then 752 has_attributes:=true; 753 OMPutOMATTR( writer ); 754 OMPutOMATP( writer ); 755 for attr in objrec.attributes do 756 if attr[1] in [ "call_id", "info_memory", "info_runtime" ] then 757 OMPutSymbol( writer, "scscp1", attr[1] ); 758 OMPut( writer, attr[2] ); 759 else 760 Error("Unsupported attribute : ", attr[1], "\n" ); 761 fi; 762 od; 763 OMPutEndOMATP( writer ); 764else 765 has_attributes:=false; 766fi; 767OMPutOMA( writer ); 768OMPutSymbol( writer, "scscp1", "procedure_terminated" ); 769OMPutError( writer, error_cd, error_type, [ objrec.object ] ); 770OMPutEndOMA( writer ); 771if has_attributes then 772 OMPutEndOMATTR( writer ); 773fi; 774OMPutEndOMOBJ( writer ); 775WriteLine( stream, "<?scscp end ?>" ); 776if IsInputOutputTCPStream( stream ) then 777 IO_Flush( stream![1] ); 778fi; 779return true; 780end); 781 782########################################################################### 783## 784#E 785## 786