home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / clisp / src / archive / clisp.src.lha / src / rexx.d < prev    next >
Text File  |  1996-07-21  |  22KB  |  549 lines
  1. # Rexx-Interface für CLISP
  2. # Jörg Höhle 10.2.1994
  3.  
  4.  
  5. #include "lispbibl.c"
  6.  
  7. #ifdef AMIGAOS
  8.  
  9. #include "amiga2.c"
  10.  
  11. # ARexx 'library base' pointer:
  12. # (Muß global sichtbar sein und diesen Namen tragen, damit's der Linker findet!)
  13.   global struct RxsLib * RexxSysBase = NULL;
  14.  
  15.  
  16. #ifdef DEBUG_REXX
  17.   #define debug_asciz_out  asciz_out
  18.   #define debug_dez_out  dez_out
  19.   #define debug_hex_out  hex_out
  20. #else
  21.   #define debug_asciz_out(x)
  22.   #define debug_dez_out(x)
  23.   #define debug_hex_out(x)
  24. #endif
  25.  
  26.  
  27. # Fehlermeldung wenn kein Rexx möglich
  28. # fehler_norexx();
  29. # > subr_self: Aufrufer (ein SUBR)
  30.   nonreturning_function(local, fehler_norexx, (void));
  31.   local void fehler_norexx()
  32.     { 
  33.       //: DEUTSCH "Keine Kommunikation mit ARexx möglich."
  34.       //: ENGLISH "Communication with ARexx isn't possible."
  35.       //: FRANCAIS "La communication avec ARexx n'est pas possible."
  36.       fehler(error, GETTEXT("Communication with ARexx isn't possible."));
  37.     }
  38.  
  39. # Speicher freigeben, der wegen Fehler nicht freigegeben wurde.
  40.   local UBYTE* rexxLostArgstr = NULL;
  41.   local void handle_lost_argstr (void);
  42.   local void handle_lost_argstr()
  43.     { if (rexxLostArgstr)
  44.         { begin_system_call();
  45.           DeleteArgstring(rexxLostArgstr);
  46.           end_system_call();
  47.           rexxLostArgstr = NULL;
  48.     }   }
  49.  
  50. # Die Anzahl der auf Antwort (durch andere Prozesse) wartenden Messages:
  51.   local uintC rexxNeededReplies = 0;
  52.  
  53. # O(rexx_inmsg_list) ist eine Liste von Foreigns, die jeweils die ein-
  54. # gegangenen und auf Antwort (durch CLISP) wartenden Messages repräsentieren.
  55.  
  56. # Sucht eine gegebene Message in O(rexx_inmsg_list):
  57.   local object find_inmsg (FOREIGN pointer);
  58.   local object find_inmsg(pointer)
  59.     var reg2 FOREIGN pointer;
  60.     { var reg1 object current;
  61.       for (current = O(rexx_inmsg_list); consp(current); current = Cdr(current))
  62.         { if (TheFpointer(Car(current))->fp_pointer == pointer) { return Car(current); } }
  63.       return NIL;
  64.     }
  65.  
  66. # Der Message Port, auf dem wir arbeiten:
  67.   local struct MsgPort * rexxPort = NULL;
  68. # Sein Name:
  69.   local UBYTE rexxPortName[] = {'C','L','I','S','P','1','\0','\0'};
  70. # Position der Ziffer darin:
  71.   #define NRPOSITION 5
  72. # Default-Extension für ARexx-Kommandofiles:
  73.   local UBYTE rexxExtension[] = "cl";
  74. # Signalnummer, mit der wir auf Ereignisse an diesem Port warten können:
  75.   local ULONG rexxPortBit = 0UL;
  76.  
  77. LISPFUN(rexx_put,1,0,norest,key,6,\
  78.         (kw(result),kw(string),kw(token),kw(async),kw(io),kw(return)) )
  79.   { # Stackaufbau: string/array, resultp, stringp, tokenp, asyncp, iop, returnp.
  80.     # > string/array: String für Kommando inklusive Argumente oder
  81.     #                 Array von Strings für Funktion und Argumente
  82.     # > resultp: Flag: Antwort merken?
  83.     # > stringp: Flag: ARexx Argument als Befehle oder
  84.     #                  erstes Token als Dateiname verstehen?
  85.     # > tokenp: Flag: Soll ARexx Tokens erzeugen?
  86.     # > asyncp: Flag: Nachricht asynchron bearbeiten?
  87.     # > iop: Flag: E/A Kanäle übernehmen?
  88.     # > returnp: Flag: Auf Antwort warten?!?
  89.     # Es sind nicht alle Kombinationen sinvoll.
  90.     var reg4 uintL vargs; # 1 + Zahl Funktionsargumente
  91.     var reg5 boolean functionp; # Funktions- statt Kommandoaufruf
  92.     if (rexxPort == NULL) { fehler_norexx(); }
  93.     # vorsorglich ein Foreign allozieren:
  94.     pushSTACK(allocate_fpointer(NULL));
  95.    {var reg6 object* args_pointer = args_end_pointer;
  96.     # Erstes Argument verarbeiten:
  97.     if (mstringp(STACK_(6+1)))
  98.       { # String
  99.         functionp = FALSE;
  100.         STACK_(6+1) = coerce_ss(STACK_(6+1));
  101.       }
  102.       else
  103.       { functionp = TRUE;
  104.         # sollte (Simple-)Vector sein:
  105.         # evtl.: STACK_(6+1) = coerce_sequence(STACK_(6+1),S(simple_vector));
  106.         if (!m_simple_vector_p(STACK_(6+1)))
  107.           { pushSTACK(STACK_(6+1)); # Wert für Slot DATUM von TYPE-ERROR
  108.             pushSTACK(S(simple_vector)); # Wert für Slot EXPECTED-TYPE von TYPE-ERROR
  109.             pushSTACK(STACK_1);
  110.             //: DEUTSCH "~ muß ein String für Kommandos oder ein Vektor von Strings für eine Funktion sein."
  111.             //: ENGLISH "~ must be a string for commands or a vector of strings for a function"
  112.             //: FRANCAIS "~ doit être une chaîne pour une commande ou un vecteur de chaînes pour une fonction."
  113.             fehler(type_error, GETTEXT("~ must be a string for commands or a vector of strings for a function"));
  114.           }
  115.         vargs = TheSvector(STACK_(6+1))->length;
  116.         if (!( /* vargs > 0 && */ vargs-1 <= MAXRMARG))
  117.           { pushSTACK(STACK_(6+1));
  118.             pushSTACK(fixnum(MAXRMARG));
  119.             pushSTACK(S(rexx_put));
  120.             //: DEUTSCH "~: ARexx Funktion muß 0 bis ~ Argumente haben: ~"
  121.             //: ENGLISH "~: an ARexx function must have 0 to ~ arguments: ~"
  122.             //: FRANCAIS "~ : Une fonction ARexx a de 0 à ~ arguments : ~"
  123.             fehler(error, GETTEXT("~: an ARexx function must have 0 to ~ arguments: ~"));
  124.           }
  125.         # Alle Argumentstrings aus dem Vektor auf dem Stack ablegen:
  126.        {var reg3 object* vptr = &STACK_(6+1);
  127.         var reg2 uintL index;
  128.         for (index = 0; index < vargs; index++)
  129.           { var reg1 object arg = TheSvector(*vptr)->data[index];
  130.             if (!stringp(arg))
  131.               { pushSTACK(arg); # Wert für Slot DATUM von TYPE-ERROR
  132.                 pushSTACK(S(string)); # Wert für Slot EXPECTED-TYPE von TYPE-ERROR
  133.                 pushSTACK(arg);
  134.                 pushSTACK(S(rexx_put));
  135.                 //: DEUTSCH "~: Muß für ARexx ein String sein: ~"
  136.                 //: ENGLISH "~: must be a string for ARexx: ~"
  137.                 //: FRANCAIS "~ : Doit être une chaîne pour ARexx : ~"
  138.                 fehler(type_error, GETTEXT("~: must be a string for ARexx: ~"));
  139.               }
  140.             # Argument in Simple-String umwandeln:
  141.             pushSTACK(coerce_ss(arg));
  142.       }}  }
  143.     # Stackaufbau: ... string/vector ..(6).. foreign ..(vargs).. .
  144.     # Ab hier für eine Weile keine GC mehr
  145.     { var reg3 struct RexxMsg * rexxmsg;
  146.       debug_asciz_out("%REXX-PUT: ");
  147.       begin_system_call();
  148.       rexxmsg = CreateRexxMsg(rexxPort,rexxExtension,rexxPortName);
  149.       end_system_call();
  150.       if (!(rexxmsg == NULL))
  151.         # vorerst erfolgreich
  152.         { var reg4 boolean success;
  153.           if (functionp)
  154.             { # ARexx Funktionsaufruf
  155.               debug_asciz_out("function ");
  156.               # Argumente einfüllen:
  157.               { var reg2 uintL i;
  158.                 var reg2 object* argptr = args_pointer;
  159.                 success = TRUE;
  160.                 begin_system_call();
  161.                 for (i=0; i<vargs; i++)
  162.                   { var reg1 object s = NEXT(argptr);
  163.                     if ((rexxmsg->rm_Args[i] = CreateArgstring(&TheSstring(s)->data[0],TheSstring(s)->length)) == NULL)
  164.                       { if (i>0) ClearRexxMsg(rexxmsg,i);
  165.                         success = FALSE;
  166.                         break;
  167.                   }   }
  168.                 end_system_call();
  169.               }
  170.               set_args_end_pointer(args_pointer); # Stack aufräumen
  171.             }
  172.             else
  173.             { # ARexx Kommando
  174.               debug_asciz_out("command ");
  175.               begin_system_call();
  176.               if (rexxmsg->rm_Args[0] = CreateArgstring(&TheSstring(STACK_(6+1))->data[0],TheSstring(STACK_(6+1))->length))
  177.                 { success = TRUE; }
  178.                 else
  179.                 { success = FALSE; }
  180.               end_system_call();
  181.             }
  182.           # Stackaufbau: ... string/vector ..(6).. foreign.
  183.           if (success)
  184.             # vorerst immer noch erfolgreich
  185.             { rexxmsg->rm_Action = (functionp ? (RXFUNC | (vargs-1)) : RXCOMM);
  186.               # Keyword-Argumente verarbeiten:
  187.               #define is_set(obj)  (!(eq(obj,unbound) || nullp(obj)))
  188.               # :RESULT-Argument:
  189.               if (is_set(STACK_(5+1))) { rexxmsg->rm_Action |= RXFF_RESULT; }
  190.               # :STRING-Argument:
  191.               if (is_set(STACK_(4+1))) { rexxmsg->rm_Action |= RXFF_STRING; }
  192.               # :TOKEN-Argument:
  193.               if (is_set(STACK_(3+1))) { rexxmsg->rm_Action |= RXFF_TOKEN; }
  194.               # :IO-Argument:
  195.               if (!is_set(STACK_(1+1))) { rexxmsg->rm_Action |= RXFF_NOIO; }
  196.               # :RETURN-Argument:
  197.               if (!is_set(STACK_(0+1))) { rexxmsg->rm_Action |= RXFF_NONRET; }
  198.               rexxmsg->rm_Node.mn_Node.ln_Name = RXSDIR;
  199.               { var reg2 boolean asyncp = is_set(STACK_(2+1)); # :ASYNCP-Argument
  200.                 var reg1 struct MsgPort* arexxport;
  201.                 begin_system_call();
  202.                 Forbid();
  203.                 arexxport = FindPort(asyncp ? RXADIR : RXSDIR);
  204.                 if (!(arexxport==NULL))
  205.                   # Message abschicken:
  206.                   { PutMsg(arexxport,(struct Message *)rexxmsg); }
  207.                   else
  208.                   { success = FALSE; }
  209.                 Permit();
  210.                 end_system_call();
  211.               }
  212.               #undef is_set
  213.               if (success)
  214.                 # erfolgreich -> mitzählen:
  215.                 { rexxNeededReplies++;
  216.                   TheFpointer(STACK_0)->fp_pointer = rexxmsg;
  217.                   debug_hex_out(rexxmsg);
  218.                 }
  219.                 else
  220.                 # nicht erfolgreich -> aufräumen:
  221.                 { begin_system_call();
  222.                   if (functionp)
  223.                     { ClearRexxMsg(rexxmsg,vargs); }
  224.                   else
  225.                     { DeleteArgstring(rexxmsg->rm_Args[0]); }
  226.                   end_system_call();
  227.             }   }
  228.           if (success)
  229.             { value1 = STACK_0; } # Wert ist das Foreign zu rexxmsg
  230.             else
  231.             # Nachricht konnte nicht erfolgreich abgeschickt werden, also löschen
  232.             { begin_system_call();
  233.               DeleteRexxMsg(rexxmsg);
  234.               end_system_call();
  235.               value1 = NIL;
  236.         }   }
  237.         else
  238.         { set_args_end_pointer(args_pointer); # Stack aufräumen
  239.           value1 = NIL;
  240.         }
  241.       debug_asciz_out(CRLFstring);
  242.     }
  243.     mv_count=1; skipSTACK(7+1);
  244.   }}
  245.  
  246. # Warten, bis am Port eine Message eintrifft oder Ctrl-C.
  247. # Ergebnis ist ein Flag, das angibt, ob eine Message eintraf.
  248.   local boolean rexx_wait (void);
  249.   local boolean rexx_wait()
  250.     { start:
  251.       begin_system_call();
  252.      {var LONG wait_erg = Wait(rexxPortBit | SIGBREAKF_CTRL_C);
  253.       end_system_call();
  254.       #if 0 # spätere asynchrone DOS-Packet-Bearbeitung ??
  255.       if (wait_erg & ioPortBit)
  256.         { flush_io_queue(); }
  257.       #endif
  258.       if (wait_erg & SIGBREAKF_CTRL_C)
  259.         { # Bearbeitung einer evtl. Message verschieben:
  260.           if (wait_erg & rexxPortBit)
  261.             { begin_system_call(); SetSignal(wait_erg,rexxPortBit); end_system_call(); }
  262.           # Ctrl-C behandeln:
  263.           pushSTACK(S(rexx_wait_input)); tast_break();
  264.           goto start;
  265.         }
  266.         else
  267.         { if (wait_erg & rexxPortBit)
  268.             return TRUE;
  269.             else
  270.             return FALSE; # eigentlich nicht möglich
  271.         }
  272.     }}
  273.  
  274. # (SYSTEM::REXX-WAIT-INPUT) wartet bis am AREXX-Port etwas anliegt,
  275. # und liefert dann T.
  276. LISPFUNN(rexx_wait_input,0)
  277.   { if (!(rexxPort == NULL))
  278.       { if (rexx_wait())
  279.           { value1 = T; mv_count=1; return; }
  280.       }
  281.     value1 = NIL; mv_count=1;
  282.   }
  283.  
  284. # Flag, ob sich das ARexx-Interface gerade in der Endphase befindet und
  285. # deswegen keine neuen Nachrichten entgegennimmt:
  286.   local boolean rexxShutdown = TRUE;
  287.  
  288. # Empfängt ARexx Nachrichten.
  289. # Liefert eine Liste (MsgId ...) oder T, wenn eine Nachricht empfangen wurde.
  290. # Falls rexxShutdown gesetzt ist, werden keine neuen Nachrichten, nur noch
  291. # Antworten, angenommen.
  292. # Kann GC auslösen, falls nicht im rexxShutdown Modus.
  293.   local object rexx_getmsg(void);
  294.   local object rexx_getmsg()
  295.     { if (rexxPort == NULL)
  296.         { return NIL; }
  297.         else
  298.         { var reg1 struct RexxMsg * rexxmsg;
  299.           handle_lost_argstr();
  300.           # Resource-tracking für einkommende Nachrichten
  301.           # (Benutzt eine globale Variable O(rexx_prefetch_inmsg),
  302.           # um nicht jedes Mal ein neues Cons erzeugen zu müssen.)
  303.           if (!rexxShutdown
  304.               && matomp(O(rexx_prefetch_inmsg)))
  305.             { pushSTACK(allocate_fpointer(NULL));
  306.              {var reg1 object new_cons = allocate_cons();
  307.               Car(new_cons) = popSTACK();
  308.               O(rexx_prefetch_inmsg) = new_cons;
  309.             }}
  310.           # O(rexx_prefetch_inmsg) ist nun garantiert ein brauchbares Cons.
  311.           # Bereich gegen GC geschützt.
  312.           begin_system_call();
  313.           rexxmsg = (struct RexxMsg *)GetMsg(rexxPort);
  314.           end_system_call();
  315.           if (rexxmsg == NULL) # keine Nachricht vorhanden?
  316.             { return NIL; }
  317.             else
  318.             { debug_asciz_out("rexx_getmsg: ");
  319.               debug_hex_out(rexxmsg->rm_Action);
  320.               if (rexxmsg->rm_Node.mn_Node.ln_Type == NT_REPLYMSG)
  321.                 # Antwort auf eine von uns geschickte Message
  322.                 { var reg3 LONG result1 = rexxmsg->rm_Result1;
  323.                   begin_system_call();
  324.                   if (rexxmsg->rm_Action & RXCOMM)
  325.                     { DeleteArgstring(rexxmsg->rm_Args[0]); }
  326.                     else
  327.                     { ClearRexxMsg(rexxmsg,1+(rexxmsg->rm_Action & RXARGMASK)); }
  328.                   if ((rexxmsg->rm_Action & RXFF_RESULT)
  329.                       && (rexxmsg->rm_Result1 == 0)
  330.                       && rexxmsg->rm_Result2
  331.                       && !rexxShutdown
  332.                      )
  333.                     { # DeleteArgstring(rexxmsg->rm_Result2); kommt später
  334.                       rexxLostArgstr = (UBYTE*)(rexxmsg->rm_Result2);
  335.                     }
  336.                   DeleteRexxMsg(rexxmsg);
  337.                   end_system_call();
  338.                   rexxNeededReplies--;
  339.                   debug_asciz_out(" a reply ");
  340.                   # ab hier GC wieder möglich
  341.                   if (rexxShutdown)
  342.                     { handle_lost_argstr(); return T; }
  343.                     else
  344.                     # Ergebnis ist eine 2- oder 3-elementige Liste (Msg-ID RC [RESULT]),
  345.                     { pushSTACK(allocate_fpointer(rexxmsg));
  346.                       pushSTACK(L_to_I(result1));
  347.                       if (rexxLostArgstr)
  348.                         { pushSTACK(make_string(rexxLostArgstr,LengthArgstring(rexxLostArgstr)));
  349.                           handle_lost_argstr();
  350.                           return listof(3);
  351.                         }
  352.                         else
  353.                         { /* handle_lost_argstr(); */ # hier unnötig
  354.                           return listof(2);
  355.                     }   }
  356.                 }
  357.                 else
  358.                 { rexxmsg->rm_Result2 = 0;
  359.                   debug_asciz_out(" incoming is " CRLFstring);
  360.                   debug_asciz_out(rexxmsg->rm_Args[0]);
  361.                   # Eingehender Befehl
  362.                   if (rexxShutdown)
  363.                     { # Schluß, nichts läuft mehr
  364.                       rexxmsg->rm_Result1 = RXERRORIMGONE;
  365.                       begin_system_call();
  366.                       ReplyMsg((struct Message *)rexxmsg);
  367.                       end_system_call();
  368.                       return T;
  369.                     }
  370.                     else
  371.                     { var reg2 object new_cons = O(rexx_prefetch_inmsg);
  372.                       # Resource-tracking, bis dahin keine GC.
  373.                       TheFpointer(Car(new_cons))->fp_pointer = rexxmsg;
  374.                       Cdr(new_cons) = O(rexx_inmsg_list);
  375.                       O(rexx_inmsg_list) = new_cons;
  376.                       O(rexx_prefetch_inmsg) = NIL;
  377.                       # Resource-tracking beendet, ab hier wieder GC möglich
  378.                       # Ergebnis ist zweielementige Liste (Msg-ID "Msg-string")
  379.                       pushSTACK(Car(new_cons));
  380.                       pushSTACK(make_string(rexxmsg->rm_Args[0],LengthArgstring(rexxmsg->rm_Args[0])));
  381.                       return listof(2);
  382.                     }
  383.                 }
  384.             }
  385.         }
  386.     }
  387.  
  388. # (SYSTEM::%REXX-GET) empfängt eine Nachricht und liefert sie im
  389. # Format (MsgId ...). Ergebnis NIL falls keine Nachricht vorliegt.
  390. LISPFUNN(rexx_get,0)
  391.   { if (rexxPort == NULL) { fehler_norexx(); }
  392.     value1 = rexx_getmsg(); mv_count=1;
  393.   }
  394.  
  395. # Antwortet auf eine eingegangene Nachricht.
  396. # > foreign: Foreign mit der Message-Adresse
  397. # > rc, result,result_length: Return-Code und Ergebnis-String
  398.   local void rexx_replymsg (object foreign, LONG rc, UBYTE* result, ULONG result_length);
  399.   local void rexx_replymsg(foreign,rc,result,result_length)
  400.     var reg4 object foreign;
  401.     var reg2 LONG rc;
  402.     var reg3 UBYTE* result;
  403.     var reg5 ULONG result_length;
  404.     { var reg1 struct RexxMsg* rexxmsg = TheFpointer(foreign)->fp_pointer;
  405.       debug_asciz_out("rexx_replymsg: ");
  406.       debug_hex_out(rexxmsg);
  407.       rexxmsg->rm_Result1 = rc;
  408.       begin_system_call();
  409.       rexxmsg->rm_Result2 = (ULONG)
  410.         (((rc == 0) && (rexxmsg->rm_Action & RXFF_RESULT))
  411.          ? CreateArgstring(result,result_length)
  412.          : NULL
  413.         );
  414.       ReplyMsg((struct Message *)rexxmsg);
  415.       end_system_call();
  416.       # Die Message foreign ist nun beantwortet.
  417.       O(rexx_inmsg_list) = deleteq(O(rexx_inmsg_list),foreign);
  418.       mark_fp_invalid(TheFpointer(foreign)); # prohibit further use
  419.       debug_asciz_out(CRLFstring);
  420.     }
  421.  
  422. # (SYS::%REXX-REPLY message-id return-code return-string)
  423. # antwortet auf eine Message.
  424. LISPFUNN(rexx_reply,3)
  425.   { # Stackaufbau: ..., message-id, return-code, return-string.
  426.     if (rexxPort == NULL) { fehler_norexx(); }
  427.     # Argumente überprüfen:
  428.     # return-code sollte ein Fixnum sein:
  429.     if (!mfixnump(STACK_1))
  430.       { pushSTACK(STACK_1); # Wert für Slot DATUM von TYPE-ERROR
  431.         pushSTACK(S(fixnum)); # Wert für Slot EXPECTED-TYPE von TYPE-ERROR
  432.         pushSTACK(STACK_(1+2));
  433.         pushSTACK(S(rexx_reply));
  434.         //: DEUTSCH "~: Kein Fixnum: ~"
  435.         //: ENGLISH "~: Not a Fixnum: ~"
  436.         //: FRANCAIS "~ : ~ n'est pas de type FIXNUM"
  437.         fehler(type_error, GETTEXT("~: Not a Fixnum: ~"));
  438.       }
  439.     # return-string sollte ein String oder NIL sein:
  440.     if (mstringp(STACK_0))
  441.       { STACK_0 = coerce_ss(STACK_0); } # in Simple-String umwandeln
  442.     # message-id sollte ein Foreign sein:
  443.    {var reg3 object foreign;
  444.     if (!(fpointerp(STACK_2) && !nullp(foreign = find_inmsg(TheFpointer(STACK_2)->fp_pointer))))
  445.       { pushSTACK(STACK_2);
  446.         pushSTACK(S(rexx_reply));
  447.         //: DEUTSCH "~: Keine eingehende Rexx Nachricht: ~"
  448.         //: ENGLISH "~: Not an incoming Rexx message: ~"
  449.         //: FRANCAIS "~ : ~ n'est pas un message Rexx entrant"
  450.         fehler(error, GETTEXT("~: Not an incoming Rexx message: ~"));
  451.       }
  452.     # Beantworten:
  453.     { var reg2 object retcode = STACK_1;
  454.       var reg4 LONG result1 = fixnum_to_L(retcode);
  455.       var reg1 object retstring = STACK_0;
  456.       if (simple_string_p(retstring))
  457.         { rexx_replymsg(foreign,result1,&TheSstring(retstring)->data[0],TheSstring(retstring)->length); }
  458.         else
  459.         { rexx_replymsg(foreign,result1,NULL,0); }
  460.     }
  461.     skipSTACK(3);
  462.     value1 = NIL; mv_count=0;
  463.   }}
  464.  
  465. # Initialisiert das REXX-Interface.
  466. # < ergebnis: Flag, ob erfolgreich initialisiert.
  467. # Kann mehrfach aufgerufen werden.
  468.   global boolean init_rexx(void)
  469.     { if (rexxPort == NULL) # noch was zu tun?
  470.         { if (RexxSysBase == NULL)
  471.             { begin_system_call();
  472.               RexxSysBase = (struct RxsLib *) OpenLibrary(RXSNAME,0L);
  473.               end_system_call();
  474.               if (RexxSysBase == NULL) { return FALSE; }
  475.             }
  476.          {var reg1 uintC nr = 1; # wir probieren verschiedene Ports
  477.           loop
  478.             { if (!(rexxPort == NULL)) break;
  479.              {var reg2 boolean existent;
  480.               rexxPortName[NRPOSITION] = '0' + nr;
  481.               { begin_system_call();
  482.                 Forbid();
  483.                 if (FindPort(rexxPortName) == NULL)
  484.                   # Port existiert noch nicht, wir machen einen (öffentlichen):
  485.                   { rexxPort = CreatePort(rexxPortName,0L);
  486.                     existent = FALSE;
  487.                   }
  488.                   else
  489.                   { existent = TRUE; }
  490.                 Permit();
  491.                 end_system_call();
  492.               }
  493.               if (!existent)
  494.                 # Wir haben's wenigstens probiert...
  495.                 { if (rexxPort == NULL) { return FALSE; }
  496.                   rexxPortBit = bit(rexxPort->mp_SigBit);
  497.                   rexxNeededReplies = 0;
  498.                   rexxShutdown = FALSE;
  499.                   break;
  500.                 }
  501.               # Wir versuchen es mit einem anderem Namen erneut.
  502.               nr++; if (nr==10) { return FALSE; }
  503.             }}
  504.         }}
  505.       return TRUE;
  506.     }
  507.  
  508. # Schließt das REXX-Interface.
  509. # Kann nur einmal aufgerufen werden.
  510.   global void close_rexx(void)
  511.     { rexxShutdown = TRUE;
  512.       debug_asciz_out("close_rexx: ");
  513.       debug_dez_out(rexxNeededReplies); debug_asciz_out(" messages waiting." CRLFstring);
  514.       if (!(rexxPort == NULL))
  515.         { # Port unbekannt machen (abmelden):
  516.           begin_system_call();
  517.           RemPort(rexxPort);
  518.           end_system_call();
  519.           handle_lost_argstr();
  520.           # Ausstehende Nachrichten mit Fehler zurückschicken:
  521.           while (mconsp(O(rexx_inmsg_list)))
  522.             { rexx_replymsg(Car(O(rexx_inmsg_list)),RXERRORIMGONE,NULL,0L); }
  523.           # Eingegangene Nachrichten mit Fehler zurückschicken:
  524.           loop
  525.             { until (nullp(rexx_getmsg())) { /* loop until empty */ }
  526.               if (rexxNeededReplies == 0) break;
  527.               begin_system_call();
  528.               Wait(rexxPortBit);
  529.               end_system_call();
  530.               debug_asciz_out("Looping" CRLFstring);
  531.             }
  532.           begin_system_call();
  533.           rexxPort->mp_Node.ln_Name = NULL;
  534.           DeletePort(rexxPort);
  535.           end_system_call();
  536.           rexxPort = NULL;
  537.           rexxPortBit = 0;
  538.         }
  539.       if (!(RexxSysBase == NULL))
  540.         { begin_system_call();
  541.           CloseLibrary((struct Library *)RexxSysBase);
  542.           end_system_call();
  543.           RexxSysBase = NULL;
  544.         }
  545.     }
  546.  
  547. #endif # AMIGAOS
  548.  
  549.