about summary refs log tree commit diff stats
path: root/html/apps/ex13.subx.html
blob: 883d153237a190588ee1d92ef49ec729a998037a (plain) (blame) 
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

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
<title>Mu - apps/ex13.subx</title>
<meta name="Generator" content="Vim/8.1">
<meta name="plugin-version" content="vim8.1_v1">
<meta name="syntax" content="none">
<meta name="settings" content="number_lines,use_css,no_foldcolumn,expand_tabs,line_ids,prevent_copy=">
<meta name="colorscheme" content="minimal-light">
<style type="text/css">
<!--
pre { font-family: monospace; color: #000000; background-color: #c6c6c6; }
body { font-size:12pt; font-family: monospace; color: #000000; background-color: #c6c6c6; }
a { color:inherit; }
* { font-size:12pt; font-size: 1em; }
.subxComment { color: #005faf; }
.subxS2Comment { color: #8a8a8a; }
.LineNr { }
.subxS1Comment { color: #0000af; }
.SpecialChar { color: #d70000; }
.Normal { color: #000000; background-color: #c6c6c6; padding-bottom: 1px; }
.Constant { color: #008787; }
-->
</style>

<script type='text/javascript'>
<!--

/* function to open any folds containing a jumped-to line before jumping to it */
function JumpToLine()
{
  var lineNum;
  lineNum = window.location.hash;
  lineNum = lineNum.substr(1); /* strip off '#' */

  if (lineNum.indexOf('L') == -1) {
    lineNum = 'L'+lineNum;
  }
  var lineElem = document.getElementById(lineNum);
  /* Always jump to new location even if the line was hidden inside a fold, or
   * we corrected the raw number to a line ID.
   */
  if (lineElem) {
    lineElem.scrollIntoView(true);
  }
  return true;
}
if ('onhashchange' in window) {
  window.onhashchange = JumpToLine;
}

-->
</script>
</head>
<body onload='JumpToLine();'>
<a href='https://github.com/akkartik/mu/blob/master/apps/ex13.subx'>https://github.com/akkartik/mu/blob/master/apps/ex13.subx</a>
<pre id='vimCodeElement'>
<span id="L1" class="LineNr"> 1 </span><span class="subxComment"># Compare 3 and 3.</span>
<span id="L2" class="LineNr"> 2 </span><span class="subxComment">#</span>
<span id="L3" class="LineNr"> 3 </span><span class="subxComment"># To run:</span>
<span id="L4" class="LineNr"> 4 </span><span class="subxComment">#   $ ./bootstrap translate init.linux apps/ex13.subx -o apps/ex13</span>
<span id="L5" class="LineNr"> 5 </span><span class="subxComment">#   $ ./bootstrap run apps/ex13</span>
<span id="L6" class="LineNr"> 6 </span><span class="subxComment"># Expected result:</span>
<span id="L7" class="LineNr"> 7 </span><span class="subxComment">#   $ echo $?</span>
<span id="L8" class="LineNr"> 8 </span><span class="subxComment">#   1</span>
<span id="L9" class="LineNr"> 9 </span>
<span id="L10" class="LineNr">10 </span>== code
<span id="L11" class="LineNr">11 </span><span class="subxComment">#   instruction                     effective address                                                   register    displacement    immediate</span>
<span id="L12" class="LineNr">12 </span><span class="subxS1Comment"># . op          subop               mod             rm32          base        index         scale       r32</span>
<span id="L13" class="LineNr">13 </span><span class="subxS1Comment"># . 1-3 bytes   3 bits              2 bits          3 bits        3 bits      3 bits        2 bits      2 bits      0/1/2/4 bytes   0/1/2/4 bytes</span>
<span id="L14" class="LineNr">14 </span>
<span id="L15" class="LineNr">15 </span><span class="SpecialChar">Entry</span>:
<span id="L16" class="LineNr">16 </span>    b8/copy-to-eax  3/imm32
<span id="L17" class="LineNr">17 </span>    3d/compare-eax-and  3/imm32
<span id="L18" class="LineNr">18 </span>    0f 94/set-if-=                  3/mod/direct    3/rm32/ebx   <span class="Normal"> . </span>         <span class="Normal"> . </span>           <span class="Normal"> . </span>         <span class="Normal"> . </span>         <span class="Normal"> . </span>             <span class="Normal"> . </span>                <span class="subxComment"># set ebx to ZF</span>
<span id="L19" class="LineNr">19 </span>    81 4/subop/and                  3/mod/direct    3/rm32/ebx   <span class="Normal"> . </span>         <span class="Normal"> . </span>           <span class="Normal"> . </span>         <span class="Normal"> . </span>         <span class="Normal"> . </span>              0xff/imm32        <span class="subxComment"># AND with eax</span>
<span id="L20" class="LineNr">20 </span>
<span id="L21" class="LineNr">21 </span><span class="Constant">$exit</span>:
<span id="L22" class="LineNr">22 </span>    <span class="subxComment"># exit(ebx)</span>
<span id="L23" class="LineNr">23 </span>    e8/call  syscall_exit/disp32
<span id="L24" class="LineNr">24 </span>
<span id="L25" class="LineNr">25 </span><span class="subxS2Comment"># . . vim&#0058;nowrap:textwidth=0</span>
</pre>
</body>
</html>
<!-- vim: set foldmethod=manual : -->
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2025-04-22 16:53:31 +0000
/span>extend-environment '() '() '())) (set! the-procedures the-primitive-procedures) (driver-loop)) (define (driver-loop) (define (helper) (prompt "? ") (let ((line (logo-read))) (if (not (null? line)) (let ((result (eval-line (make-line-obj line) the-global-environment))) (if (not (eq? result '=no-value=)) (logo-print (list "You don't say what to do with" result)))))) (helper)) (logo-read) (helper)) ;;; APPLYING PRIMITIVE PROCEDURES ;;; To apply a primitive procedure, we ask the underlying Scheme system ;;; to perform the application. (Of course, an implementation on a ;;; low-level machine would perform the application in some other way.) (define (apply-primitive-procedure p args) (apply (text p) args)) ;;; Now for the code that's based on the book!!! ;;; Section 4.1.1 ;; Given an expression like (proc :a :b :c)+5 ;; logo-eval calls eval-prefix for the part in parentheses, and then ;; handle-infix to check for and process the infix arithmetic. ;; Eval-prefix is comparable to Scheme's eval. (define (logo-eval line-obj env) (handle-infix (eval-prefix line-obj env) line-obj env)) (define (eval-prefix line-obj env) (define (eval-helper paren-flag) (let ((token (ask line-obj 'next))) (cond ((self-evaluating? token) token) ((variable? token) (lookup-variable-value (variable-name token) env)) ((quoted? token) (text-of-quotation token)) ((definition? token) (eval-definition line-obj)) ((left-paren? token) (let ((result (handle-infix (eval-helper #t) line-obj env))) (let ((token (ask line-obj 'next))) (if (right-paren? token) result (error "Too much inside parens"))))) ((right-paren? token) (error "Unexpected ')'")) (else (let ((proc (lookup-procedure token))) (if (not proc) (error "I don't know how to" token)) (logo-apply proc (collect-n-args (arg-count proc) line-obj env) env))) ))) (eval-helper #f)) (define (logo-apply procedure arguments env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (parameters procedure) arguments env))) (else (error "Unknown procedure type -- LOGO-APPLY" procedure)))) (define (collect-n-args n line-obj env) (cond ((= n 0) '()) ((and (< n 0) (not (ask line-obj 'empty?))) (let ((token (ask line-obj 'next))) (ask line-obj 'put-back token) (if (right-paren? token) '() (let ((next (logo-eval line-obj env))) (cons next (collect-n-args (-1+ n) line-obj env)) )))) (else (let ((next (logo-eval line-obj env))) (cons next (collect-n-args (-1+ n) line-obj env)) )))) ;;; Section 4.1.2 -- Representing expressions ;;; numbers (define (self-evaluating? exp) (number? exp)) ;;; quote (define (quoted? exp) (or (list? exp) (eq? (string-ref (word->string (first exp)) 0) #\"))) (define (text-of-quotation exp) (if (list? exp) exp (bf exp))) ;;; parens (define (left-paren? exp) (eq? exp left-paren-symbol)) (define (right-paren? exp) (eq? exp right-paren-symbol)) ;;; definitions (define (definition? exp) (eq? exp 'to)) ;;; procedures (define (lookup-procedure name) (assoc name the-procedures)) (define (primitive-procedure? p) (eq? (cadr p) 'primitive)) (define (compound-procedure? p) (eq? (cadr p) 'compound)) (define (arg-count proc) (caddr proc)) (define (text proc) (cadddr proc)) (define (parameters proc) (car (text proc))) (define (procedure-body proc) (cdr (text proc))) ;;; Section 4.1.3 ;;; Operations on environments (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables frame) (car frame)) (define (frame-values frame) (cdr frame)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable -- SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame))))
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2025-04-22 16:53:24 +0000