
                           : ѱ(Mulasame 0.9)
                    (SECDR-Schemeץȥ)ˤĤ
                                   (ɥե)
                                                         ʿ6ǯ923
   
        Copyright (C) 1990, 1991, 1992, 1993, 1994  Shoichi Hayashi ( Ͱ)

------------------------------------------------------------------------------

  

   MulasameϡSECDR-Scheme1.0󲽤ΤǤ󲽤ˤä
   Ʊ̿βΤɬפʥޥեΥץߥƥ֤ɲ
   ƤޤޤƱ󶡤饤֥ϡ褯Τ줿äȹ
   ̿ƱʤɤޤǤޤ

   󲽤ˤäơSECDR-Scheme1.0λͤФƤϲ¤äƤ
   ޤset!write, readѤΤǤäƤ⡢ɤΥץ
   ¤뤳Ȥʤ¹Ԥ뤳ȤǤޤˤäƥ桼
   ϡƱ̿Τεޤȼ湽¤򿷤뤳Ȥư
   ˤǤޤդ˸СΤ褦ѤȼΤľܸƤӽФ
   ˤϡˤäƥ桼ȤǤǲ򤷤ʤФʤ
   ޤ

------------------------------------------------------------------------------

  ưĶ

   UNIXMacư褦˺ƤޤưǧƤΤSun 
   OS4.1.2BSDϤccgcc2.6, System VϤ/usr/5bin/ccȤˤäƥѥ
   뤷ΤȡMacintoshA/UX3.0.1ccgccˤäƥѥ뤷ΡMa
   cintoshMacMiNTgccˤäƥѥ뤷ΡMacintoshThink C 7.0
   äƥѥ뤷ΤǤ

   MacASL-EditToolȤƤϡ꥽Υ¤ۤƤޤ
   ˼¸Բǽʤ褦Ǥޤ餯MS-DOS, MacǤMPWǤϤΤޤޤǤ
   ѥǤʤǤ礦SECDR-Scheme1.0٤ȰܿϰʤäƤ
   ޤϡMulasameμΰλͤ¸뤿ͳˤ
   ΤǤ

   ̤ˤϤΰ̿¹MulasameΥץڤؤ뤳ȤϤ
   ޤ󡣤Ǥ顢㤨(read)¹ԤȡʰĤμ(ʤ㤨
   ꥹȤξϳ̤бȤޤ)ϤޤǤϡ¾Υץ
   ߤޤ

   ȤǡMasterCPUǼ¹ԤᥤΥץϡ¾Υץ椷
   ꡢξ֤ߤǤ褦ˡ¾Υץ¹ǤäƤ⥤
   饯ƥ֤˻ؼФ褦ˡȥåץ٥Ծ֤ˤƤ
   ȤϤ褯뤳ȤǤ⤷⤳Ծ֤λƤ¾Υץ
   ƤޤȤСؤʤȤȤʤäƤޤޤ
   褹ˡѰդƤޤ

   ĤˡϡMasterCPUREAD-COMPILE-EXEC-PRINTΥ롼פˤƤSUB-C
   PUμ¹ԤǽȤ뤿ˡޡˤ߽ѤΤǤ
   ʤSIG_ALARMˤSUB_CPUŪ˵ưޤѥ륪ץ
   Ȥơ-DBSDALRMꤹȤˡǤμ¹ԷޤȤ
   ǤˡǤϡ̿signalȯˡγ߽
   ưˤʤޤBSDϤϲʤä褦Ǥޤ
   System VϤ̿᤬Ԥ褦˿񤦤褦Ǥäơ
   ˡBSDϤΤߤͭǤBSDϤǤäƤ⤳ˡϤޤꤪ
   ǤޤͳϡߥޡκǾñ̻CPUͷǤ
   Ȥʤꡢ¹®٤μ¤㲼뤫Ǥ

   ⤦ĤˡϡUNIXξ硢ɸϤΥȥåץ٥ǤγƼ
   ˤơΰ(ץץȤνФƤ֤顢ǽβԤϤ
   ޤ)ϤˤĤƤΤߤϡϤ̵Ƥgetc()֥åʤ褦
   Ϥ̵ȤˤSUB-CPUưȤˡǤơܤ
   ϤϥХåե󥰤ȼ˹Ԥޤ
   ʤMasterCPUΥȥåץ٥ǤREAD-COMPILE-EXEC-PRINTΥ롼פ
   ܤϡ¾SUB-CPUΥץߤ뤳Ȥʤ¹ԤǤ
   褦ˤʤäƤޤ
   ܤΰ̣ϡץץȤνФƤ֤ǽβԤϤޤǤ
   Ȥǡ㤨аʲΤ褦ϤԤä硢
   
   > (define
        a 0)
   a
   >
   
   "(define"ϤƤ֤ϡ¾ΥץưƤޤ" a 0)"ιԤ
   ϡ¾ΥץߤޤޤϤƥץץȤФȺƤ
   ¾ΥץưϤޤ
   ¸뤿ˤϡgetchar()֥åʤ褦Ǥɬפ
   ޤ(긵ưƤSun OSξŤgcc version2.3.3Ǥϡɤ
   櫓̵꤬뤵Ƥޤޤ)ǡMulasameΥ󥹥ȡ
   Ԥޤˡinput-test.c򥳥ѥ뤷OK!ɽ뤳ȤǧƤߤ
   

    㤨С
    % cc -o input-test input-test.c
    % input-test
    Hit Return Key!
    Hit Return Key!
    OK!
    %

   Ҥinput-testηOK!ǤϤʤError!ɽ줿ϡޤ
   ȥåץ٥뤬ԤΤȤSUB-CPUưϡʲΤ褦
   Ƥ(run)¹ԤƤ
   
       (define (run)(%task-switch%)(run))
   
   ƥȥåץ٥뤫鲿ؼФȤˤϡ^Cǥ󥿥ץȤ򤫤
   ơȥåץ٥ԤäƤؼФä顢Ƥ(ru
   n)¹ԤSUB-CPUǤη׻³ưޤ
   MacǤϲ⥤٥ȤȯƤʤȤˤϡSUB-CPUư褦
   ƤޤThink Cconsole饤֥ѤƤޤΤǡ٥Ԥ
   롼פϤconsole饤֥˵ҤƤޤ褦Think CA
   NSIΥ饤֥˥ѥåƤƤޤ

