Skip to content

Commit

Permalink
Corrected typos.
Browse files Browse the repository at this point in the history
Changed many tabs to 4-whitespaces.
Reformatted some backend code.
  • Loading branch information
maoif authored and mflatt committed Nov 28, 2023
1 parent 1c0888c commit 6202677
Show file tree
Hide file tree
Showing 9 changed files with 1,351 additions and 1,348 deletions.
4 changes: 2 additions & 2 deletions IMPLEMENTATION.md
Original file line number Diff line number Diff line change
Expand Up @@ -350,7 +350,7 @@ type word indicates a vector. The fixnum value is the vector's length
in words/objects, but shifted up by 1 bit, and then the low bit is set
to 1 for an immutable vector.

Most kinds of Scheme values are represented records, so the layout is
Most kinds of Scheme values are represented as records, so the layout is
defined by `define-record-type` and similar. For the primitive object
types that are not records (and even a few that are), the layouts are
defined in "cmacros.ss". For example, an `exactnum` (i.e., a complex
Expand All @@ -367,7 +367,7 @@ The `type-typed-object` in the first line indicates that an `exactnum`
is represented by a pointer that is tagged with `type-typed-object`,
and so we should expect the first field to be a type word. That's why
the first field above is `type`, and it turns out that it will always
contain the value `type-inexactnum`. The `iptr` type for `type` means
contain the value `type-exactnum`. The `iptr` type for `type` means
"a pointer-sized signed integer". The `ptr` type for `real` and `imag`
means "pointer" or "Scheme object".

Expand Down
2 changes: 1 addition & 1 deletion c/segment.c
Original file line number Diff line number Diff line change
Expand Up @@ -584,7 +584,7 @@ static void contract_segment_table(uptr base, uptr end) {
}

/* Bracket all writes to `space_code` memory with calls to
`S_thread_start_code_write` and `S_thread_start_code_write'.
`S_thread_start_code_write` and `S_thread_end_code_write'.
On a platform where a page cannot be both writable and executable
at the same time (a.k.a. W^X), AND assuming that the disposition is
Expand Down
1,310 changes: 657 additions & 653 deletions s/arm32.ss

Large diffs are not rendered by default.

535 changes: 267 additions & 268 deletions s/arm64.ss

Large diffs are not rendered by default.

6 changes: 3 additions & 3 deletions s/cpprim.ss
Original file line number Diff line number Diff line change
Expand Up @@ -38,14 +38,14 @@

(define rtd-ancestry (csv7:record-field-accessor #!base-rtd 'ancestry))

;; After the `np-expand-primitives` pass, some expression produce
;; After the `np-expand-primitives` pass, some expressions produce
;; double (i.e., floating-point) values instead of pointer values.
;; Those expression results always flow to an `inline` primitive
;; that expects double values. The main consequence is that a later
;; pass must only put such returns in a temporary with type 'fp.

; TODO: recognize a direct call when it is at the end of a sequence, closures, or let form
; TODO: push call into if? (would need to pull arguments into temporaries to ensure order of evaluation
; TODO: push call into if? (would need to pull arguments into temporaries to ensure order of evaluation)
; TODO: how does this interact with mvcall?
(module (np-expand-primitives)
(define-threaded new-l*)
Expand Down Expand Up @@ -99,7 +99,7 @@
(single-valued? e))
e
(with-output-language (L7 Expr)
(let ([t (make-tmp 'v)])
(let ([t (make-tmp 'v)])
`(values ,(make-info-call #f #f #f #f #f) ,e))))]
[(e) (ensure-single-valued e (fx= (optimize-level) 3))]))
(define-pass np-expand-primitives : L7 (ir) -> L9 ()
Expand Down
710 changes: 355 additions & 355 deletions s/ppc32.ss

Large diffs are not rendered by default.

6 changes: 3 additions & 3 deletions s/riscv64.ss
Original file line number Diff line number Diff line change
Expand Up @@ -387,7 +387,7 @@
(define-instruction value (fpcastto)
[(op (x mem) (y fpur)) `(set! ,(make-live-info) ,(mem->mem x 'fp) ,y)]
[(op (x ur) (y fpur)) `(set! ,(make-live-info) ,x (asm ,info ,asm-fpcastto ,y))])

(define-instruction value (fpcastfrom)
[(op (x fpmem) (y ur)) `(set! ,(make-live-info) ,(mem->mem x 'uptr) ,y)]
[(op (x fpur) (y ur)) `(set! ,(make-live-info) ,x (asm ,info ,asm-fpcastfrom ,y))]))
Expand Down Expand Up @@ -1413,7 +1413,7 @@
;; dest can be an mref, and then the offset is double-aligned
(lambda (code* dest src)
(gen-fpmove who code* dest src #t)))

(define-who asm-fpmove-single
(lambda (code* dest src)
(gen-fpmove who code* dest src #f)))
Expand Down Expand Up @@ -1465,7 +1465,7 @@
(lambda (code* dest src)
(Trivit (dest src)
(emit fmov.d.x dest src '() code*))))

;; flonum to fixnum
(define-who asm-fptrunc
(lambda (code* dest src)
Expand Down
12 changes: 6 additions & 6 deletions s/x86.ss
Original file line number Diff line number Diff line change
Expand Up @@ -894,7 +894,7 @@
(define-op extad byte-op #b10011001) ; extend eax to edx

(define-op int3 byte-op #b11001100)

(define-op rdtsc two-byte-op #b1111 #b00110001) ; read time-stamp counter
(define-op rdpmc two-byte-op #b1111 #b00110011) ; read performance monitoring counter
(define-op pause two-byte-op #b11110011 #b10010000) ; equivalent to rep nop
Expand Down Expand Up @@ -1293,7 +1293,7 @@
(emit-code (op disp code*)
(build byte #b11101001)
(build long offset)))]
[else
[else
(emit-code (op disp code*)
(build byte #b11101001)
(ax-ea-branch-disp disp))])))
Expand Down Expand Up @@ -1447,7 +1447,7 @@
[(and (eqv? 0 size) (not (eq? base-reg %ebp))) #b00]
[(ax-byte-size? size) #b01]
[else #b10])]
[(literal@) stuff #b00]
[(literal@) stuff #b00]
[(disp) (size reg)
(cond
[(and (eqv? 0 size) (not (eq? reg %ebp))) #b00] ; indirect
Expand Down Expand Up @@ -2463,14 +2463,14 @@
[(4)
(cond
[(and (if-feature windows (not ($ftd-compound? ftd)) #t)
(equal? '((float 4 0)) ($ftd->members ftd)))
(equal? '((float 4 0)) ($ftd->members ftd)))
`(set! ,(%mref ,%ecx ,%zero 0 fp) ,(%inline fstps))]
[else
`(set! ,(%mref ,%ecx 0) ,%eax)])]
[(8)
(cond
[(and (if-feature windows (not ($ftd-compound? ftd)) #t)
(equal? '((float 8 0)) ($ftd->members ftd)))
(equal? '((float 8 0)) ($ftd->members ftd)))
`(set! ,(%mref ,%ecx ,%zero 0 fp) ,(%inline fstpl))]
[else
`(seq
Expand Down Expand Up @@ -2707,7 +2707,7 @@
;; the extra 4 bytes may be used for the unactivate mode
12])]
[init-stack-offset (fx+ 20 indirect-result-space)]
[indirect-result-to-registers? (fill-result-pointer-from-registers? result-type)])
[indirect-result-to-registers? (fill-result-pointer-from-registers? result-type)])
(let-values ([(get-result result-regs result-num-fp-regs)
(do-result result-type init-stack-offset indirect-result-to-registers?)])
(with-values (do-stack (if indirect-result-to-registers?
Expand Down
114 changes: 57 additions & 57 deletions s/x86_64.ss
Original file line number Diff line number Diff line change
Expand Up @@ -1623,7 +1623,7 @@
(and maybe-reg (rex-required? maybe-reg)))
b)))
(record-case ea
[(index) (size index-reg base-reg)
[(index) (size index-reg base-reg)
(build-rex
(fxsrl (reg-mdinfo index-reg) 3)
(fxsrl (reg-mdinfo base-reg) 3))]
Expand Down Expand Up @@ -2485,53 +2485,53 @@
(if-feature windows
;; Windows: either passed in one register or not
(define (classify-eightbytes ftd)
(cond
[($ftd-compound? ftd)
(if (memv ($ftd-size ftd) '(1 2 4 8))
'(integer)
'(memory))]
[(eq? 'float (caar ($ftd->members ftd)))
'(sse)]
[else '(integer)]))
(cond
[($ftd-compound? ftd)
(if (memv ($ftd-size ftd) '(1 2 4 8))
'(integer)
'(memory))]
[(eq? 'float (caar ($ftd->members ftd)))
'(sse)]
[else '(integer)]))
;; Non-Windows: SYSV ABI is a more general classification of
;; 8-byte segments into 'integer, 'sse, or 'memory modes
(define (classify-eightbytes ftd)
(define (merge t1 t2)
(cond
[(eq? t1 t2) t1]
[(eq? t1 'no-class) t2]
[(eq? t2 'no-class) t1]
[(eq? t1 'memory) 'memory]
[(eq? t2 'memory) 'memory]
[else 'integer]))
(cond
[(or (> ($ftd-size ftd) 16) ; more than 2 eightbytes => passed in memory
(fx= 0 ($ftd-size ftd)))
'(memory)]
[else
(let ([classes (make-vector (fxsrl (align ($ftd-size ftd) 8) 3) 'no-class)])
(let loop ([mbrs ($ftd->members ftd)])
(cond
[(null? mbrs)
(vector->list classes)]
[else
(let ([kind (caar mbrs)]
[size (cadar mbrs)]
[offset (caddar mbrs)])
(cond
[(not (fx= offset (align offset size)))
;; misaligned
'(memory)]
[else
(let* ([pos (fxsrl offset 3)]
[class (vector-ref classes pos)]
[new-class (merge class (if (eq? kind 'float) 'sse 'integer))])
(cond
[(eq? new-class 'memory)
'(memory)]
[else
(vector-set! classes pos new-class)
(loop (cdr mbrs))]))]))])))])))
(define (merge t1 t2)
(cond
[(eq? t1 t2) t1]
[(eq? t1 'no-class) t2]
[(eq? t2 'no-class) t1]
[(eq? t1 'memory) 'memory]
[(eq? t2 'memory) 'memory]
[else 'integer]))
(cond
[(or (> ($ftd-size ftd) 16) ; more than 2 eightbytes => passed in memory
(fx= 0 ($ftd-size ftd)))
'(memory)]
[else
(let ([classes (make-vector (fxsrl (align ($ftd-size ftd) 8) 3) 'no-class)])
(let loop ([mbrs ($ftd->members ftd)])
(cond
[(null? mbrs)
(vector->list classes)]
[else
(let ([kind (caar mbrs)]
[size (cadar mbrs)]
[offset (caddar mbrs)])
(cond
[(not (fx= offset (align offset size)))
;; misaligned
'(memory)]
[else
(let* ([pos (fxsrl offset 3)]
[class (vector-ref classes pos)]
[new-class (merge class (if (eq? kind 'float) 'sse 'integer))])
(cond
[(eq? new-class 'memory)
'(memory)]
[else
(vector-set! classes pos new-class)
(loop (cdr mbrs))]))]))])))])))

(define (count v l)
(cond
Expand Down Expand Up @@ -2959,7 +2959,7 @@
(returnem frame-size locs
(lambda (t0 not-varargs?)
(let* ([t (if adjust-active? %deact t0)] ; need a register if `adjust-active?`
[kill* (add-caller-save-registers result-reg*)]
[kill* (add-caller-save-registers result-reg*)]
[c-call
(add-deactivate adjust-active? t0 (append fp-live* live*)
result-reg*
Expand Down Expand Up @@ -3030,8 +3030,8 @@ incoming | incoming return address | one quad
+---------------------------+
| pad word / indirect space | one quad
sp+0: +---------------------------+<- 16-byte boundary


Standard:
Frame Layout
+---------------------------+
Expand Down Expand Up @@ -3212,14 +3212,14 @@ incoming | incoming return address | one quad
(nanopass-case (Ltype Type) (car types)
[(fp-double-float) (load-double-stack isp)]
[(fp-single-float) (load-single-stack isp)]
[(fp-ftd& ,ftd)
(cond
[(memq ($ftd-size ftd) '(1 2 4 8))
;; passed by value
(load-stack-address isp)]
[else
;; passed by reference
(load-int-stack (car types) isp)])]
[(fp-ftd& ,ftd)
(cond
[(memq ($ftd-size ftd) '(1 2 4 8))
;; passed by value
(load-stack-address isp)]
[else
;; passed by reference
(load-int-stack (car types) isp)])]
[else (load-int-stack (car types) isp)])
locs)
(fx+ isp 8))))
Expand Down Expand Up @@ -3399,7 +3399,7 @@ incoming | incoming return address | one quad
(set! ,(%mref ,%sp ,active-state-offset) ,%rax)
,e)
e))
(%seq
(%seq
(set! ,%rax ,(%inline get-tc))
(set! ,%tc ,%rax)))
`(set! ,%tc (literal ,(make-info-literal #f 'entry (lookup-c-entry thread-context) 0))))))
Expand Down

0 comments on commit 6202677

Please sign in to comment.