File: theme-d-linker-core-def.scm

package info (click to toggle)
theme-d 1.4.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 12,784 kB
  • sloc: lisp: 47,684; sh: 4,200; makefile: 455; ansic: 319
file content (94 lines) | stat: -rw-r--r-- 1,856 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
;; Copyright (C) 2008-2013 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.


;; *** Linker core definitions ***


(import (rnrs exceptions)
	(srfi srfi-1)
	(th-scheme-utilities stdutils)
	(th-scheme-utilities hrecord))


;; Generic procedures shall not be added into global-decls.
(define-hrecord-type <linker> ()
  state
  all-assertions?
  factorize?
  pretty-print?
  verbose-errors?
  verbose-typechecks?
  backtrace?
  runtime-pretty-backtrace?
  strip?
  verbose-unlinked-procedures?
  module-debug-output?
  s-intermediate-language
  repr-list
  ht-used
  ht-var-defs
  ht-method-defs
  ht-method-decls
  ht-used-decls
  ht-rebound
  ht-decl-types
  ht-cycles
  ht-goops-classes
  ht-prim-classes
  ht-fact
  ht-module-indices
  ht-lexical-vars
  ht-equal
  ht-equal-objects
  ht-equal-contents
  lst-enclosing-cycles
  interm-file
  interm-filename
  target-filename
  module-search-path
  param-cache-parsing
  param-cache-instantiation
  binder-parsing
  binder-instantiation
  fixed-tvars
  next-free-loc
  next-tvar-number
  current-module
  linked-interfaces
  linked-bodies
  l-linked-bodies2
  l-bodies-to-process
  l-bodies-to-link
  root-env
  global-decls
  ht-globals-by-name
  ht-globals-by-address
  decl-proc-instances
  inside-param-def?
  tcomp-inside-param-proc?
  t-tvars
  visited-in-binding
  i-next-var-start
  current-expr
  current-toplevel-expr
  current-repr
  current-toplevel-repr
  current-instance
  current-repr-to-bind)


(define is-linker? (get-hrecord-type-predicate <linker>))


(define (linker-alloc-loc linker name toplevel?)
  (let ((result
	 (make-hrecord <address>
		       #f
		       (hfield-ref linker 'next-free-loc)
		       name
		       toplevel?)))
    (hfield-set! linker 'next-free-loc
		 (+ (hfield-ref linker 'next-free-loc) 1))
    result))