------------------------------------------------------------------------------

  ޥ˥奢
   []
    SECDR-Scheme1.0γĥʬˤĤơʲޤ

    (require <LIBNAME>)                     procedure

     secdrlib, ֿ夿ޤץ饤֥, Linda˴ؤơʲΤ褦б
     ǡ<LIBNAME>ǻꤷΤɤޤ
     (slibrequireͭȤʤ褦ˡбƤޤ)
     
         'mizutamari      "mizutamari"
         'linda           "linda"
         'amb             "amb"
         'pcall           "pcall"
         'module          "module"
         'schelog         "schelog"
         'methods         "methods"
         'meroon          "meroon"
         'tiny-clos       "tiny-clos"

    (gencpu)                                procedure

     ŪCPU򿷤˰first-class objectȤ֤ޤCP
     Ufirst-class objectɽ֤ϡξ֤ˤäưʲΤ褦Ѳ
     idñ줿ˤդֹǤ
     (Master0, Slave1ʤΤǡ2ϤޤֹǤ)
     
         #<CPU id: 2>
             ֤ޤϽλ֤C쥸˲⥻åȤ
     ʤǤ
         #<PROCESS id: 2>
             ¹Ԥ٤̿äƤơʲξʳǤ
             (¹Ȥϸ¤ޤ)
         #<WAIT-PROCESS id: 2>
             ץ졼ۥβΤԤäƤǤ
         #<SEMWAIT-PROCESS id: 2>
             ޥեˤäWAIT֤ˤʤäƤǤ
         #<ERROR-PROCESS id: 2>
             顼ˤäƶŪߤƤǤ

    (peval <EXP> <CPU>)                     procedure

     evalǤǤ<EXP>ȥåץ٥δĶǥѥ뤷ɾ
     ˡCPUǤ<CPU>Υ쥸򥻥åȤޤ
     ʤξ֤Ǥϡ¹ԤϳϤޤ󡣡
     ơɾ̤Ǽ뤳Ȥˤʤץ졼ۥ
     first-class objectȤ֤ޤ

    (migrate <CLOSURE> <CPU>)               procedure

     ؿ<CLOSURE>CPUǤ<CPU>إޥ졼Ȥ<CPU>Υ쥸
     򤳤ɾ褦˥åȤޤ
     ʤξ֤Ǥϡ¹ԤϳϤޤ󡣡
     ơɾ̤Ǽ뤳Ȥˤʤץ졼ۥ
     first-class objectȤ֤ޤ

    (wakeup-cpu <CPU>)                      procedure

     CPUǤ<CPU>μ¹Ԥ򳫻Ϥޤ塼Υ塼Ǥ-*-proc
     ess-*-<CPU>ɲäޤƤ-*-process-*-֤ޤ

    (make-place-holder)                     procedure

     ͤβ(instantiate)Ƥʤץ졼ۥfi
     rst-class objectȤ֤ޤ

    (place-holder-set! <OBJ1> <OBJ2>)       procedure

     <OBJ1>β(instantiate)Ƥʤץ졼ۥǤСͤ
     <OBJ2>˶βޤǤʤХ顼Ȥʤޤ
     (ٶβ줿ץ졼ۥƤӶβ褦Ȥȥ顼ˤʤ
     ʤ˲Ūϵ줺٤ͤꤹ뤳ȤǤ
     ȤȤǤ)

    (place-holder? <OBJ>)                   procedure

     <OBJ>ץ졼ۥǤ#t򡢤Ǥʤ#f֤ޤ

    (future? <OBJ>)                         procedure

     <OBJ>ץ졼ۥǤꡢͤޤβ(instantiate)Ƥ
     #t򡢤ʳξ#f֤ޤ

    (%ph-object% <OBJ>)                     procedure

     <OBJ>ץ졼ۥǤʤФͤ򡢤Ǥʤ<OBJ>Ȥ
     ޤץ졼ۥͤinstantiateƤʤϥ顼ˤʤ
     

    (%touch% <OBJ>)                         procedure

     <OBJ>Ȥ֤ޤ<OBJ>ץ졼ۥǤꡢͤinstantiate
     ƤʤˤϡͤinstantiateΤԤäƤ֤ޤ

    (future <EXP>)                          macro

     줬ƤФ줿ĶǤ<EXP>ɾ˳Ϥη̤Ǽ
     졼ۥ֤ޤʲΤ褦Ƥޤ
      (macro future
        (lambda (l)
          `(let* ((cpu (gencpu))
              (ans (migrate (lambda () ,@(cdr l)) cpu)))
             (wakeup-cpu cpu)
             ans)))

    (touch <OBJ>)                           procedure

     <OBJ>ץ졼ۥǤФͤ򡢤Ǥʤ<OBJ>Ȥ֤
     ץ졼ۥinstantiateƤʤinstantiateΤԤ
     Ƥ֤ޤʲΤ褦Ƥޤ
      (define (touch proc)
        (%ph-object% (%touch% proc)))

    (fcons-stream <OBJ> <STREAM>)           macro

     ʲΤ褦Ƥޤ
      (macro fcons-stream (lambda (l)
          `(cons ,(cadr l) (future ,(caddr l)))))

    (tail <STREAM>)                         procedure

     delayΤߤǤϤʤfutureˤбǤ褦ˡʲΤ褦Ѥ
     Ƥޤ
      (define (tail stream)
        (if (place-holder? (cdr stream))
            (touch (cdr stream))
            (force (cdr stream))))
    (cobegin <EXP> ...)                     macro

     <EXP> ... ɾޤ<EXP>...줾Υץ졼ۥꥹ
     ˤ֤ޤʲΤ褦Ƥޤ
      (extend-syntax (cobegin)
         ((cobegin x) (cons (future x) nil))
          ((cobegin x y ...)
          (cons (future x) (cobegin y ...))))

    (exbegin <EXP> ...)                     macro

     <EXP> ... ¾Ū༡ɾޤ<EXP>...Ƥɾλޤǥ
     ؤϵޤ󡣤ʤ(exbegin ...)ɾ¾Υץ
     ߤޤä(exbegin ...)ɾû֤ǽλΤ
     뤳Ȥ˾ޤޤޤɬפʾʳϻѤ٤ǤϤ
     󡣰ʲΤ褦Ƥޤ
      (macro exbegin
        (lambda (l)
          `(begin (%task-switch-off%)
              (let ((ans (begin ,@(cdr l))))
                (%task-switch-on%)
                ans))))

    (race <LIST>)                           procedure

     ץ졼ۥΥꥹ<LIST>᤯׻äν¤ؤ
     ꡼ˤ֤ޤʲΤ褦Ƥޤ
      (define (race l)
         (if (null? l)
            nil
            (do ((previous nil procp)(procp l (cdr procp)))
            ((or (null? procp)(not (future? (car procp))))
             (cond ((null? procp)(race l))
               ((null? previous)
                (cons (%ph-object% (car l))
                      (future (race (cdr l)))))
               (else (set-cdr! previous (cdr procp))
                     (cons (%ph-object% (car procp))
                           (future (race l)))))))))

    (gensemaphore)                          procedure
    (gensemaphore <INIT>)                   procedure

     ޥեfirst-class objectȤ֤ޤ<INIT>ϰ
     ޥեνͤǤ줬ά줿ˤϡʥޥեǤ
     Ȳꤷͤ1˥åȤޤ

    (wait <SEMAPHORE>)                      procedure

     DijkstraΤȤȤɽǤP(passerenޤprolagen)ǤäΤǤ

    (signal <SEMAPHORE>)                    procedure

     DijkstraΤȤȤɽǤV(vrygevenޤverhogen)ǤäΤǤ

    (iostream <EXP> ... )                   macro

     <EXP> ... consoleؤ̿Ǥ٤Ǥ¹¾Υ
     ̿᤬ळȤӽޤ
     դˡ¾Υץ¹ǤСʬळȤ򤻤
     줬λΤԤޤʤӽ¸ޤ
     (äȤ¾Υץ̿᤬iostreamǰϤޤƤʤС
     ޤƤޤΤǤä˥ȥåץ٥READ-COMPILE-EXEC-PRINT롼
     פˤϤiostreamǰϤޤƤޤ
     ΤȤϡMacintoshǤξSUB-CPUϤ̾SubWindowǹԤ
     Τˤʤޤ󤬡Ǥʤϥȥåץ٥ΥץץȤνФ
     ̤˳ळȤΤդɬפǤ)
     ʲΤ褦Ƥޤ
      (macro iostream (lambda (l)
          `(begin (wait console-semaphore)
                  ,@(cdr l)
                  (signal console-semaphore))))

    (%task-switch%)                         procedure

     ľ˶Ū˥ؤޤ

    (%task-switch-on%)                      procedure

     ؤĤ֤ˤޤǥեȤϤξ֤Ǥꡢޤ
     ̾Ϥξ֤Ǥ٤Ǥ#t֤ޤ

    (%task-switch-off%)                     procedure

     ľ夫饿ؤĤʤ֤ˤޤξ֤Ȥ
     ϡ(%task-switch-on%)¹ԤޤǡƤ¾Υߤ
     ޤȤ̣ޤɬפʾʳϻȤ٤ǤϤޤ󡣾
     #f֤ޤ

    (%task-switch?%)                        procedure

     ؤĤ֤Ǥ#t򡢤Ǥʤ#f֤ޤ

    (%cpu-step%)                            procedure
    (%cpu-step% <CPU>)                      procedure

     <CPU>ؤ򵯤ֳ(ݥޥΥƥå׿)֤ޤ<CPU
     >ά줿MasterCPU˴ؤ֤ͤޤ

    (%cpu-step-set!% #t <VAL>)              procedure
    (%cpu-step-set!% <CPU> <VAL>)           procedure

     <CPU>ؤ򵯤ֳ(ݥޥΥƥå׿)<VAL>ͤ
     ꤷޤǽΰ#tǤȤMasterCPU˴ؤͤꤷޤ
     ʤ顢<VAL>ǤʤФʤޤ

    (%cpu-status%)                          procedure
    (%cpu-status% <CPU>)                    procedure

     <CPU>ξ֤ʲΤ褦֤ͤޤ
     
          TERMINATE 0
          SUSPEND   1
          WAIT      2
          SEMWAIT   3
          ERRORSUSPEND -1
     
     <CPU>ά줿MasterCPU˴ؤ֤ͤޤ

    ʲѿϥ塼餬Ѥ륭塼򻲾Ȥ뤿ΤΤǤ

     塼ưΤƤʤˤϡä-*-process-*-, -*-wait-
     process-*-, -*-sem-wait-process-*-ϻȤnil˥ꥢ٤
     ˻ߤƤ٤Ǥ

    -*-process-*-                           variable

     ¹ΥץΥꥹȤǤ

    -*-wait-process-*-                      variable

     ץ졼ۥinstantiateΤԤäƤץΥꥹȤǤ

    -*-sem-wait-process-*-                  variable

     ޥեˤäWAITƤץΥꥹȤǤ

    -*-error-cpu-*-                         variable

     ¹˥顼򵯤ץΥꥹȤǤ

    -*-terminate-*-                         variable

     λץΥꥹȤǤʲ-*-backup-cpu-*-ͤnil
     ˽λץϡˤ¸줺˼ΤƤޤ

    -*-backup-cpu-*-                        variable

     ͤnilʳǤС¹ԤλץΤβCPU-*-term
     inate-*-¸ޤ

    (report)                                procedure

     ץξ֤Ȥο𤷤ޤʲΤ褦ƤޤΤǡ
     ԤäƤˤѲͭޤפʤ
     ϤΤǤܰ٤ѤƤ
      (define (report)
         (display "======================")(newline)
         (display " terminate cpu:")
         (display (length -*-terminate-*-))(newline)
         (display " active    cpu:")
         (display (length -*-process-*-))(newline)
         (display " wait      cpu:")
         (display (length -*-wait-process-*-))(newline)
         (display " sem wait  cpu:")
         (display (length -*-sem-wait-process-*-))(newline)
         (display " error     cpu:")
         (display (length -*-error-cpu-*-))(newline)
         (display "======================")(newline))

-----

   ȥ륰եåˤĤƤϡܤޤΤǡʲ򻲹ͤˤ
   Ʋ
    ( ա yƤޤΤǡturn-right, turn-leftϡ
             줾դ˶ʤ褦˸뤳ȤդƲ)

    (help-gr)                               procedure

     Ret   Name               nargs    args        returns
     ---------------------------------------------------------
     B  graphics-avail?         0       -          #t if graphics available
     B  graphics-mode!          0       -          #f if no graphics
     B  text-mode!              0       -          #t on success
     B  clear-graphics!         0       -          #f if not in graphics mode
     i  max-x                   0       -          maximum value of x
     i  max-y                   0       -          maximum value of y
     i  max-color               0       -          maximum value of color
     B  valid-xyc?              3       x y color  #t if valid
     B  set-dot!                3       x y color  #t on success
     i  get-dot                 2       x y        color of the dot in (x,y)
                                                   or #f if (x,y) not legal
     
     NOTE: Origin (0,0) is in the upper left corner.
     
     #t
	 
    (help-turtlegr)                         procedure

     Ret   Name               nargs    args        returns
     ---------------------------------------------------------
     B  goto-home!              0       -          #f if not in graphics mode
     B  goto-center!            0       -          #f if not in graphics mode
     B  goto-nw!                0       -          #f if not in graphics mode
     B  goto-ne!                0       -          #f if not in graphics mode
     B  goto-sw!                0       -          #f if not in graphics mode
     B  goto-se!                0       -          #f if not in graphics mode
     B  draw                    1       length     #t if target within drawing area
     B  draw-to                 2       x y        #t if (x,y) within drawing area
     B  draw-to!                2       x y        #t if (x,y) within drawing area
     B  move                    1       length     #t if target within drawing area
     B  move-to!                2       x y        #t if (x,y) within drawing area
     i  where-x                 0       -          current x-coordinate
     i  where-y                 0       -          current y-coordinate
     i  turn-right              1       angle      drawing direction in degrees
     i  turn-left               1       angle      drawing direction in degrees
     i  turn-to!                1       angle      drawing direction in degrees
     i  what-direction          0       -          drawing direction in degrees
     B  set-color!              1       color      #t if color valid
     i  what-color              0       -          current drawing color
     
     #t.

-----

   MacintoshǤ˴ؤ

    ջ

     ¹®ٸΤᡢ٥ȼδֳ֤ꤹѥ᡼̵
     ͤꤷƤޤȤʤɤȾѱѻľϤ⡼ɤˤ
     Ƥ硢ʸꤳܤȤޤäϤ
     ޤ󤬡ˤˤΤ褦ʾ֤ϡܡɥץ
     RomanڤؤƤ

     ȥ륰եåϡ8bit顼ޤǤбƤޤ(쥯ȥ
     顼ˤбƤޤ)ưꤵƤ˥οĴ˹
     碌216뤤216ĴꤵޤʣΥ˥³
     ˤϡ8bit顼ޤǤϰϤǺbitΥ˥˹碌ꤵ
     

    MacintoshǤĤΥɥäƤޤMainΥɥ
    stdin-port, stdout-port˲äơSubΥɥб
    sub-stdin-port, sub-stdout-portäƤޤ̾̿ϡ
    ݡȤۤ˻ꤷʤstdin-port, stdout-portꤵ줿褦˿
    񤤤ޤMacintoshǤˤƤSUB-CPUˤƼ¹Ԥ줿̿
    sub-stdin-port, sub-stdout-portꤵ줿褦˿񤤤ޤ
    MacintoshǤǤϥɥΥХå뤬Ǥޤ󤷡emacsѤ
    ޤΤǡΤΤɲäƤޤ

    (transcript-on <FILENAME>)              procedure

     <FILENAME>ʸǤ٤ǡʹߤMainɥ(console)Ǥ
     Ϥˤäƻꤵ̾Υեˤ⵭Ͽޤ
     transcript-offϥݡȤƤޤΤǡٻꤹȽλޤǵ
     Ͽ³ޤ

    (sub-transcript-on <FILENAME>)          procedure

     <FILENAME>ʸǤ٤ǡʹߤSubɥǤϤϤˤ
     ƻꤵ̾Υեˤ⵭Ͽޤ
     sub-transcript-offϥݡȤƤޤΤǡٻꤹȽλ
     ǵϿ³ޤ

    (cgotoxy <X> <Y>)                       procedure

     <X>, <Y> Ǥ٤ǡˤäƻꤵxyɸMain
     Υ֤ưޤ

    (sub-cgotoxy <X> <Y>)                   procedure

     <X>, <Y> Ǥ٤ǡˤäƻꤵxyɸSub
     Υ֤ưޤ

------------------------------------------------------------------------------

  ¹򼨤ޤ

   mulasameΩ夲ȰʲΤ褦ʥåȥץץȤǤޤ

    Mulasame (Parallel SECDR-Scheme) version 0.9,
    Copyright (C) 1990, 1991, 1992, 1993, 1994  Shoichi Hayashi, Atsushi Moriwaki.
    Mulasame comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'.
    
    Scheme Turtlegraphics Copyright (C) 1992 sjm@cc.tut.fi, jtl@cc.tut.fi
    Type `(help-gr)' or `(help-turtlegr)' for a quick reference of
    the new primitives.
    
    ; loading bin-file /usr/PDS/lang/Scheme/Mulasame/boot.bin
    ; loading scm-file /usr/PDS/lang/Scheme/Mulasame/Init.scm
    allocate 50 new segments
    ; loading bin-file /usr/PDS/lang/Scheme/Mulasame/parallel
    ; loading scm-file /usr/PDS/lang/Scheme/slib/secdrscm.init
    ; loading bin-file /usr/PDS/lang/Scheme/slib/require
    
    > 

   ơץȤƤ벾CPU򥫥󥿤ȤưƤߤޤ
   
        (define (counter cpu)
          (let ((value 0))
            (letrec ((loop (lambda ()(set! value (1+ value))(loop))))
              (migrate loop cpu)
              (lambda (msg)
            (cond ((eq? msg 'value) value)
                  (else (error "unknown message" msg)))))))
    
    ޤCPUޤ
    
    > (define cpu (gencpu))
    ; Evaluation took 0 Seconds (0 in gc).
    cpu
    
    CPU˲򤹤٤Ƥޤ
    
    > (define c1 (counter cpu))
    ; Evaluation took 0 Seconds (0 in gc).
    c1
    
    ξ֤CPUˤϼɾ뤿νԤʤ졢ƥ쥸ꤵ
    ޤʤѤη̤ȤñʤCPU¹Բǽʾ֤˽졢
    ХץΤ褦Ѳޤ
    
    > cpu
    ; Evaluation took 0 Seconds (0 in gc).
    #<PROCESS id: 2>
    
    ξ֤ǤϥץϤޤưƤޤ
    Ǥ顢
    
    > (c1 'value)
    ; Evaluation took 0 Seconds (0 in gc).
    0
    
    Τ褦˽ͤΤޤޤǤ
    
    ץư뤿ˤϼΤ褦ˡưץ򵯤ޤ
    
    > (wakeup-cpu cpu)
    ; Evaluation took 0 Seconds (0 in gc).
    (#<PROCESS id: 2>)
    
    cpu¹Υץ򼨤ꥹ-*-process-*-˥åȤޤ
    (塼ưΤƤʤ-*-process-*-ľѹ뤳Ȥ
    򤱡Ȥ˻ߤ٤Ǥ)
    
    ¹ԤλץϼˤΥꥹȤǤޤΤȤ-*-backu
    p-cpu-*-nilʳǤнλCPUϥꥹ-*-terminate-*-¸
    ξϽλ뤳ȤʤΤǡ˾Ǥ뤳Ȥͭޤ
    
    
    > -*-process-*-
    ; Evaluation took 0 Seconds (0 in gc).
    (#<PROCESS id: 2>)
    
    ǡΥץȡä򤷤Ƥȥåץ٥ΥץȷףĤ
    ץưƤ뤳Ȥˤʤޤ
    
    󥿤ϹѲϤƤΤ򸫤뤳ȤǤޤ
    
    > (c1 'value)
    ; Evaluation took 0 Seconds (0 in gc).
    161468
    > (c1 'value)
    ; Evaluation took 0 Seconds (0 in gc).
    223006
    
    ơץߤˤϡ¹ԤƤ벾CPU-*-process-*-, -*-wait-
    process-*-, -sem-wait-process-*-ɤΤǤ
    ʤäƤ֤ˤ⤳Υ塼ϹѲƤΤǡ̾Υꥹϴ
    ǤΤ褦ˤɤǤ礦
    
    ޤ󥿥ץȤ򤫤ޤSlaveCPUư뤳Ȥˤʤޤ
    δMasterޤƤCPUߤޤ-*-error-hook-*-ؿ
    Υ˥塼'K'ޤΤǡǰöƤμ¹Υץ򥭥塼
    Ǥ-*-process-*-ޤäƤΤ-*-backup-pro
    cess-*-˰ư¸ޤƵưץϥȥåץ٥
    Ƥ顢-*-backup-process-*-˹ʤ褦˥ꥹԤʤwakeup-cpu
    ǺƵưƲ
    
    > ^C
    ; Interrupted!
    List of Commands: (K, S, E, C, D, R, A, !, &, T or Help) ? k
     Error CPU:()
     KILL: all sub-process : (#<PROCESS id: 2>)
    -*-process-*- -> -*-backup-process-*-
    
    List of Commands: (K, S, E, C, D, R, A, !, &, T or Help) ? t
    > -*-process-*-
    ; Evaluation took 0 Seconds (0 in gc).
    ()
    > -*-backup-process-*-
    ; Evaluation took 0 Seconds (0 in gc).
    (#<PROCESS id: 2>)
    
    ǥץߤȤˤʤޤ
    
    > (c1 'value)
    ; Evaluation took 0 Seconds (0 in gc).
    599929
    > (c1 'value)
    ; Evaluation took 0 Seconds (0 in gc).
    599929
    
    Τ褦c1Ѳϻߤޤޤ
    
    > (wakeup-cpu cpu)
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    (#<PROCESS id: 2>)
    
    Τ褦ˤȺƤӡߤƤץưФȤˤʤޤ
    
    > (c1 'value)
    ; Evaluation took 0 Seconds (0 in gc).
    753775
    > (c1 'value)
    ; Evaluation took 0 Seconds (0 in gc).
    823006

   ϡfutureȤäƥȥ꡼¹ԤƤߤޤ

    ޤñȤnϤޤΥȥ꡼Ƥߤޤ礦
    
    ʲΤ褦뤳ȤǤޤ
    
        (define (integersfrom n)
          (fcons-stream n (integersfrom (1+ n))))
    
    ʤnϤޤnn+1ϤޤҤΤǤ
    
    
    ǡȥ꡼򥭥塼Τ褦˰ƬǤĤǤ
    stream-popƤޤ礦
    
        (macro stream-pop
          (lambda (l)
              (let ((n (cadr l)))
                `(let ((ans (head ,n)))
                   (set! ,n (tail ,n))
                   ans))))
    
    > (define x (integersfrom 1))
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    x
    > x
    ; Evaluation took 0 Seconds (0 in gc).
    (1 . #<Place Holder>)
    > (stream-pop x)
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    1
    > x
    ; Evaluation took 0 Seconds (0 in gc).
    (2 . #<Place Holder>)
    > (stream-pop x)
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    2
    > x
    ; Evaluation took 0 Seconds (0 in gc).
    (3 . #<Place Holder>)
    > (stream-pop x)
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    3
    > ^C

   ˥ȥ꡼ѤR-SեåץեåפNANDȤ鹽Ƥ
   ޤ
        (define (logic-nand x y)
          (if (= 0 x)
              1
              (if (= 0 y)
              1
              0)))
    
    NANDȤͤͤꤹؿǤϤȥ꡼
    бΤϰʲΤ褦Ǥޤ
    
        (define (nand x y)
          (fcons-stream (logic-nand (head x) (head y))
                (nand (tail x)
                      (tail y))))
    
    ˤȤ߹碌R-SեåץեåפϰʲΤ褦Ǥ
    
    
        (define (rs-ff s r)
          (letrec ((t1 (fcons-stream 0 (nand t2 r)))
               (t2 (fcons-stream 1 (nand s t1))))
            (cons t2 t1)))
    
    ϤĤΤǡĤΥȥ꡼cons֤Ƥޤ
    
    ǴǤϿȯ륯åƤޤ礦
    
        (define (clock tau ctime)
          (if (< (remainder ctime tau) (* 2 (/ tau 3)))
              (fcons-stream 1 (clock tau (1+ ctime)))
              (fcons-stream 0 (clock tau (1+ ctime)))))
    
    ޤƿξ֤ƻ뤹뤿ˡʲprobeƤޤ
    time-limitꤹɬפ̵Ȥȥ꡼ɤȤǤꡢº
    ˥꥽¤׻ʤΤǤǤñɽԹ礫time
    -limit׵ᤷƤޤ
    
        (define (probe signal signal-name time-limit)
          (display signal-name)
          (display ": ")
          (do ((ctime 0 (1+ ctime)))
              ((<= time-limit ctime) (begin (display 'halt)(newline)))
            (if (= 0 (stream-pop signal))
            (display '_)
            (display '-))))
    
    ơclockprobe³ϩϰʲΤ褦ˤʤޤ
    
        (define (sim time-limit)
          (letrec ((s1 (clock 12 0))
               (s2 (clock 12 6))
               (s (rs-ff s1 s2))
               (q (car s))
               (~q (cdr s)))
            (probe s1 "Set  " time-limit)
            (probe s2 "Reset" time-limit)
            (probe q  "Out  " time-limit)
            (probe ~q "~Out " time-limit)))
    
    Ǥϼ¹ԤƤߤޤ礦
    
    > (sim 60)
    Set  : --------____--------____--------____--------____--------____halt
    Reset: --____--------____--------____--------____--------____------halt
    Out  : ----_____-------_____-------_____-------_____-------_____---halt
    ~Out : ___-------_____-------_____-------_____-------_____-------__halt
    ; Evaluation took 0.366667 Seconds (0 in gc).
    
    > ^C

   Ƽϡ¹Իcobeginȡη̤ᤤνΥȥ꡼Ѵ
   raceμ¸ԤäƤޤ礦
    ޤ֤Τ׻ȤơʲtaraiؿȤȤˤޤ
    
    
        (define (tarai x y z)
          (if (> x y)
            (tarai (tarai (- x 1) y z)
                   (tarai (- y 1) z x)
                   (tarai (- z 1) x y))
            y))
    
    Ǥϼ¹ԤƤߤޤ礦
    
    > (define a
        (race
          (cobegin (tarai 6 3 0)(tarai 4 2 0)(tarai 10 5 0)(tarai 8 4 0))))
    ; Evaluation took 0.3 Seconds (0 in gc).
    a
    > a
    ; Evaluation took 0 Seconds (0 in gc).
    (4 . #<Place Holder>)
    > (stream-pop a)
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    4
    > a
    ; Evaluation took 0 Seconds (0 in gc).
    (6 . #<Place Holder>)
    > (stream-pop a)
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    6
    > a
    ; Evaluation took 0 Seconds (0 in gc).
    (8 . #<Place Holder>)
    > (stream-pop a)
    ; Evaluation took 67.7333 Seconds (20.2333 in gc).
    8
    > a
    ; Evaluation took 0 Seconds (0 in gc).
    (10 . #<Place Holder>)
    > (stream-pop a)
    ; Evaluation took 0.0333333 Seconds (0 in gc).
    10
    > a
    ; Evaluation took 0 Seconds (0 in gc).
    ()

   ǸˡޥեѤȤơʿԥץߥ󥰤ȤƤϤ
   ߤο򤹤ůؼԤ夲뤳Ȥˤޤ
    Ѥ륻ޥեϡ֥ԥۡθפˤǥåɥåβΤ
    roomȣܤΥեǤ(ȤȤ;̵Ȼ
    פΤǡ)
    
    Ȥǡо줹ůؼԤϡΤͤƤ뤳Ȥ(tarai 6 3 0)
    ĤˤʤΤȤȤǤɤˤ(tarai 8 4 0)
    ĤˤʤΤ׻ƤΤǤ(̵Ȼפ
    ⤤ä뤫⤷ޤ󤬡ůؼԤͤƤ뤳Ȥɤ狼ʤ
    ǤʤˤȤäƤƱ褦ʤΤʤǤ:-)
    
    (define (dining-philosophers)
      (define (ngensemaphore i n)
        (if (= 0 n) nil (cons (gensemaphore i) (ngensemaphore i (-1+ n)))))
      (let ((room (gensemaphore 4))
        (fork (list->vector (ngensemaphore 1 5)))
        (think (lambda (i)
              (iostream
                (display "Philosopher")
                (display i)
                (display " starts thinking.")
                (newline))
              (tarai 6 3 0)
              (iostream
                (display "Philosopher")
                (display i)
                (display " stops thinking.")
                (newline))))
        (eat (lambda (i)
               (iostream
                 (display "Philosopher")
                 (display i)
                 (display " starts eating.")
                 (newline))
               (tarai 8 4 0)
               (iostream
                 (display "Philosopher")
                 (display i)
                 (display " stops eating.")
                 (newline)))))
        (letrec ((philosopher (lambda (i)
                    (think i)
                    (wait room)
                    (wait (vector-ref fork i))
                    (wait (vector-ref fork (modulo (1+ i) 5)))
                    (eat i)
                    (signal (vector-ref fork i))
                    (signal (vector-ref fork (modulo (1+ i) 5)))
                    (signal room)
                    (philosopher i))))
          (global-define start-eating
        (lambda ()
          (wait room)
          (iostream (display "You've gone into the room.")(newline))
          (wait (vector-ref fork 0))
          (iostream (display "You've taken your own fork.")(newline))
          (wait (vector-ref fork 1))
          (iostream (display "You've taken the fork on the right side.")(newline)
                (display "You can eat.")(newline)) #t))
          (global-define stop-eating
        (lambda ()
          (signal (vector-ref fork 0))
          (iostream (display "You've released your own fork.")(newline))
          (signal (vector-ref fork 1))
          (iostream (display "You've released the fork on the right side.")
    (newline))
          (signal room)
          (iostream (display "You've gone out of the room.")(newline)) #t))
          (cobegin
    ;       (philosopher 0)
           (philosopher 1)
           (philosopher 2)
           (philosopher 3)
           (philosopher 4)))))
    
    Ǥϡ¹ԤƤߤޤ礦
    
    > (dining-philosophers)
    ; Evaluation took 0 Seconds (0 in gc).
    (#<Place Holder> #<Place Holder> #<Place Holder> #<Place Holder>)
    > Philosopher1 starts thinking.
    Philosopher2 starts thinking.
    Philosopher3 starts thinking.
    Philosopher4 starts thinking.
    Philosopher1 stops thinking.
    Philosopher1 starts eating.
    Philosopher2 stops thinking.
    Philosopher3 stops thinking.
    Philosopher3 starts eating.
    Philosopher4 stops thinking.
    Philosopher1 stops eating.
    Philosopher1 starts thinking.
    Philosopher3 stops eating.
    Philosopher3 starts thinking.
    Philosopher2 starts eating.
    Philosopher1 stops thinking.
    Philosopher4 starts eating.
    Philosopher3 stops thinking.
    Philosopher2 stops eating.
    Philosopher2 starts thinking.
    Philosopher4 stops eating.
    Philosopher4 starts thinking.
    Philosopher1 starts eating.
    Philosopher3 starts eating.
    Philosopher2 stops thinking.
    Philosopher4 stops thinking.
    Philosopher1 stops eating.
    Philosopher1 starts thinking.
    Philosopher3 stops eating.
    Philosopher3 starts thinking.
    Philosopher2 starts eating.
    Philosopher4 starts eating.
    Philosopher1 stops thinking.
    Philosopher3 stops thinking.
    
    ơůؼԤΰͤϲΤʤǤ򤷤ƤߤƤ
    (start-eating)
    
    Philosopher2 stops eating.
    Philosopher2 starts thinking.
    You've gone into the room.
    Philosopher4 stops eating.
    Philosopher4 starts thinking.
    You've taken your own fork.
    Philosopher1 starts eating.
    Philosopher3 starts eating.
    Philosopher2 stops thinking.
    Philosopher4 stops thinking.
    Philosopher1 stops eating.
    Philosopher1 starts thinking.
    You've taken the fork on the right side.
    You can eat.
    ; Evaluation took 8.03333 Seconds (2.61667 in gc).
    #t
    > 
    ̵ˤʤϿǤޤåȤˤäƲषƤů
    ؼԤʤȤǧƤƤ
    
    Philosopher3 stops eating.
    Philosopher3 starts thinking.
    Philosopher2 starts eating.
    Philosopher1 stops thinking.
    Philosopher3 stops thinking.
    Philosopher2 stops eating.
    Philosopher2 starts thinking.
    Philosopher2 stops thinking.
    (report)
    ======================
     terminate cpu:0
     active    cpu:0
     wait      cpu:0
     sem wait  cpu:4
     error     cpu:0
    ======================
    ; Evaluation took 0.0166667 Seconds (0 in gc).
    
    䤪䡢ٽä餵äФޤ礦
    
    > (stop-eating)
    You've released your own fork.
    You've released the fork on the right side.
    You've gone out of the room.
    ; Evaluation took 0 Seconds (0 in gc).
    #t
    > Philosopher4 starts eating.
    Philosopher4 stops eating.
    Philosopher4 starts thinking.
    Philosopher3 starts eating.
    ^C
    
    ơ̤ˤʤtaraiη׻򤹤ɬפϤޤ󡣤äͭյʤ
    ƬȤޤ礦
    
    > (quit)
    ;EXIT
    
    Process scheme finished

------------------------------------------------------------------------------

  

   ʾǤ󤳤ǽʬǤȤͤƤޤ
   ĥƹԤޤ
