Changeset 34413 in project


Ignore:
Timestamp:
08/27/17 04:48:15 (4 weeks ago)
Author:
kon
Message:

bump ver, re-flow

Location:
release/4/stack/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/stack/trunk/stack.scm

    r34140 r34413  
    5353  (only ports with-output-to-port)
    5454  (only extras format))
     55(require-library ports extras)
    5556
    5657(import
     
    6768;; Stack Support
    6869
    69 (define-inline (%make-stack) (%make-structure 'stack '() 0))
    70 
    71 (define-inline (%stack? obj) (%structure-instance? obj 'stack))
     70(define-inline (%make-stack)
     71        (%make-structure 'stack '() 0) )
     72
     73(define-inline (%stack? obj)
     74        (%structure-instance? obj 'stack) )
    7275
    7376(define-inline (%valid-stack? obj)
     
    7982;; Stack List
    8083
    81 (define-inline (%stack-list stk) (%structure-ref stk 1))
    82 
    83 (define-inline (%stack-list-empty? stk) (%null? (%stack-list stk)))
    84 
    85 (define-inline (%stack-list-set! stk ls) (%structure-set! stk 1 ls))
    86 
    87 (define-inline (%stack-list-empty! stk) (%structure-set!/immediate stk 1 '()))
     84(define-inline (%stack-list stk)
     85  (%structure-ref stk 1) )
     86
     87(define-inline (%stack-list-empty? stk)
     88        (%null? (%stack-list stk)) )
     89
     90(define-inline (%stack-list-set! stk ls)
     91        (%structure-set! stk 1 ls) )
     92
     93(define-inline (%stack-list-empty! stk)
     94        (%structure-set!/immediate stk 1 '()) )
    8895
    8996;; Stack Count
    9097
    91 (define-inline (%stack-count stk) (%structure-ref stk 2))
    92 
    93 (define-inline (%stack-count-set! stk cnt) (%structure-set!/immediate stk 2 cnt))
    94 
    95 (define-inline (%stack-count-inc! stk cnt) (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)))
    96 
    97 (define-inline (%stack-count-dec! stk cnt) (%stack-count-set! stk (%fx- (%stack-count stk) cnt)))
     98(define-inline (%stack-count stk)
     99        (%structure-ref stk 2) )
     100
     101(define-inline (%stack-count-set! stk cnt)
     102        (%structure-set!/immediate stk 2 cnt) )
     103
     104(define-inline (%stack-count-inc! stk cnt)
     105        (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)) )
     106
     107(define-inline (%stack-count-dec! stk cnt)
     108        (%stack-count-set! stk (%fx- (%stack-count stk) cnt)) )
    98109
    99110;; Stack Operations
    100111
    101 (define-inline (%stack-empty? stk) (%stack-list-empty? stk))
     112(define-inline (%stack-empty? stk)
     113        (%stack-list-empty? stk))
    102114
    103115(define-inline (%stack-empty! stk)
  • release/4/stack/trunk/stack.setup

    r34140 r34413  
    55(verify-extension-name 'stack)
    66
    7 (setup-shared+static-extension-module (extension-name) (extension-version "2.3.0")
     7(setup-shared+static-extension-module (extension-name) (extension-version "2.3.1")
    88  #:inline? #t
    99  #:types? #t
  • release/4/stack/trunk/tests/run.scm

    r34140 r34413  
    11;;;; run.scm
    2 
    3 (use utils)
    42
    53(define-constant TEST-SOURCE-FILE "test-impl.scm")
    64
    75(cond-expand
    8 
     6  ;
    97  (unix
    10 
    11   (define (csi-n-csc fil #!optional (csi "csi") (csc-opt (compile-file-options)))
    12     (let ((rc
    13           (begin
    14             (print) (print "*** Interpreted ***") (print)
    15             (system (string-append csi " -s " fil))) ) )
    16       (receive (normal? code) (process-status rc)
    17         (if (not normal?)
    18           (exit (fxneg code))
    19           (if (not (zero? code))
    20             (exit code)
    21             (begin
    22               (print) (print "*** Compiled ***") (print)
    23               (parameterize ((compile-file-options csc-opt))
    24                 ;NOTE this exits due to 'test-exit'!
    25                 (compile-file fil)) ) ) ) ) ) )
    26 
     8    ;
     9    (use utils)
     10    ;
     11    (define (system-normal? . args)
     12      ;preform system command & exit upon error
     13      (receive (normal? code) (apply system/status args)
     14        (cond
     15          ((not normal?)
     16            (exit (fxneg code)) )
     17          ((not (fx= 0 code))
     18            (exit code) ) ) )
     19      ;ok
     20      #t )
     21    ;
     22    (define (system/status . args)
     23      (process-status (apply system args)) )
     24    ;
    2725    ;from manual: library # system
    2826    ;; Returns two values: #t if the process exited normally or #f otherwise;
    2927    ;; and either the exit status, or the signal number if terminated via signal.
    3028    (define (process-status rc)
    31       (define (wait-signaled? x) (not (= 0 (bitwise-and x 127))))
     29      (define (wait-signaled? x) (not (fx= 0 (bitwise-and x 127))))
    3230      (define (wait-signal x) (bitwise-and x 127))
    3331      (define (wait-exit-status x) (arithmetic-shift x -8))
     
    3533        (values #f (wait-signal rc))
    3634        (values #t (wait-exit-status rc)) ) )
    37 
     35    ;
     36    (define (stgmsg msg)
     37      (print) (print "*** " msg " ***") (print) )
     38    ;
     39    (define (csi-n-csc fil #!optional (csi "csi") (csc-opt (compile-file-options)))
     40      (stgmsg "Interpreted")
     41      (when (system-normal? (string-append csi " -s " fil))
     42        (stgmsg "Compiled")
     43        (parameterize ((compile-file-options csc-opt))
     44          ;NOTE this exits due to 'test-exit'!
     45          (compile-file fil) ) ) )
     46    ;
     47    ;NOTE when 'csi -s <script>' -> (program-name <script>) so must
     48    ;determine w/ other means
     49    ;
    3850    (let* ((args (argv) )
    3951           (csi (car args) ) )
    40       (csi-n-csc TEST-SOURCE-FILE csi '("-O3" "-d2"))  )
    41     )
    42 
     52      (csi-n-csc TEST-SOURCE-FILE csi '("-O3" "-d2"))  ) )
     53  ;
    4354  (else ;(windows ...)
    44 
    45     (include TEST-SOURCE-FILE) )
    46 )
     55    ;
     56    (include TEST-SOURCE-FILE) ) )
Note: See TracChangeset for help on using the changeset viewer.