* libposix librarified
This commit is contained in:
		
							parent
							
								
									0144cf7bb1
								
							
						
					
					
						commit
						d8619ac96e
					
				
							
								
								
									
										
											BIN
										
									
								
								src/ikarus.boot
								
								
								
								
							
							
						
						
									
										
											BIN
										
									
								
								src/ikarus.boot
								
								
								
								
							
										
											Binary file not shown.
										
									
								
							| 
						 | 
					@ -1,11 +1,17 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(primitive-set! 'posix-fork
 | 
					(library (ikarus posix)
 | 
				
			||||||
 | 
					  (export)
 | 
				
			||||||
 | 
					  (import (scheme))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define ikarus-posix-fork
 | 
				
			||||||
  (lambda ()
 | 
					  (lambda ()
 | 
				
			||||||
    (foreign-call "ikrt_fork")))
 | 
					    (foreign-call "ikrt_fork")))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(primitive-set! 'posix-fork ikarus-posix-fork)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(primitive-set! 'fork
 | 
					(primitive-set! 'fork
 | 
				
			||||||
  (lambda (parent-proc child-proc)
 | 
					  (lambda (parent-proc child-proc)
 | 
				
			||||||
    (let ([pid (posix-fork)])
 | 
					    (let ([pid (ikarus-posix-fork)])
 | 
				
			||||||
      (cond
 | 
					      (cond
 | 
				
			||||||
        [(fx= pid 0) (child-proc)]
 | 
					        [(fx= pid 0) (child-proc)]
 | 
				
			||||||
        [(fx= pid -1) 
 | 
					        [(fx= pid -1) 
 | 
				
			||||||
| 
						 | 
					@ -103,3 +109,4 @@
 | 
				
			||||||
                      (substring s (fxadd1 i) n)
 | 
					                      (substring s (fxadd1 i) n)
 | 
				
			||||||
                      "")))))
 | 
					                      "")))))
 | 
				
			||||||
      (foreign-call "ikrt_environ"))))
 | 
					      (foreign-call "ikrt_environ"))))
 | 
				
			||||||
 | 
					)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -520,13 +520,23 @@
 | 
				
			||||||
        [if         if-label         (core-macro . if)]
 | 
					        [if         if-label         (core-macro . if)]
 | 
				
			||||||
        [when       when-label       (core-macro . when)]
 | 
					        [when       when-label       (core-macro . when)]
 | 
				
			||||||
        [unless     unless-label     (core-macro . unless)]
 | 
					        [unless     unless-label     (core-macro . unless)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					        [void       void-label       (core-prim . void)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        [cons       cons-label       (core-prim . cons)]
 | 
					        [cons       cons-label       (core-prim . cons)]
 | 
				
			||||||
        [values     values-label     (core-prim . values)]
 | 
					 | 
				
			||||||
        [car        car-label        (core-prim . car)]
 | 
					        [car        car-label        (core-prim . car)]
 | 
				
			||||||
        [cdr        cdr-label        (core-prim . cdr)]
 | 
					        [cdr        cdr-label        (core-prim . cdr)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        [null?      null?-label      (core-prim . null?)]
 | 
					        [null?      null?-label      (core-prim . null?)]
 | 
				
			||||||
        [error      error-label      (core-prim . error)]
 | 
					        [boolean?   boolean-label    (core-prim . boolean?)]
 | 
				
			||||||
        [exit       exit-label       (core-prim . exit)]
 | 
					        [char=?     char=?-label     (core-prim . char=?)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					        [string?    string?-label    (core-prim . string?)]
 | 
				
			||||||
 | 
					        [string-ref string-ref-label (core-prim . string-ref)]
 | 
				
			||||||
 | 
					        [string-length string-length-label (core-prim . string-length)]
 | 
				
			||||||
 | 
					        [string=?   string=?-label   (core-prim . string=?)]
 | 
				
			||||||
 | 
					        [substring  substring-label  (core-prim . substring)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        [new-cafe   new-cafe-label   (core-prim . new-cafe)]
 | 
					        [new-cafe   new-cafe-label   (core-prim . new-cafe)]
 | 
				
			||||||
        [load       load-label       (core-prim . load)]
 | 
					        [load       load-label       (core-prim . load)]
 | 
				
			||||||
        [for-each   for-each-label   (core-prim . for-each)]
 | 
					        [for-each   for-each-label   (core-prim . for-each)]
 | 
				
			||||||
| 
						 | 
					@ -539,8 +549,10 @@
 | 
				
			||||||
        [list       list-label       (core-prim . list)]
 | 
					        [list       list-label       (core-prim . list)]
 | 
				
			||||||
        [append     append-label     (core-prim . append)]
 | 
					        [append     append-label     (core-prim . append)]
 | 
				
			||||||
        [apply      apply-label      (core-prim . apply)]
 | 
					        [apply      apply-label      (core-prim . apply)]
 | 
				
			||||||
 | 
					        [values     values-label     (core-prim . values)]
 | 
				
			||||||
        [call-with-values cwv-label  (core-prim . call-with-values)]
 | 
					        [call-with-values cwv-label  (core-prim . call-with-values)]
 | 
				
			||||||
        [procedure? procedure?-label (core-prim . procedure?)]
 | 
					        [procedure? procedure?-label (core-prim . procedure?)]
 | 
				
			||||||
 | 
					        [fixnum?    fixnum-label     (core-prim . fixnum?)]
 | 
				
			||||||
        [fx<        fx<-label        (core-prim . fx<)]
 | 
					        [fx<        fx<-label        (core-prim . fx<)]
 | 
				
			||||||
        [fx<=       fx<=-label       (core-prim . fx<=)]
 | 
					        [fx<=       fx<=-label       (core-prim . fx<=)]
 | 
				
			||||||
        [fx>        fx>-label        (core-prim . fx>)]
 | 
					        [fx>        fx>-label        (core-prim . fx>)]
 | 
				
			||||||
| 
						 | 
					@ -548,6 +560,8 @@
 | 
				
			||||||
        [fx=        fx=-label        (core-prim . fx=)]
 | 
					        [fx=        fx=-label        (core-prim . fx=)]
 | 
				
			||||||
        [fx-        fx--label        (core-prim . fx-)]
 | 
					        [fx-        fx--label        (core-prim . fx-)]
 | 
				
			||||||
        [fx+        fx+-label        (core-prim . fx+)]
 | 
					        [fx+        fx+-label        (core-prim . fx+)]
 | 
				
			||||||
 | 
					        [fxadd1     fxadd1-label     (core-prim . fxadd1)]
 | 
				
			||||||
 | 
					        [fxsub1     fxsub1-label     (core-prim . fxsub1)]
 | 
				
			||||||
        [-          minus-label      (core-prim . -)]
 | 
					        [-          minus-label      (core-prim . -)]
 | 
				
			||||||
        [*          *-label          (core-prim . *)]
 | 
					        [*          *-label          (core-prim . *)]
 | 
				
			||||||
        [+          plus-label       (core-prim . +)]
 | 
					        [+          plus-label       (core-prim . +)]
 | 
				
			||||||
| 
						 | 
					@ -557,16 +571,19 @@
 | 
				
			||||||
        [list->vector list->vector-label (core-prim . list->vector)]
 | 
					        [list->vector list->vector-label (core-prim . list->vector)]
 | 
				
			||||||
        [symbol->string symbol->string-label (core-prim .  symbol->string)]
 | 
					        [symbol->string symbol->string-label (core-prim .  symbol->string)]
 | 
				
			||||||
        [current-eval current-eval-label (core-prim . current-eval)]
 | 
					        [current-eval current-eval-label (core-prim . current-eval)]
 | 
				
			||||||
 | 
					        [error      error-label      (core-prim . error)]
 | 
				
			||||||
 | 
					        [exit       exit-label       (core-prim . exit)]
 | 
				
			||||||
        [primitive-ref primitive-ref-label (core-prim .  primitive-ref)]
 | 
					        [primitive-ref primitive-ref-label (core-prim .  primitive-ref)]
 | 
				
			||||||
        [$set-symbol-value! $set-symbol-value!-label (core-prim .  $set-symbol-value!)]
 | 
					        [$set-symbol-value! $set-symbol-value!-label (core-prim .  $set-symbol-value!)]
 | 
				
			||||||
        [compile    compile-label    (core-prim . compile)]
 | 
					        [compile    compile-label    (core-prim . compile)]
 | 
				
			||||||
        [printf     printf-label     (core-prim . printf)]
 | 
					        [printf     printf-label     (core-prim . printf)]
 | 
				
			||||||
        [string=?   string=?-label   (core-prim . string=?)]
 | 
					 | 
				
			||||||
        [$record-set! $record-set!-label (core-prim . $record-set!)]
 | 
					        [$record-set! $record-set!-label (core-prim . $record-set!)]
 | 
				
			||||||
        [$record-ref  $record-ref-label  (core-prim . $record-ref)]
 | 
					        [$record-ref  $record-ref-label  (core-prim . $record-ref)]
 | 
				
			||||||
        [$record      $record-label      (core-prim . $record)]
 | 
					        [$record      $record-label      (core-prim . $record)]
 | 
				
			||||||
        [$record?     $record?-label     (core-prim . $record?)]
 | 
					        [$record?     $record?-label     (core-prim . $record?)]
 | 
				
			||||||
        [$record/rtd? $record/rtd?-label (core-prim . $record/rtd?)]
 | 
					        [$record/rtd? $record/rtd?-label (core-prim . $record/rtd?)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        [primitive-set! primitive-set!-label (core-prim .  primitive-set!)]
 | 
					        [primitive-set! primitive-set!-label (core-prim .  primitive-set!)]
 | 
				
			||||||
        [command-line-arguments command-line-arguments-label (core-prim .  command-line-arguments)]
 | 
					        [command-line-arguments command-line-arguments-label (core-prim .  command-line-arguments)]
 | 
				
			||||||
        ))
 | 
					        ))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue