comparison lab4/test/pprolog.p @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bfdcc3820b32
1 (* A prolog interpreter running a program that computes tilings *)
2
3 (* This program is the output of a macro processor, so contains many
4 untidy expressions *)
5
6
7 (* tunable parameters *)
8 const
9 MAXSYMBOLS = 511; (* max no. of symbols *)
10 HASHFACTOR = 90; (* percent loading factor for hash table *)
11 MAXCHARS = 2048; (* max chars in symbols *)
12 MAXSTRING = 128; (* max string length *)
13 MAXARITY = 63; (* max arity of function, vars in clause *)
14 MEMSIZE = 25000; (* size of |mem| array *)
15
16 (* special character values *)
17 const ENDSTR = chr(0); (* end of string *)
18 TAB = chr(9); (* tab character *)
19 ENDLINE = chr(10); (* newline character *)
20 ENDFILE = chr(127); (* end of file *)
21
22 var run: boolean; (* whether execution should continue *)
23 dflag: boolean; (* switch for debugging code *)
24
25 type
26 permstring = integer;
27 tempstring = array MAXSTRING of char;
28
29 var
30 charptr: integer;
31 charbuf: array MAXCHARS of char;
32
33 (* |StringLength| -- length of a tempstring *)
34 proc StringLength(var s: tempstring): integer;
35 var i: integer;
36 begin
37 i := 0;
38 while s[i] <> ENDSTR do i := i+1 end;
39 return i
40 end;
41
42 (* |SaveString| -- make a tempstring permanent *)
43 proc SaveString(var s: tempstring): permstring;
44 var p, i: integer;
45 begin
46 if charptr + StringLength(s) + 1 > MAXCHARS then
47 newline(); print_string("Panic: "); print_string("out of string space"); newline(); exit(2)
48 end;
49 p := charptr; i := 0;
50 repeat
51 charbuf[charptr] := s[i]; charptr := charptr+1; i := i+1
52 until charbuf[charptr-1] = ENDSTR;
53 return p
54 end;
55
56 (* |StringEqual| -- compare a tempstring to a permstring *)
57 proc StringEqual(var s1: tempstring; s2: permstring): boolean;
58 var i: integer;
59 begin
60 i := 0;
61 while (s1[i] <> ENDSTR) and (s1[i] = charbuf[s2+i]) do i := i+1 end;
62 return (s1[i] = charbuf[s2+i])
63 end;
64
65 (* |WriteString| -- print a permstring *)
66 proc WriteString(s: permstring);
67 var i: integer;
68 begin
69 i := s;
70 while charbuf[i] <> ENDSTR do
71 print_char(charbuf[i]); i := i+1
72 end
73 end;
74
75 type
76 ptr = integer; (* index into |mem| array *)
77
78 const NULL = 0; (* null pointer *)
79
80 type term = ptr;
81
82 const FUNC = 1; (* compound term *)
83 INT = 2; (* integer *)
84 CHRCTR = 3; (* character *)
85 CELL = 4; (* variable cell *)
86 REF = 5; (* variable reference *)
87 UNDO = 6; (* trail item *)
88
89 const TERM_SIZE = 2; (* \dots\ plus no. of args *)
90
91 var
92 lsp, gsp, hp, hmark: ptr;
93 mem: array MEMSIZE+1 of integer;
94
95 (* |LocAlloc| -- allocate space on local stack *)
96 proc LocAlloc(size: integer): ptr;
97 var p: ptr;
98 begin
99 if lsp + size >= gsp then newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2) end;
100 p := lsp + 1; lsp := lsp + size; return p
101 end;
102
103 (* |GloAlloc| -- allocate space on global stack *)
104 proc GloAlloc(kind, size: integer): ptr;
105 var p: ptr;
106 begin
107 if gsp - size <= lsp then
108 newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2)
109 end;
110 gsp := gsp - size; p := gsp;
111 mem[p] := lsl(kind, 8) + size;
112 return p
113 end;
114
115 (* |HeapAlloc| -- allocate space on heap *)
116 proc HeapAlloc(size: integer): ptr;
117 var p: ptr;
118 begin
119 if hp + size > MEMSIZE then newline(); print_string("Panic: "); print_string("out of heap space"); newline(); exit(2) end;
120 p := hp + 1; hp := hp + size; return p
121 end;
122
123 var infile: array 3000 of char; pin, pout: integer;
124
125 proc prog(line: array 60 of char);
126 var i: integer;
127 begin
128 for i := 0 to 59 do
129 infile[pin] := line[i]; pin := pin+1
130 end;
131 infile[pin] := ENDLINE; pin := pin+1
132 end;
133
134 proc rdchar(var ch: char);
135 begin
136 if pout >= pin then
137 ch := ENDFILE
138 else
139 ch := infile[pout]; pout := pout+1
140 end
141 end;
142
143 var
144 pbchar: char; (* pushed-back char, else |ENDFILE| *)
145 lineno: integer; (* line number in current file *)
146
147 (* |GetChar| -- get a character *)
148 proc GetChar(): char;
149 var ch: char;
150 begin
151 if pbchar <> ENDFILE then
152 ch := pbchar; pbchar := ENDFILE
153 else
154 rdchar(ch);
155 if ch = ENDLINE then lineno := lineno+1 end
156 end;
157 return ch
158 end;
159
160 (* |PushBack| -- push back a character on the input *)
161 proc PushBack(ch: char);
162 begin
163 pbchar := ch
164 end;
165
166 type clause = ptr;
167
168 const CLAUSE_SIZE = 4; (* ... plus size of body + 1 *)
169
170 type frame = ptr;
171
172 const FRAME_SIZE = 7; (* \dots plus space for local variables *)
173
174 var
175 current: ptr; (* current goal *)
176 call: term; (* |Deref|'ed first literal of goal *)
177 goalframe: frame; (* current stack frame *)
178 choice: frame; (* last choice point *)
179 base: frame; (* frame for original goal *)
180 prok: clause; (* clauses left to try on current goal *)
181
182 (* |Deref| -- follow |VAR| and |CELL| pointers *)
183 proc Deref(t: term; e: frame): term;
184 begin
185 if t = NULL then newline(); print_string("Panic: "); print_string("Deref"); newline(); exit(2) end;
186 if (lsr(mem[t], 8) = REF) and (e <> NULL) then
187 t := (e+7+(mem[t+1]-1)*TERM_SIZE)
188 end;
189 while (lsr(mem[t], 8) = CELL) and (mem[t+1] <> NULL) do
190 t := mem[t+1]
191 end;
192 return t
193 end;
194
195 type symbol = integer; (* index in |symtab| *)
196
197 var
198 nsymbols: integer; (* number of symbols *)
199 symtab: array MAXSYMBOLS+1 of record
200 name: integer; (* print name: index in |charbuf| *)
201 arity: integer; (* number of arguments or -1 *)
202 action: integer; (* code if built-in, 0 otherwise *)
203 prok: clause (* clause chain *)
204 end;
205 cons, eqsym, cutsym, nilsym, notsym: symbol;
206 node: symbol;
207
208 (* |Lookup| -- convert string to internal symbol *)
209 proc Lookup(var name: tempstring): symbol;
210 var h, i: integer; p: symbol;
211 begin
212 (* Compute the hash function in |h| *)
213 h := 0; i := 0;
214 while name[i] <> ENDSTR do
215 h := (5 * h + ord(name[i])) mod MAXSYMBOLS; i := i+1
216 end;
217
218 (* Search the hash table *)
219 p := h+1;
220 while symtab[p].name <> -1 do
221 if StringEqual(name, symtab[p].name) then return p end;
222 p := p-1;
223 if p = 0 then p := MAXSYMBOLS end
224 end;
225
226 (* Not found: enter a new symbol *)
227 (* Be careful to avoid overflow on 16 bit machines: *)
228 if nsymbols >= (MAXSYMBOLS div 10) * (HASHFACTOR div 10) then
229 newline(); print_string("Panic: "); print_string("out of symbol space"); newline(); exit(2)
230 end;
231 symtab[p].name := SaveString(name);
232 symtab[p].arity := -1;
233 symtab[p].action := 0; symtab[p].prok := NULL;
234 return p
235 end;
236
237 type keyword = array 8 of char;
238
239 (* |Enter| -- define a built-in symbol *)
240 proc Enter(name: keyword; arity: integer; action: integer): symbol;
241 var s: symbol; i: integer; temp: tempstring;
242 begin
243 i := 0;
244 while name[i] <> ' ' do
245 temp[i] := name[i]; i := i+1
246 end;
247 temp[i] := ENDSTR; s := Lookup(temp);
248 symtab[s].arity := arity; symtab[s].action := action;
249 return s
250 end;
251
252 (* Codes for built-in relations *)
253 const
254 CUT = 1; (* $!/0$ *)
255 CALL = 2; (* |call/1| *)
256 PLUS = 3; (* |plus/3| *)
257 TIMES = 4; (* |times/3| *)
258 ISINT = 5; (* |integer/1| *)
259 ISCHAR = 6; (* |char/1| *)
260 NAFF = 7; (* |not/1| *)
261 EQUALITY = 8; (* |=/2| *)
262 FAIL = 9; (* |false/0| *)
263 PRINT = 10; (* |print/1| *)
264 NL = 11; (* |nl/0| *)
265
266 (* |InitSymbols| -- initialize and define standard symbols *)
267 proc InitSymbols();
268 var i: integer; dummy: symbol;
269 begin
270 nsymbols := 0;
271 for i := 1 to MAXSYMBOLS do symtab[i].name := -1 end;
272 cons := Enter(": ", 2, 0);
273 cutsym := Enter("! ", 0, CUT);
274 eqsym := Enter("= ", 2, EQUALITY);
275 nilsym := Enter("nil ", 0, 0);
276 notsym := Enter("not ", 1, NAFF);
277 node := Enter("node ", 2, 0);
278 dummy := Enter("call ", 1, CALL);
279 dummy := Enter("plus ", 3, PLUS);
280 dummy := Enter("times ", 3, TIMES);
281 dummy := Enter("integer ", 1, ISINT);
282 dummy := Enter("char ", 1, ISCHAR);
283 dummy := Enter("false ", 0, FAIL);
284 dummy := Enter("print ", 1, PRINT);
285 dummy := Enter("nl ", 0, NL)
286 end;
287
288 (* |AddClause| -- insert a clause at the end of its chain *)
289 proc AddClause(c: clause);
290 var s: symbol; p: clause;
291 begin
292 s := mem[mem[c+3]+1];
293 if symtab[s].action <> 0 then
294 newline(); print_string("Error: "); print_string("cannot add clauses to built-in relation "); run := false;
295 WriteString(symtab[s].name)
296 elsif symtab[s].prok = NULL then
297 symtab[s].prok := c
298 else
299 p := symtab[s].prok;
300 while mem[p+2] <> NULL do p := mem[p+2] end;
301 mem[p+2] := c
302 end
303 end;
304
305 type argbuf = array MAXARITY+1 of term;
306
307 (* |MakeCompound| -- construct a compound term on the heap *)
308 proc MakeCompound(fun: symbol; var arg: argbuf): term;
309 var p: term; i, n: integer;
310 begin
311 n := symtab[fun].arity;
312 p := HeapAlloc(TERM_SIZE+n);
313 mem[p] := lsl(FUNC, 8) + TERM_SIZE+n;
314 mem[p+1] := fun;
315 for i := 1 to n do mem[p+i+1] := arg[i] end;
316 return p
317 end;
318
319 (* |MakeNode| -- construct a compound term with up to 2 arguments *)
320 proc MakeNode(fun: symbol; a1, a2: term): term;
321 var arg: argbuf;
322 begin
323 arg[1] := a1; arg[2] := a2;
324 return MakeCompound(fun, arg)
325 end;
326
327 var refnode: array MAXARITY+1 of term;
328
329 (* |MakeRef| -- return a reference cell prepared earlier *)
330 proc MakeRef(offset: integer): term;
331 begin
332 return refnode[offset]
333 end;
334
335 (* |MakeInt| -- construct an integer node on the heap *)
336 proc MakeInt(i: integer): term;
337 var p: term;
338 begin
339 p := HeapAlloc(TERM_SIZE);
340 mem[p] := lsl(INT, 8) + TERM_SIZE;
341 mem[p+1] := i; return p
342 end;
343
344 (* |MakeChar| -- construct a character node on the heap *)
345 proc MakeChar(c: char): term;
346 var p: term;
347 begin
348 p := HeapAlloc(TERM_SIZE);
349 mem[p] := lsl(CHRCTR, 8) + TERM_SIZE;
350 mem[p+1] := ord(c); return p
351 end;
352
353 (* |MakeString| -- construct a string as a Prolog list of chars *)
354 proc MakeString(var s: tempstring): term;
355 var p: term; i: integer;
356 begin
357 i := StringLength(s);
358 p := MakeNode(nilsym, NULL, NULL);
359 while i > 0 do
360 i := i-1; p := MakeNode(cons, MakeChar(s[i]), p)
361 end;
362 return p
363 end;
364
365 (* |MakeClause| -- construct a clause on the heap *)
366 proc MakeClause(nvars: integer; head: term;
367 var body: argbuf; nbody: integer): clause;
368 var p: clause; i: integer;
369 begin
370 p := HeapAlloc(CLAUSE_SIZE + nbody + 1);
371 mem[p] := nvars; mem[p+2] := NULL; mem[p+3] := head;
372 for i := 1 to nbody do mem[(p+4)+i-1] := body[i] end;
373 mem[(p+4)+nbody+1-1] := NULL;
374 if head = NULL then
375 mem[p+1] := 0
376 else
377 mem[p+1] := Key(head, NULL)
378 end;
379 return p
380 end;
381
382 (* operator priorities *)
383 const
384 MAXPRIO = 2; (* isolated term *)
385 ARGPRIO = 2; (* function arguments *)
386 EQPRIO = 2; (* equals sign *)
387 CONSPRIO = 1; (* colon *)
388
389 (* |IsString| -- check if a list represents a string *)
390 proc IsString(t: term; e: frame): boolean;
391 const limit = 128;
392 var i: integer;
393 begin
394 i := 0; t := Deref(t, e);
395 while i < limit do
396 if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
397 return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
398 elsif lsr(mem[Deref(mem[t+1+1], e)], 8) <> CHRCTR then
399 return false
400 else
401 i := i+1; t := Deref(mem[t+2+1], e)
402 end
403 end;
404 return false
405 end;
406
407 (* |IsList| -- check if a term is a proper list *)
408 proc IsList(t: term; e: frame): boolean;
409 const limit = 128;
410 var i: integer;
411 begin
412 i := 0; t := Deref(t, e);
413 while i < limit do
414 if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
415 return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
416 else
417 i := i+1; t := Deref(mem[t+2+1], e)
418 end
419 end;
420 return false
421 end;
422
423 (* |ShowString| -- print a list as a string *)
424 proc ShowString(t: term; e: frame);
425 begin
426 t := Deref(t, e);
427 print_char('"');
428 while mem[t+1] <> nilsym do
429 print_char(chr(mem[Deref(mem[t+1+1], e)+1]));
430 t := Deref(mem[t+2+1], e)
431 end;
432 print_char('"')
433 end;
434
435 (* |PrintCompound| -- print a compound term *)
436 proc PrintCompound(t: term; e: frame; prio: integer);
437 var f: symbol; i: integer;
438 begin
439 f := mem[t+1];
440 if f = cons then
441 (* |t| is a list: try printing as a string, or use infix : *)
442 if IsString(t, e) then
443 ShowString(t, e)
444 else
445 if prio < CONSPRIO then print_char('(') end;
446 PrintTerm(mem[t+1+1], e, CONSPRIO-1);
447 print_char(':');
448 PrintTerm(mem[t+2+1], e, CONSPRIO);
449 if prio < CONSPRIO then print_char(')') end
450 end
451 elsif f = eqsym then
452 (* |t| is an equation: use infix = *)
453 if prio < EQPRIO then print_char('(') end;
454 PrintTerm(mem[t+1+1], e, EQPRIO-1);
455 print_string(" = ");
456 PrintTerm(mem[t+2+1], e, EQPRIO-1);
457 if prio < EQPRIO then print_char(')') end
458 elsif f = notsym then
459 (* |t| is a literal 'not P' *)
460 print_string("not ");
461 PrintTerm(mem[t+1+1], e, MAXPRIO)
462 elsif (f = node) and IsList(mem[t+2+1], e) then
463 PrintNode(t, e)
464 else
465 (* use ordinary notation *)
466 WriteString(symtab[f].name);
467 if symtab[f].arity > 0 then
468 print_char('(');
469 PrintTerm(mem[t+1+1], e, ARGPRIO);
470 for i := 2 to symtab[f].arity do
471 print_string(", ");
472 PrintTerm(mem[t+i+1], e, ARGPRIO)
473 end;
474 print_char(')')
475 end
476 end
477 end;
478
479 (* |PrintNode| -- print and optree node *)
480 proc PrintNode(t: term; e: frame);
481 var u: term;
482 begin
483 print_char('<');
484 PrintTerm(mem[t+1+1], e, MAXPRIO);
485 u := Deref(mem[t+2+1], e);
486 while mem[u+1] <> nilsym do
487 print_string(", ");
488 PrintTerm(mem[u+1+1], e, MAXPRIO);
489 u := Deref(mem[u+2+1], e)
490 end;
491 print_char('>');
492 end;
493
494 (* |PrintTerm| -- print a term *)
495 proc PrintTerm(t: term; e: frame; prio: integer);
496 begin
497 t := Deref(t, e);
498 if t = NULL then
499 print_string("*null-term*")
500 else
501 case lsr(mem[t], 8) of
502 FUNC:
503 PrintCompound(t, e, prio)
504 | INT:
505 print_num(mem[t+1])
506 | CHRCTR:
507 print_char(''''); print_char(chr(mem[t+1])); print_char('''')
508 | CELL:
509 if (t >= gsp) then
510 print_char('G'); print_num((MEMSIZE - t) div TERM_SIZE)
511 else
512 print_char('L'); print_num((t - hp) div TERM_SIZE)
513 end
514 | REF:
515 print_char('@'); print_num(mem[t+1])
516 else
517 print_string("*unknown-term(tag=");
518 print_num(lsr(mem[t], 8)); print_string(")*")
519 end
520 end
521 end;
522
523 (* |PrintClause| -- print a clause *)
524 proc PrintClause(c: clause);
525 var i: integer;
526 begin
527 if c = NULL then
528 print_string("*null-clause*"); newline();
529 else
530 if mem[c+3] <> NULL then
531 PrintTerm(mem[c+3], NULL, MAXPRIO);
532 print_char(' ')
533 end;
534 print_string(":- ");
535 if mem[(c+4)+1-1] <> NULL then
536 PrintTerm(mem[(c+4)+1-1], NULL, MAXPRIO);
537 i := 2;
538 while mem[(c+4)+i-1] <> NULL do
539 print_string(", ");
540 PrintTerm(mem[(c+4)+i-1], NULL, MAXPRIO);
541 i := i+1
542 end
543 end;
544 print_char('.'); newline()
545 end
546 end;
547
548 var
549 token: integer; (* last token from input *)
550 tokval: symbol; (* if |token = IDENT|, the identifier*)
551 tokival: integer; (* if |token = NUMBER|, the number *)
552 toksval: tempstring; (* if |token = STRCON|, the string *)
553 errflag: boolean; (* whether recovering from an error *)
554 errcount: integer; (* number of errors found so far *)
555
556 (* Possible values for |token|: *)
557 const
558 IDENT = 1; (* identifier: see |tokval| *)
559 VARIABLE = 2; (* variable: see |tokval| *)
560 NUMBER = 3; (* number: see |tokival| *)
561 CHCON = 4; (* char constant: see |tokival| *)
562 STRCON = 5; (* string constant: see |toksval| *)
563 ARROW = 6; (* |':-'| *)
564 LPAR = 7; (* |'('| *)
565 RPAR = 8; (* |')'| *)
566 COMMA = 9; (* |','| *)
567 DOT = 10; (* |'.'| *)
568 COLON = 11; (* |':'| *)
569 EQUAL = 12; (* |'='| *)
570 NEGATE = 13; (* |'not'| *)
571 EOFTOK = 14; (* end of file *)
572 LANGLE = 15; (* |'<'| *)
573 RANGLE = 16; (* |'>'| *)
574 HASH = 17; (* |'#'| *)
575
576 (* |ShowError| -- report error location *)
577 proc ShowError();
578 begin
579 errflag := true; errcount := errcount+1;
580 print_string("Line "); print_num(lineno); print_char(' ');
581 print_string("Syntax error - ")
582 end;
583
584 (* |Recover| -- discard rest of input clause *)
585 proc Recover();
586 var ch: char;
587 begin
588 if errcount >= 20 then
589 print_string("Too many errors: I am giving up"); newline(); exit(2)
590 end;
591 if token <> DOT then
592 repeat
593 ch := GetChar()
594 until (ch = '.') or (ch = ENDFILE);
595 token := DOT
596 end
597 end;
598
599 (* |Scan| -- read one symbol from |infile| into |token|. *)
600 proc Scan();
601 var ch, ch2: char; i: integer;
602 begin
603 ch := GetChar(); token := 0;
604 while token = 0 do
605 (* Loop after white-space or comment *)
606 if ch = ENDFILE then
607 token := EOFTOK
608 elsif (ch = ' ') or (ch = TAB) or (ch = ENDLINE) then
609 ch := GetChar()
610 elsif ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) then
611 if (((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) then
612 token := VARIABLE
613 else
614 token := IDENT
615 end;
616 i := 0;
617 while ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) or ((ch >= '0') and (ch <= '9')) do
618 if i > MAXSTRING then
619 newline(); print_string("Panic: "); print_string("identifier too long"); newline(); exit(2)
620 end;
621 toksval[i] := ch; ch := GetChar(); i := i+1
622 end;
623 PushBack(ch);
624 toksval[i] := ENDSTR; tokval := Lookup(toksval);
625 if tokval = notsym then token := NEGATE end
626 elsif ((ch >= '0') and (ch <= '9')) then
627 token := NUMBER; tokival := 0;
628 while ((ch >= '0') and (ch <= '9')) do
629 tokival := 10 * tokival + (ord(ch) - ord('0'));
630 ch := GetChar()
631 end;
632 PushBack(ch)
633 else
634 case ch of
635 '(': token := LPAR
636 | ')': token := RPAR
637 | ',': token := COMMA
638 | '.': token := DOT
639 | '=': token := EQUAL
640 | '<': token := LANGLE
641 | '>': token := RANGLE
642 | '#': token := HASH
643 | '!': token := IDENT; tokval := cutsym
644 | '/':
645 ch := GetChar();
646 if ch <> '*' then
647 if not errflag then ShowError(); print_string("bad token /"); newline(); Recover() end
648 else
649 ch2 := ' '; ch := GetChar();
650 while (ch <> ENDFILE) and not ((ch2 = '*') and (ch = '/')) do
651 ch2 := ch; ch := GetChar()
652 end;
653 if ch = ENDFILE then
654 if not errflag then ShowError(); print_string("end of file in comment"); newline(); Recover() end
655 else
656 ch := GetChar()
657 end
658 end
659 | ':':
660 ch := GetChar();
661 if ch = '-' then
662 token := ARROW
663 else
664 PushBack(ch); token := COLON
665 end
666 | '''':
667 token := CHCON; tokival := ord(GetChar()); ch := GetChar();
668 if ch <> '''' then if not errflag then ShowError(); print_string("missing quote"); newline(); Recover() end end
669 | '"':
670 token := STRCON; i := 0; ch := GetChar();
671 while (ch <> '"') and (ch <> ENDLINE) do
672 toksval[i] := ch; ch := GetChar(); i := i+1
673 end;
674 toksval[i] := ENDSTR;
675 if ch = ENDLINE then
676 if not errflag then ShowError(); print_string("unterminated string"); newline(); Recover() end;
677 PushBack(ch)
678 end
679 else
680 if not errflag then ShowError(); print_string("illegal character"); newline(); Recover() end; print_char(ch); newline()
681 end
682 end
683 end
684 end;
685
686 (* |PrintToken| -- print a token as a string *)
687 proc PrintToken(t: integer);
688 begin
689 case t of
690 IDENT:
691 print_string("identifier "); WriteString(symtab[tokval].name)
692 | VARIABLE:
693 print_string("variable "); WriteString(symtab[tokval].name)
694 | NUMBER: print_string("number");
695 | CHCON: print_string("char constant");
696 | ARROW: print_string(":-");
697 | LPAR: print_string("(");
698 | RPAR: print_string(")");
699 | COMMA: print_string(",");
700 | DOT: print_string(".");
701 | COLON: print_string(":");
702 | EQUAL: print_string("=");
703 | STRCON: print_string("string constant")
704 | LANGLE: print_string("<")
705 | RANGLE: print_string(">")
706 | HASH: print_string("#")
707 else
708 print_string("unknown token")
709 end
710 end;
711
712 var
713 nvars: integer; (* no. of variables so far *)
714 vartable: array MAXARITY+1 of symbol; (* names of the variables *)
715
716 (* |VarRep| -- look up a variable name *)
717 proc VarRep(name: symbol): term;
718 var i: integer;
719 begin
720 if nvars = MAXARITY then newline(); print_string("Panic: "); print_string("too many variables"); newline(); exit(2) end;
721 i := 1; vartable[nvars+1] := name; (* sentinel *)
722 while name <> vartable[i] do i := i+1 end;
723 if i = nvars+1 then nvars := nvars+1 end;
724 return MakeRef(i)
725 end;
726
727 (* |ShowAnswer| -- display answer and get response *)
728 proc ShowAnswer(bindings: frame);
729 var i: integer; ch, ch2: char;
730 begin
731 if nvars = 0 then
732 print_string("yes"); newline()
733 else
734 for i := 1 to nvars do
735 WriteString(symtab[vartable[i]].name); print_string(" = ");
736 PrintTerm((bindings+7+(i-1)*TERM_SIZE), NULL, EQPRIO-1);
737 newline()
738 end
739 end
740 end;
741
742 (* |Eat| -- check for an expected token and discard it *)
743 proc Eat(expected: integer);
744 begin
745 if token = expected then
746 if token <> DOT then Scan() end
747 elsif not errflag then
748 ShowError();
749 print_string("expected "); PrintToken(expected);
750 print_string(", found "); PrintToken(token); newline();
751 Recover()
752 end
753 end;
754
755 (* |ParseCompound| -- parse a compound term *)
756 proc ParseCompound(): term;
757 var fun: symbol; arg: argbuf; n: integer;
758 begin
759 fun := tokval; n := 0; Eat(IDENT);
760 if token = LPAR then
761 Eat(LPAR); n := 1; arg[1] := ParseTerm();
762 while token = COMMA do
763 Eat(COMMA); n := n+1; arg[n] := ParseTerm()
764 end;
765 Eat(RPAR)
766 end;
767 if symtab[fun].arity = -1 then
768 symtab[fun].arity := n
769 elsif symtab[fun].arity <> n then
770 if not errflag then ShowError(); print_string("wrong number of args"); newline(); Recover() end
771 end;
772 return MakeCompound(fun, arg)
773 end;
774
775 (* |ParsePrimary| -- parse a primary *)
776 proc ParsePrimary(): term;
777 var t: term;
778 begin
779 if token = IDENT then t := ParseCompound()
780 elsif token = VARIABLE then
781 t := VarRep(tokval); Eat(VARIABLE)
782 elsif token = NUMBER then
783 t := MakeInt(tokival); Eat(NUMBER)
784 elsif token = CHCON then
785 t := MakeChar(chr(tokival)); Eat(CHCON)
786 elsif token = STRCON then
787 t := MakeString(toksval); Eat(STRCON)
788 elsif token = LPAR then
789 Eat(LPAR); t := ParseTerm(); Eat(RPAR)
790 elsif token = LANGLE then
791 t := ParseNode()
792 else
793 if not errflag then ShowError(); print_string("expected a term"); newline(); Recover() end; t := NULL
794 end;
795 return t
796 end;
797
798 (* |ParseNode| -- parse an optree node *)
799 proc ParseNode(): term;
800 var tag, kids: term;
801 begin
802 Eat(LANGLE);
803 tag := ParseTerm();
804 kids := ParseKids();
805 Eat(RANGLE);
806 return MakeNode(node, tag, kids)
807 end;
808
809 (* |ParseKids| -- parse children of an optree node *)
810 proc ParseKids(): term;
811 var head, tail: term;
812 begin
813 if token <> COMMA then
814 return MakeNode(nilsym, NULL, NULL)
815 else
816 Eat(COMMA);
817 head := ParseTerm();
818 tail := ParseKids();
819 return MakeNode(cons, head, tail)
820 end
821 end;
822
823 (* |ParseFactor| -- parse a factor *)
824 proc ParseFactor(): term;
825 var t: term;
826 begin
827 t := ParsePrimary();
828 if token <> COLON then
829 return t
830 else
831 Eat(COLON);
832 return MakeNode(cons, t, ParseFactor())
833 end
834 end;
835
836 (* |ParseTerm| -- parse a term *)
837 proc ParseTerm(): term;
838 var t: term;
839 begin
840 t := ParseFactor();
841 if token <> EQUAL then
842 return t
843 else
844 Eat(EQUAL);
845 return MakeNode(eqsym, t, ParseFactor())
846 end
847 end;
848
849 (* |CheckAtom| -- check that a literal is a compound term *)
850 proc CheckAtom(a: term);
851 begin
852 if lsr(mem[a], 8) <> FUNC then
853 if not errflag then ShowError(); print_string("literal must be a compound term"); newline(); Recover() end
854 end
855 end;
856
857 (* |ParseClause| -- parse a clause *)
858 proc ParseClause(): clause;
859 var head, t: term;
860 body: argbuf;
861 n: integer;
862 minus, more: boolean;
863 begin
864 if token = HASH then
865 Eat(HASH); head := NULL
866 else
867 head := ParseTerm();
868 CheckAtom(head)
869 end;
870 Eat(ARROW);
871 n := 0;
872 if token <> DOT then
873 more := true;
874 while more do
875 n := n+1; minus := false;
876 if token = NEGATE then
877 Eat(NEGATE); minus := true
878 end;
879 t := ParseTerm(); CheckAtom(t);
880 if minus then
881 body[n] := MakeNode(notsym, t, NULL)
882 else
883 body[n] := t
884 end;
885 if token = COMMA then Eat(COMMA) else more := false end
886 end
887 end;
888 Eat(DOT);
889
890 if errflag then
891 return NULL
892 else
893 return MakeClause(nvars, head, body, n)
894 end
895 end;
896
897 (* |ReadClause| -- read a clause from |infile| *)
898 proc ReadClause(): clause;
899 var c: clause;
900 begin
901 repeat
902 hp := hmark; nvars := 0; errflag := false;
903 Scan();
904 if token = EOFTOK then
905 c := NULL
906 else
907 c := ParseClause()
908 end
909 until (not errflag) or (token = EOFTOK);
910 return c
911 end;
912
913 type trail = ptr;
914
915 const TRAIL_SIZE = 3;
916
917 var trhead: trail; (* start of the trail *)
918
919 (* |Save| -- add a variable to the trail if it is critical *)
920 proc Save(v: term);
921 var p: trail;
922 begin
923 if ((v < choice) or (v >= mem[choice+4])) then
924 p := GloAlloc(UNDO, TRAIL_SIZE);
925 mem[p+1] := v; mem[p+2] := trhead; trhead := p
926 end
927 end;
928
929 (* |Restore| -- undo bindings back to previous state *)
930 proc Restore();
931 var v: term;
932 begin
933 while (trhead <> mem[choice+5]) do
934 v := mem[trhead+1];
935 if v <> NULL then mem[v+1] := NULL end;
936 trhead := mem[trhead+2]
937 end
938 end;
939
940 (* |Commit| -- blank out trail entries not needed after cut *)
941 proc Commit();
942 var p: trail;
943 begin
944 p := trhead;
945 while (p <> NULL) and (p < mem[choice+4]) do
946 if (mem[p+1] <> NULL) and not ((mem[p+1] < choice) or (mem[p+1] >= mem[choice+4])) then
947 mem[p+1] := NULL
948 end;
949 p := mem[p+2]
950 end
951 end;
952
953 (* |GloCopy| -- copy a term onto the global stack *)
954 proc GloCopy(t: term; e: frame): term;
955 var tt: term; i, n: integer;
956 begin
957 t := Deref(t, e);
958 if (t >= gsp) then
959 return t
960 else
961 case lsr(mem[t], 8) of
962 FUNC:
963 n := symtab[mem[t+1]].arity;
964 if (t <= hp) and (n = 0) then
965 return t
966 else
967 tt := GloAlloc(FUNC, TERM_SIZE+n);
968 mem[tt+1] := mem[t+1];
969 for i := 1 to n do
970 mem[tt+i+1] := GloCopy(mem[t+i+1], e)
971 end;
972 return tt
973 end
974 | CELL:
975 tt := GloAlloc(CELL, TERM_SIZE);
976 mem[tt+1] := NULL;
977 Save(t); mem[t+1] := tt;
978 return tt
979 else
980 return t
981 end
982 end
983 end;
984
985 (* |Share| -- bind two variables together *)
986 proc Share(v1, v2: term);
987 begin
988 if (v1 * (2 * ord((v1 >= gsp)) - 1)) <= (v2 * (2 * ord((v2 >= gsp)) - 1)) then
989 Save(v1); mem[v1+1] := v2
990 else
991 Save(v2); mem[v2+1] := v1
992 end
993 end;
994
995 (* |Unify| -- find and apply unifier for two terms *)
996 proc Unify(t1: term; e1: frame; t2: term; e2: frame): boolean;
997 var i: integer; match: boolean;
998 begin
999 t1 := Deref(t1, e1); t2 := Deref(t2, e2);
1000 if t1 = t2 then (* Includes unifying a var with itself *)
1001 return true
1002 elsif (lsr(mem[t1], 8) = CELL) and (lsr(mem[t2], 8) = CELL) then
1003 Share(t1, t2); return true
1004 elsif lsr(mem[t1], 8) = CELL then
1005 Save(t1); mem[t1+1] := GloCopy(t2, e2); return true
1006 elsif lsr(mem[t2], 8) = CELL then
1007 Save(t2); mem[t2+1] := GloCopy(t1, e1); return true
1008 elsif lsr(mem[t1], 8) <> lsr(mem[t2], 8) then
1009 return false
1010 else
1011 case lsr(mem[t1], 8) of
1012 FUNC:
1013 if (mem[t1+1] <> mem[t2+1]) then
1014 return false
1015 else
1016 i := 1; match := true;
1017 while match and (i <= symtab[mem[t1+1]].arity) do
1018 match := Unify(mem[t1+i+1], e1, mem[t2+i+1], e2);
1019 i := i+1
1020 end;
1021 return match
1022 end
1023 | INT:
1024 return (mem[t1+1] = mem[t2+1])
1025 | CHRCTR:
1026 return (mem[t1+1] = mem[t2+1])
1027 else
1028 newline(); print_string("Panic: "); print_string("bad tag" (*t_kind(t1):1, " in ", "Unify"*)); newline(); exit(2)
1029 end
1030 end
1031 end;
1032
1033 (* |Key| -- unification key of a term *)
1034 proc Key(t: term; e: frame): integer;
1035 var t0: term;
1036 begin
1037 (* The argument |t| must be a direct pointer to a compound term.
1038 The value returned is |key(t)|: if |t1| and |t2| are unifiable,
1039 then |key(t1) = 0| or |key(t2) = 0| or |key(t1) = key(t2)|. *)
1040
1041 if t = NULL then newline(); print_string("Panic: "); print_string("Key"); newline(); exit(2) end;
1042 if lsr(mem[t], 8) <> FUNC then newline(); print_string("Panic: "); print_string("bad tag" (*t_kind(t):1, " in ", "Key1"*)); newline(); exit(2) end;
1043
1044 if symtab[mem[t+1]].arity = 0 then
1045 return 0
1046 else
1047 t0 := Deref(mem[t+1+1], e);
1048 case lsr(mem[t0], 8) of
1049 FUNC: return mem[t0+1]
1050 | INT: return mem[t0+1] + 1
1051 | CHRCTR: return mem[t0+1] + 1
1052 else
1053 return 0
1054 end
1055 end
1056 end;
1057
1058 (* |Search| -- find the first clause that might match *)
1059 proc Search(t: term; e: frame; p: clause): clause;
1060 var k: integer;
1061 begin
1062 k := Key(t, e);
1063 if k <> 0 then
1064 while (p <> NULL) and (mem[p+1] <> 0) and (mem[p+1] <> k) do
1065 p := mem[p+2]
1066 end
1067 end;
1068 return p
1069 end;
1070
1071 var ok: boolean; (* whether execution succeeded *)
1072
1073 (* |PushFrame| -- create a new local stack frame *)
1074 proc PushFrame(nvars: integer; retry: clause);
1075 var f: frame; i: integer;
1076 begin
1077 f := LocAlloc((FRAME_SIZE + (nvars)*TERM_SIZE));
1078 mem[f] := current; mem[f+1] := goalframe;
1079 mem[f+2] := retry; mem[f+3] := choice;
1080 mem[f+4] := gsp; mem[f+5] := trhead;
1081 mem[f+6] := nvars;
1082 for i := 1 to nvars do
1083 mem[(f+7+(i-1)*TERM_SIZE)] := lsl(CELL, 8) + TERM_SIZE;
1084 mem[(f+7+(i-1)*TERM_SIZE)+1] := NULL
1085 end;
1086 goalframe := f;
1087 if retry <> NULL then choice := goalframe end
1088 end;
1089
1090 (* |TroStep| -- perform a resolution step with tail-recursion *)
1091 proc TroStep();
1092 var temp: frame; oldsize, newsize, i: integer;
1093 begin
1094 if dflag then print_string("(TRO)"); newline() end;
1095
1096 oldsize := (FRAME_SIZE + (mem[goalframe+6])*TERM_SIZE); (* size of old frame *)
1097 newsize := (FRAME_SIZE + (mem[prok])*TERM_SIZE); (* size of new frame *)
1098 temp := LocAlloc(newsize);
1099 temp := goalframe + newsize; (* copy old frame here *)
1100
1101 (* Copy the old frame: in reverse order in case of overlap *)
1102 for i := 1 to oldsize do
1103 mem[temp+oldsize-i] := mem[goalframe+oldsize-i]
1104 end;
1105
1106 (* Adjust internal pointers in the copy *)
1107 for i := 1 to mem[goalframe+6] do
1108 if (lsr(mem[(temp+7+(i-1)*TERM_SIZE)], 8) = CELL)
1109 and (mem[(temp+7+(i-1)*TERM_SIZE)+1] <> NULL)
1110 and (goalframe <= mem[(temp+7+(i-1)*TERM_SIZE)+1])
1111 and (mem[(temp+7+(i-1)*TERM_SIZE)+1] < goalframe + oldsize) then
1112 mem[(temp+7+(i-1)*TERM_SIZE)+1] := mem[(temp+7+(i-1)*TERM_SIZE)+1] + newsize
1113 end
1114 end;
1115
1116 (* Overwrite the old frame with the new one *)
1117 mem[goalframe+6] := mem[prok];
1118 for i := 1 to mem[goalframe+6] do
1119 mem[(goalframe+7+(i-1)*TERM_SIZE)] := lsl(CELL, 8) + TERM_SIZE;
1120 mem[(goalframe+7+(i-1)*TERM_SIZE)+1] := NULL
1121 end;
1122
1123 (* Perform the resolution step *)
1124 ok := Unify(call, temp, mem[prok+3], goalframe);
1125 current := (prok+4);
1126 lsp := temp-1
1127 end;
1128
1129 (* |Step| -- perform a resolution step *)
1130 proc Step();
1131 var retry: clause;
1132 begin
1133 if symtab[mem[call+1]].action <> 0 then
1134 ok := DoBuiltin(symtab[mem[call+1]].action)
1135 elsif prok = NULL then
1136 ok := false
1137 else
1138 retry := Search(call, goalframe, mem[prok+2]);
1139 if (mem[(current)+1] = NULL) and (choice < goalframe)
1140 and (retry = NULL) and (goalframe <> base) then
1141 TroStep()
1142 else
1143 PushFrame(mem[prok], retry);
1144 ok := Unify(call, mem[goalframe+1], mem[prok+3], goalframe);
1145 current := (prok+4);
1146 end
1147 end
1148 end;
1149
1150 (* |Unwind| -- return from completed clauses *)
1151 proc Unwind();
1152 begin
1153 while (mem[current] = NULL) and (goalframe <> base) do
1154 if dflag then
1155 print_string("Exit"); print_string(": ");
1156 PrintTerm(mem[mem[goalframe]], mem[goalframe+1], MAXPRIO); newline()
1157 end;
1158 current := (mem[goalframe])+1;
1159 if goalframe > choice then lsp := goalframe-1 end;
1160 goalframe := mem[goalframe+1]
1161 end
1162 end;
1163
1164 (* |Backtrack| -- roll back to the last choice-point *)
1165 proc Backtrack();
1166 begin
1167 Restore();
1168 current := mem[choice]; goalframe := mem[choice+1];
1169 call := Deref(mem[current], goalframe);
1170 prok := mem[choice+2]; gsp := mem[choice+4];
1171 lsp := choice-1; choice := mem[choice+3];
1172 if dflag then
1173 print_string("Redo"); print_string(": ");
1174 PrintTerm(call, goalframe, MAXPRIO); newline()
1175 end;
1176 end;
1177
1178 (* |Resume| -- continue execution *)
1179 proc Resume();
1180 begin
1181 while run do
1182 if ok then
1183 if mem[current] = NULL then return end;
1184 call := Deref(mem[current], goalframe);
1185 if dflag then
1186 print_string("Call"); print_string(": ");
1187 PrintTerm(call, goalframe, MAXPRIO); newline()
1188 end;
1189 if (symtab[mem[call+1]].prok = NULL)
1190 and (symtab[mem[call+1]].action = 0) then
1191 newline(); print_string("Error: "); print_string("call to undefined relation "); run := false;
1192 WriteString(symtab[mem[call+1]].name);
1193 return
1194 end;
1195 prok := Search(call, goalframe, symtab[mem[call+1]].prok)
1196 else
1197 if choice <= base then return end;
1198 Backtrack()
1199 end;
1200 Step();
1201 if ok then Unwind() end;
1202 end;
1203 end;
1204
1205 (* |Execute| -- solve a goal by SLD-resolution *)
1206 proc Execute(g: clause);
1207 var nsoln: integer;
1208 begin
1209 lsp := hp; gsp := MEMSIZE+1;
1210 current := NULL; goalframe := NULL; choice := NULL; trhead := NULL;
1211 PushFrame(mem[g], NULL);
1212 choice := goalframe; base := goalframe; current := (g+4);
1213 run := true; ok := true;
1214 Resume();
1215 if not run then return end;
1216 while ok do
1217 nsoln := nsoln+1;
1218 ShowAnswer(base);
1219 newline();
1220 ok := false;
1221 Resume();
1222 if not run then return end;
1223 end;
1224
1225 if nsoln = 0 then
1226 print_string("no"); newline(); newline();
1227 end
1228 end;
1229
1230 var
1231 av: argbuf; (* |GetArgs| puts arguments here *)
1232 callbody: ptr; (* dummy clause body used by |call/1| *)
1233
1234 (* |GetArgs| -- set up |av| array *)
1235 proc GetArgs();
1236 var i: integer;
1237 begin
1238 for i := 1 to symtab[mem[call+1]].arity do
1239 av[i] := Deref(mem[call+i+1], goalframe)
1240 end
1241 end;
1242
1243 proc NewInt(n: integer): term;
1244 var t: term;
1245 begin
1246 t := GloAlloc(INT, TERM_SIZE);
1247 mem[t+1] := n;
1248 return t
1249 end;
1250
1251 (* |DoCut| -- built-in relation !/0 *)
1252 proc DoCut(): boolean;
1253 begin
1254 choice := mem[goalframe+3];
1255 lsp := goalframe + (FRAME_SIZE + (mem[goalframe+6])*TERM_SIZE) - 1;
1256 Commit();
1257 current := (current)+1;
1258 return true
1259 end;
1260
1261 (* |DoCall| -- built-in relation |call/1| *)
1262 proc DoCall(): boolean;
1263 begin
1264 GetArgs();
1265 if not (lsr(mem[av[1]], 8) = FUNC) then
1266 newline(); print_string("Error: "); print_string("bad argument to call/1"); run := false;
1267 return false
1268 else
1269 PushFrame(1, NULL);
1270 mem[(goalframe+7+(1-1)*TERM_SIZE)+1] :=
1271 GloCopy(av[1], mem[goalframe+1]);
1272 current := callbody;
1273 return true
1274 end
1275 end;
1276
1277 (* |DoNot| -- built-in relation |not/1| *)
1278 proc DoNot(): boolean;
1279 var savebase: frame;
1280 begin
1281 GetArgs();
1282 if not (lsr(mem[av[1]], 8) = FUNC) then
1283 newline(); print_string("Error: "); print_string("bad argument to call/1"); run := false;
1284 return false
1285 else
1286 PushFrame(1, NULL);
1287 savebase := base; base := goalframe; choice := goalframe;
1288 mem[(goalframe+7+(1-1)*TERM_SIZE)+1] :=
1289 GloCopy(av[1], mem[goalframe+1]);
1290 current := callbody; ok := true;
1291 Resume();
1292 choice := mem[base+3]; goalframe := mem[base+1];
1293 if not ok then
1294 current := (mem[base])+1;
1295 return true
1296 else
1297 Commit();
1298 return false
1299 end;
1300 lsp := base-1; base := savebase
1301 end
1302 end;
1303
1304 (* |DoPlus| -- built-in relation |plus/3| *)
1305 proc DoPlus(): boolean;
1306 var result: boolean;
1307 begin
1308 GetArgs();
1309 result := false;
1310 if (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[2]], 8) = INT) then
1311 result := Unify(av[3], goalframe, NewInt(mem[av[1]+1] + mem[av[2]+1]), NULL)
1312 elsif (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
1313 if mem[av[1]+1] <= mem[av[3]+1] then
1314 result := Unify(av[2], goalframe,
1315 NewInt(mem[av[3]+1] - mem[av[1]+1]), NULL)
1316 end
1317 elsif (lsr(mem[av[2]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
1318 if mem[av[2]+1] <= mem[av[3]+1] then
1319 result := Unify(av[1], goalframe, NewInt(mem[av[3]+1] - mem[av[2]+1]), NULL)
1320 end
1321 else
1322 newline(); print_string("Error: "); print_string("plus/3 needs at least two integers"); run := false
1323 end;
1324 current := (current)+1;
1325 return result
1326 end;
1327
1328 (* |DoTimes| -- built-in relation |times/3| *)
1329 proc DoTimes(): boolean;
1330 var result: boolean;
1331 begin
1332 GetArgs();
1333 result := false;
1334 if (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[2]], 8) = INT) then
1335 result := Unify(av[3], goalframe,
1336 NewInt(mem[av[1]+1] * mem[av[2]+1]), NULL)
1337 elsif (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
1338 if mem[av[1]+1] <> 0 then
1339 if mem[av[3]+1] mod mem[av[1]+1] = 0 then
1340 result := Unify(av[2], goalframe,
1341 NewInt(mem[av[3]+1] div mem[av[1]+1]), NULL)
1342 end
1343 end
1344 elsif (lsr(mem[av[2]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
1345 if mem[av[2]+1] <> 0 then
1346 if mem[av[3]+1] mod mem[av[2]+1] = 0 then
1347 result := Unify(av[1], goalframe,
1348 NewInt(mem[av[3]+1] div mem[av[2]+1]), NULL)
1349 end
1350 end
1351 else
1352 newline(); print_string("Error: "); print_string("times/3 needs at least two integers"); run := false
1353 end;
1354 current := (current)+1;
1355 return result
1356 end;
1357
1358 (* |DoEqual| -- built-in relation |=/2| *)
1359 proc DoEqual(): boolean;
1360 begin
1361 GetArgs();
1362 current := (current)+1;
1363 return Unify(av[1], goalframe, av[2], goalframe)
1364 end;
1365
1366 (* |DoInteger| -- built-in relation |integer/1| *)
1367 proc DoInteger(): boolean;
1368 begin
1369 GetArgs();
1370 current := (current)+1;
1371 return (lsr(mem[av[1]], 8) = INT)
1372 end;
1373
1374 (* |DoChar| -- built-in relation |char/1| *)
1375 proc DoChar(): boolean;
1376 begin
1377 GetArgs();
1378 current := (current)+1;
1379 return (lsr(mem[av[1]], 8) = CHRCTR)
1380 end;
1381
1382 (* |DoPrint| -- built-in relation |print/1| *)
1383 proc DoPrint(): boolean;
1384 begin
1385 GetArgs();
1386 PrintTerm(av[1], goalframe, MAXPRIO);
1387 current := (current)+1;
1388 return true
1389 end;
1390
1391 (* |DoNl| -- built-in relation |nl/0| *)
1392 proc DoNl(): boolean;
1393 begin
1394 newline();
1395 current := (current)+1;
1396 return true
1397 end;
1398
1399 (* |DoBuiltin| -- switch for built-in relations *)
1400 proc DoBuiltin(action: integer): boolean;
1401 begin
1402 case action of
1403 CUT: return DoCut()
1404 | CALL: return DoCall()
1405 | PLUS: return DoPlus()
1406 | TIMES: return DoTimes()
1407 | ISINT: return DoInteger()
1408 | ISCHAR: return DoChar()
1409 | NAFF: return DoNot()
1410 | EQUALITY: return DoEqual()
1411 | FAIL: return false
1412 | PRINT: return DoPrint()
1413 | NL: return DoNl()
1414 else
1415 newline(); print_string("Panic: "); print_string("bad tag" (*action:1, " in ", "DoBuiltin"*)); newline(); exit(2)
1416 end
1417 end;
1418
1419 (* |Initialize| -- initialize everything *)
1420 proc Initialize();
1421 var i: integer; p: term;
1422 begin
1423 dflag := false; errcount := 0;
1424 pbchar := ENDFILE; charptr := 0;
1425 hp := 0; InitSymbols();
1426
1427 (* Set up the |refnode| array *)
1428 for i := 1 to MAXARITY do
1429 p := HeapAlloc(TERM_SIZE);
1430 mem[p] := lsl(REF, 8) + TERM_SIZE;
1431 mem[p+1] := i; refnode[i] := p
1432 end;
1433
1434 (* The dummy clause $\it call(\sci p) \IF p$ is used by |call/1|. *)
1435 callbody := HeapAlloc(2);
1436 mem[callbody] := MakeRef(1);
1437 mem[(callbody)+1] := NULL
1438 end;
1439
1440 (* |ReadFile| -- read and process clauses from an open file *)
1441 proc ReadFile();
1442 var c: clause;
1443 ch: char;
1444 begin
1445 lineno := 1;
1446 repeat
1447 hmark := hp;
1448 c := ReadClause();
1449 if c <> NULL then
1450 if dflag then PrintClause(c) end;
1451 if mem[c+3] <> NULL then
1452 AddClause(c)
1453 else
1454 Execute(c);
1455 hp := hmark
1456 end
1457 end
1458 until c = NULL
1459 end;
1460
1461 begin (* main program *)
1462 prog("subject( ");
1463 prog(" <store, ");
1464 prog(" <load, ");
1465 prog(" <plusa, ");
1466 prog(" <global(a)>, ");
1467 prog(" <lsl, <load, <local(16)>>, <const(2)>>>>, ");
1468 prog(" <local(20)>> ");
1469 prog(") :- . ");
1470
1471 prog("rule(""*str"", stmt, <store, reg, addr>) :- . ");
1472 prog("rule(""*ldr"", reg, <load, addr>) :- . ");
1473 prog("rule(""*addfp"", reg, <local(N)>) :- . ");
1474 prog("rule(""local"", addr, <local(N)>) :- . ");
1475 prog("rule(""*add"", reg, <plusa, reg, rand>) :- . ");
1476 prog("rule(""index"", addr, <plusa, reg, reg>) :- . ");
1477 prog("rule(""scale"", addr, ");
1478 prog(" <plusa, reg, <lsl, reg, <const(N)>>>) :- . ");
1479 prog("rule(""*global"", reg, <global(X)>) :- . ");
1480 prog("rule(""*lsl"", reg, <lsl, reg, rand>) :- . ");
1481 prog("rule(""lshiftc"", rand, <lsl, reg, <const(N)>>) :- . ");
1482 prog("rule(""lshiftr"", rand, <lsl, reg, reg>) :- . ");
1483 prog("rule(""*mov"", reg, <const(N)>) :- . ");
1484 prog("rule(""const"", rand, <const(N)>) :- . ");
1485 prog("rule(""reg"", rand, reg) :- . ");
1486 prog("rule(""indir"", addr, reg) :- . ");
1487
1488 prog("use_rule(NT, Tree, node(Name, Kids)) :- ");
1489 prog(" rule(Name, NT, RHS), match(RHS, Tree, Kids, nil). ");
1490
1491 prog("match(NT, Tree, Parse:Kids0, Kids0) :- ");
1492 prog(" use_rule(NT, Tree, Parse). ");
1493
1494 prog("match(node(W, PS), node(W, TS), Kids, Kids0) :- ");
1495 prog(" matchall(PS, TS, Kids, Kids0). ");
1496
1497 prog("matchall(nil, nil, Kids0, Kids0) :- . ");
1498 prog("matchall(P:PS, T:TS, Kids, Kids0) :- ");
1499 prog(" match(P, T, Kids, Kids1), matchall(PS, TS, Kids1, Kids0). ");
1500
1501 prog("cost(node(X, TS), C) :- ");
1502 prog(" opcost(X, A), allcosts(TS, B), plus(A, B, C). ");
1503
1504 prog("allcosts(nil, 0) :- . ");
1505 prog("allcosts(T:TS, C) :- ");
1506 prog(" cost(T, A), allcosts(TS, B), plus(A, B, C). ");
1507
1508 prog("opcost('*':_, 1) :- !. ");
1509 prog("opcost(_, 0) :- . ");
1510
1511 prog("answer(P, C) :- ");
1512 prog(" subject(T), use_rule(stmt, T, P), cost(P, C). ");
1513
1514 prog("min(N, P) :- min1(N, 0, P). ");
1515 prog("min1(N, N, P) :- call(P), !. ");
1516 prog("min1(N, N0, P) :- plus(N0, 1, N1), min1(N, N1, P). ");
1517
1518 prog("# :- answer(P, C). ");
1519
1520 Initialize();
1521 ReadFile()
1522 end.
1523
1524 (*<<
1525 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"const">>>>, <"local">>
1526 C = 5
1527
1528 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"const">>>>, <"indir", <"*addfp">>>
1529 C = 6
1530
1531 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>, <"local">>
1532 C = 6
1533
1534 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>, <"indir", <"*addfp">>>
1535 C = 7
1536
1537 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>, <"local">>
1538 C = 6
1539
1540 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>, <"indir", <"*addfp">>>
1541 C = 7
1542
1543 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>, <"local">>
1544 C = 7
1545
1546 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>, <"indir", <"*addfp">>>
1547 C = 8
1548
1549 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"local">>>>, <"local">>
1550 C = 4
1551
1552 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"local">>>>, <"indir", <"*addfp">>>
1553 C = 5
1554
1555 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"indir", <"*addfp">>>>>, <"local">>
1556 C = 5
1557
1558 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"indir", <"*addfp">>>>>, <"indir", <"*addfp">>>
1559 C = 6
1560
1561 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"local">>>>>>, <"local">>
1562 C = 5
1563
1564 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"local">>>>>>, <"indir", <"*addfp">>>
1565 C = 6
1566
1567 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"indir", <"*addfp">>>>>>>, <"local">>
1568 C = 6
1569
1570 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"indir", <"*addfp">>>>>>>, <"indir", <"*addfp">>>
1571 C = 7
1572
1573 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"local">>, <"*mov">>>>>, <"local">>
1574 C = 6
1575
1576 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"local">>, <"*mov">>>>>, <"indir", <"*addfp">>>
1577 C = 7
1578
1579 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"indir", <"*addfp">>>, <"*mov">>>>>, <"local">>
1580 C = 7
1581
1582 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"indir", <"*addfp">>>, <"*mov">>>>>, <"indir", <"*addfp">>>
1583 C = 8
1584
1585 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"const">>>>>>, <"local">>
1586 C = 6
1587
1588 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"const">>>>>>, <"indir", <"*addfp">>>
1589 C = 7
1590
1591 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>>>, <"local">>
1592 C = 7
1593
1594 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>>>, <"indir", <"*addfp">>>
1595 C = 8
1596
1597 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>>>, <"local">>
1598 C = 7
1599
1600 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>>>, <"indir", <"*addfp">>>
1601 C = 8
1602
1603 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>>>, <"local">>
1604 C = 8
1605
1606 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>>>, <"indir", <"*addfp">>>
1607 C = 9
1608
1609 >>*)
1610
1611 (*[[
1612 @ picoPascal compiler output
1613 .include "fixup.s"
1614 .global pmain
1615
1616 @ proc StringLength(var s: tempstring): integer;
1617 .text
1618 _StringLength:
1619 mov ip, sp
1620 stmfd sp!, {r0-r1}
1621 stmfd sp!, {r4-r10, fp, ip, lr}
1622 mov fp, sp
1623 @ i := 0;
1624 mov r4, #0
1625 .L147:
1626 @ while s[i] <> ENDSTR do i := i+1 end;
1627 ldr r0, [fp, #40]
1628 add r0, r0, r4
1629 ldrb r0, [r0]
1630 cmp r0, #0
1631 beq .L149
1632 add r4, r4, #1
1633 b .L147
1634 .L149:
1635 @ return i
1636 mov r0, r4
1637 ldmfd fp, {r4-r10, fp, sp, pc}
1638 .ltorg
1639
1640 @ proc SaveString(var s: tempstring): permstring;
1641 _SaveString:
1642 mov ip, sp
1643 stmfd sp!, {r0-r1}
1644 stmfd sp!, {r4-r10, fp, ip, lr}
1645 mov fp, sp
1646 @ if charptr + StringLength(s) + 1 > MAXCHARS then
1647 ldr r0, [fp, #40]
1648 bl _StringLength
1649 set r1, _charptr
1650 ldr r1, [r1]
1651 add r0, r1, r0
1652 add r0, r0, #1
1653 cmp r0, #2048
1654 ble .L153
1655 @ newline(); print_string("Panic: "); print_string("out of string space"); newline(); exit(2)
1656 bl newline
1657 mov r1, #7
1658 set r0, g1
1659 bl print_string
1660 mov r1, #19
1661 set r0, g2
1662 bl print_string
1663 bl newline
1664 mov r0, #2
1665 bl exit
1666 .L153:
1667 @ p := charptr; i := 0;
1668 set r0, _charptr
1669 ldr r4, [r0]
1670 mov r5, #0
1671 .L154:
1672 @ charbuf[charptr] := s[i]; charptr := charptr+1; i := i+1
1673 set r6, _charbuf
1674 set r7, _charptr
1675 ldr r0, [fp, #40]
1676 add r0, r0, r5
1677 ldrb r0, [r0]
1678 ldr r1, [r7]
1679 add r1, r6, r1
1680 strb r0, [r1]
1681 ldr r0, [r7]
1682 add r8, r0, #1
1683 str r8, [r7]
1684 add r5, r5, #1
1685 add r0, r6, r8
1686 ldrb r0, [r0, #-1]
1687 cmp r0, #0
1688 bne .L154
1689 @ return p
1690 mov r0, r4
1691 ldmfd fp, {r4-r10, fp, sp, pc}
1692 .ltorg
1693
1694 @ proc StringEqual(var s1: tempstring; s2: permstring): boolean;
1695 _StringEqual:
1696 mov ip, sp
1697 stmfd sp!, {r0-r1}
1698 stmfd sp!, {r4-r10, fp, ip, lr}
1699 mov fp, sp
1700 @ i := 0;
1701 mov r4, #0
1702 .L157:
1703 @ while (s1[i] <> ENDSTR) and (s1[i] = charbuf[s2+i]) do i := i+1 end;
1704 ldr r0, [fp, #40]
1705 add r0, r0, r4
1706 ldrb r5, [r0]
1707 cmp r5, #0
1708 beq .L159
1709 set r0, _charbuf
1710 ldr r1, [fp, #44]
1711 add r0, r0, r1
1712 add r0, r0, r4
1713 ldrb r0, [r0]
1714 cmp r5, r0
1715 bne .L159
1716 add r4, r4, #1
1717 b .L157
1718 .L159:
1719 @ return (s1[i] = charbuf[s2+i])
1720 ldr r0, [fp, #40]
1721 add r0, r0, r4
1722 ldrb r0, [r0]
1723 set r1, _charbuf
1724 ldr r2, [fp, #44]
1725 add r1, r1, r2
1726 add r1, r1, r4
1727 ldrb r1, [r1]
1728 cmp r0, r1
1729 mov r0, #0
1730 moveq r0, #1
1731 ldmfd fp, {r4-r10, fp, sp, pc}
1732 .ltorg
1733
1734 @ proc WriteString(s: permstring);
1735 _WriteString:
1736 mov ip, sp
1737 stmfd sp!, {r0-r1}
1738 stmfd sp!, {r4-r10, fp, ip, lr}
1739 mov fp, sp
1740 @ i := s;
1741 ldr r4, [fp, #40]
1742 .L162:
1743 @ while charbuf[i] <> ENDSTR do
1744 set r0, _charbuf
1745 add r0, r0, r4
1746 ldrb r5, [r0]
1747 cmp r5, #0
1748 beq .L161
1749 @ print_char(charbuf[i]); i := i+1
1750 mov r0, r5
1751 bl print_char
1752 add r4, r4, #1
1753 b .L162
1754 .L161:
1755 ldmfd fp, {r4-r10, fp, sp, pc}
1756 .ltorg
1757
1758 @ proc LocAlloc(size: integer): ptr;
1759 _LocAlloc:
1760 mov ip, sp
1761 stmfd sp!, {r0-r1}
1762 stmfd sp!, {r4-r10, fp, ip, lr}
1763 mov fp, sp
1764 @ if lsp + size >= gsp then newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2) end;
1765 set r0, _lsp
1766 ldr r0, [r0]
1767 ldr r1, [fp, #40]
1768 add r0, r0, r1
1769 set r1, _gsp
1770 ldr r1, [r1]
1771 cmp r0, r1
1772 blt .L168
1773 bl newline
1774 mov r1, #7
1775 set r0, g3
1776 bl print_string
1777 mov r1, #18
1778 set r0, g4
1779 bl print_string
1780 bl newline
1781 mov r0, #2
1782 bl exit
1783 .L168:
1784 @ p := lsp + 1; lsp := lsp + size; return p
1785 set r5, _lsp
1786 ldr r6, [r5]
1787 add r4, r6, #1
1788 ldr r0, [fp, #40]
1789 add r0, r6, r0
1790 str r0, [r5]
1791 mov r0, r4
1792 ldmfd fp, {r4-r10, fp, sp, pc}
1793 .ltorg
1794
1795 @ proc GloAlloc(kind, size: integer): ptr;
1796 _GloAlloc:
1797 mov ip, sp
1798 stmfd sp!, {r0-r1}
1799 stmfd sp!, {r4-r10, fp, ip, lr}
1800 mov fp, sp
1801 @ if gsp - size <= lsp then
1802 set r0, _gsp
1803 ldr r0, [r0]
1804 ldr r1, [fp, #44]
1805 sub r0, r0, r1
1806 set r1, _lsp
1807 ldr r1, [r1]
1808 cmp r0, r1
1809 bgt .L172
1810 @ newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2)
1811 bl newline
1812 mov r1, #7
1813 set r0, g5
1814 bl print_string
1815 mov r1, #18
1816 set r0, g6
1817 bl print_string
1818 bl newline
1819 mov r0, #2
1820 bl exit
1821 .L172:
1822 @ gsp := gsp - size; p := gsp;
1823 set r5, _gsp
1824 ldr r6, [fp, #44]
1825 ldr r0, [r5]
1826 sub r7, r0, r6
1827 str r7, [r5]
1828 mov r4, r7
1829 @ mem[p] := lsl(kind, 8) + size;
1830 ldr r0, [fp, #40]
1831 lsl r0, r0, #8
1832 add r0, r0, r6
1833 set r1, _mem
1834 lsl r2, r4, #2
1835 add r1, r1, r2
1836 str r0, [r1]
1837 @ return p
1838 mov r0, r4
1839 ldmfd fp, {r4-r10, fp, sp, pc}
1840 .ltorg
1841
1842 @ proc HeapAlloc(size: integer): ptr;
1843 _HeapAlloc:
1844 mov ip, sp
1845 stmfd sp!, {r0-r1}
1846 stmfd sp!, {r4-r10, fp, ip, lr}
1847 mov fp, sp
1848 @ if hp + size > MEMSIZE then newline(); print_string("Panic: "); print_string("out of heap space"); newline(); exit(2) end;
1849 set r0, _hp
1850 ldr r0, [r0]
1851 ldr r1, [fp, #40]
1852 add r0, r0, r1
1853 set r1, #25000
1854 cmp r0, r1
1855 ble .L176
1856 bl newline
1857 mov r1, #7
1858 set r0, g7
1859 bl print_string
1860 mov r1, #17
1861 set r0, g8
1862 bl print_string
1863 bl newline
1864 mov r0, #2
1865 bl exit
1866 .L176:
1867 @ p := hp + 1; hp := hp + size; return p
1868 set r5, _hp
1869 ldr r6, [r5]
1870 add r4, r6, #1
1871 ldr r0, [fp, #40]
1872 add r0, r6, r0
1873 str r0, [r5]
1874 mov r0, r4
1875 ldmfd fp, {r4-r10, fp, sp, pc}
1876 .ltorg
1877
1878 @ proc prog(line: array 60 of char);
1879 _prog:
1880 mov ip, sp
1881 stmfd sp!, {r0-r1}
1882 stmfd sp!, {r4-r10, fp, ip, lr}
1883 mov fp, sp
1884 @ for i := 0 to 59 do
1885 mov r4, #0
1886 mov r5, #59
1887 .L178:
1888 cmp r4, r5
1889 bgt .L179
1890 @ infile[pin] := line[i]; pin := pin+1
1891 set r6, _pin
1892 ldr r0, [fp, #40]
1893 add r0, r0, r4
1894 ldrb r0, [r0]
1895 set r1, _infile
1896 ldr r2, [r6]
1897 add r1, r1, r2
1898 strb r0, [r1]
1899 ldr r0, [r6]
1900 add r0, r0, #1
1901 str r0, [r6]
1902 add r4, r4, #1
1903 b .L178
1904 .L179:
1905 @ infile[pin] := ENDLINE; pin := pin+1
1906 set r6, _pin
1907 mov r0, #10
1908 set r1, _infile
1909 ldr r2, [r6]
1910 add r1, r1, r2
1911 strb r0, [r1]
1912 ldr r0, [r6]
1913 add r0, r0, #1
1914 str r0, [r6]
1915 ldmfd fp, {r4-r10, fp, sp, pc}
1916 .ltorg
1917
1918 @ proc rdchar(var ch: char);
1919 _rdchar:
1920 mov ip, sp
1921 stmfd sp!, {r0-r1}
1922 stmfd sp!, {r4-r10, fp, ip, lr}
1923 mov fp, sp
1924 @ if pout >= pin then
1925 set r0, _pout
1926 ldr r0, [r0]
1927 set r1, _pin
1928 ldr r1, [r1]
1929 cmp r0, r1
1930 blt .L182
1931 @ ch := ENDFILE
1932 mov r0, #127
1933 ldr r1, [fp, #40]
1934 strb r0, [r1]
1935 b .L180
1936 .L182:
1937 @ ch := infile[pout]; pout := pout+1
1938 set r4, _pout
1939 set r0, _infile
1940 ldr r1, [r4]
1941 add r0, r0, r1
1942 ldrb r0, [r0]
1943 ldr r1, [fp, #40]
1944 strb r0, [r1]
1945 ldr r0, [r4]
1946 add r0, r0, #1
1947 str r0, [r4]
1948 .L180:
1949 ldmfd fp, {r4-r10, fp, sp, pc}
1950 .ltorg
1951
1952 @ proc GetChar(): char;
1953 _GetChar:
1954 mov ip, sp
1955 stmfd sp!, {r4-r10, fp, ip, lr}
1956 mov fp, sp
1957 sub sp, sp, #8
1958 @ if pbchar <> ENDFILE then
1959 set r4, _pbchar
1960 ldrb r5, [r4]
1961 cmp r5, #127
1962 beq .L186
1963 @ ch := pbchar; pbchar := ENDFILE
1964 strb r5, [fp, #-1]
1965 mov r0, #127
1966 strb r0, [r4]
1967 b .L187
1968 .L186:
1969 @ rdchar(ch);
1970 add r0, fp, #-1
1971 bl _rdchar
1972 @ if ch = ENDLINE then lineno := lineno+1 end
1973 ldrb r0, [fp, #-1]
1974 cmp r0, #10
1975 bne .L187
1976 set r4, _lineno
1977 ldr r0, [r4]
1978 add r0, r0, #1
1979 str r0, [r4]
1980 .L187:
1981 @ return ch
1982 ldrb r0, [fp, #-1]
1983 ldmfd fp, {r4-r10, fp, sp, pc}
1984 .ltorg
1985
1986 @ proc PushBack(ch: char);
1987 _PushBack:
1988 mov ip, sp
1989 stmfd sp!, {r0-r1}
1990 stmfd sp!, {r4-r10, fp, ip, lr}
1991 mov fp, sp
1992 @ pbchar := ch
1993 ldrb r0, [fp, #40]
1994 set r1, _pbchar
1995 strb r0, [r1]
1996 ldmfd fp, {r4-r10, fp, sp, pc}
1997 .ltorg
1998
1999 @ proc Deref(t: term; e: frame): term;
2000 _Deref:
2001 mov ip, sp
2002 stmfd sp!, {r0-r1}
2003 stmfd sp!, {r4-r10, fp, ip, lr}
2004 mov fp, sp
2005 @ if t = NULL then newline(); print_string("Panic: "); print_string("Deref"); newline(); exit(2) end;
2006 ldr r0, [fp, #40]
2007 cmp r0, #0
2008 bne .L195
2009 bl newline
2010 mov r1, #7
2011 set r0, g9
2012 bl print_string
2013 mov r1, #5
2014 set r0, g10
2015 bl print_string
2016 bl newline
2017 mov r0, #2
2018 bl exit
2019 .L195:
2020 @ if (lsr(mem[t], 8) = REF) and (e <> NULL) then
2021 set r0, _mem
2022 ldr r1, [fp, #40]
2023 lsl r1, r1, #2
2024 add r4, r0, r1
2025 ldr r0, [r4]
2026 lsr r0, r0, #8
2027 cmp r0, #5
2028 bne .L200
2029 ldr r5, [fp, #44]
2030 cmp r5, #0
2031 beq .L200
2032 @ t := (e+7+(mem[t+1]-1)*TERM_SIZE)
2033 add r0, r5, #7
2034 ldr r1, [r4, #4]
2035 lsl r1, r1, #1
2036 sub r1, r1, #2
2037 add r0, r0, r1
2038 str r0, [fp, #40]
2039 .L200:
2040 @ while (lsr(mem[t], 8) = CELL) and (mem[t+1] <> NULL) do
2041 set r0, _mem
2042 ldr r1, [fp, #40]
2043 lsl r1, r1, #2
2044 add r4, r0, r1
2045 ldr r0, [r4]
2046 lsr r0, r0, #8
2047 cmp r0, #4
2048 bne .L202
2049 ldr r4, [r4, #4]
2050 cmp r4, #0
2051 beq .L202
2052 @ t := mem[t+1]
2053 str r4, [fp, #40]
2054 b .L200
2055 .L202:
2056 @ return t
2057 ldr r0, [fp, #40]
2058 ldmfd fp, {r4-r10, fp, sp, pc}
2059 .ltorg
2060
2061 @ proc Lookup(var name: tempstring): symbol;
2062 _Lookup:
2063 mov ip, sp
2064 stmfd sp!, {r0-r1}
2065 stmfd sp!, {r4-r10, fp, ip, lr}
2066 mov fp, sp
2067 @ h := 0; i := 0;
2068 mov r4, #0
2069 mov r5, #0
2070 .L205:
2071 @ while name[i] <> ENDSTR do
2072 ldr r0, [fp, #40]
2073 add r0, r0, r5
2074 ldrb r7, [r0]
2075 cmp r7, #0
2076 beq .L207
2077 @ h := (5 * h + ord(name[i])) mod MAXSYMBOLS; i := i+1
2078 set r1, #511
2079 mov r0, #5
2080 mul r0, r4, r0
2081 add r0, r0, r7
2082 bl int_mod
2083 mov r4, r0
2084 add r5, r5, #1
2085 b .L205
2086 .L207:
2087 @ p := h+1;
2088 add r6, r4, #1
2089 .L208:
2090 @ while symtab[p].name <> -1 do
2091 set r0, _symtab
2092 lsl r1, r6, #4
2093 add r0, r0, r1
2094 ldr r7, [r0]
2095 mov r0, #-1
2096 cmp r7, r0
2097 beq .L210
2098 @ if StringEqual(name, symtab[p].name) then return p end;
2099 mov r1, r7
2100 ldr r0, [fp, #40]
2101 bl _StringEqual
2102 cmp r0, #0
2103 beq .L213
2104 mov r0, r6
2105 b .L204
2106 .L213:
2107 @ p := p-1;
2108 sub r6, r6, #1
2109 @ if p = 0 then p := MAXSYMBOLS end
2110 cmp r6, #0
2111 bne .L208
2112 set r6, #511
2113 b .L208
2114 .L210:
2115 @ if nsymbols >= (MAXSYMBOLS div 10) * (HASHFACTOR div 10) then
2116 set r0, _nsymbols
2117 ldr r0, [r0]
2118 set r1, #459
2119 cmp r0, r1
2120 blt .L219
2121 @ newline(); print_string("Panic: "); print_string("out of symbol space"); newline(); exit(2)
2122 bl newline
2123 mov r1, #7
2124 set r0, g11
2125 bl print_string
2126 mov r1, #19
2127 set r0, g12
2128 bl print_string
2129 bl newline
2130 mov r0, #2
2131 bl exit
2132 .L219:
2133 @ symtab[p].name := SaveString(name);
2134 ldr r0, [fp, #40]
2135 bl _SaveString
2136 set r1, _symtab
2137 lsl r2, r6, #4
2138 add r7, r1, r2
2139 str r0, [r7]
2140 @ symtab[p].arity := -1;
2141 mov r0, #-1
2142 str r0, [r7, #4]
2143 @ symtab[p].action := 0; symtab[p].prok := NULL;
2144 mov r0, #0
2145 str r0, [r7, #8]
2146 mov r0, #0
2147 str r0, [r7, #12]
2148 @ return p
2149 mov r0, r6
2150 .L204:
2151 ldmfd fp, {r4-r10, fp, sp, pc}
2152 .ltorg
2153
2154 @ proc Enter(name: keyword; arity: integer; action: integer): symbol;
2155 _Enter:
2156 mov ip, sp
2157 stmfd sp!, {r0-r3}
2158 stmfd sp!, {r4-r10, fp, ip, lr}
2159 mov fp, sp
2160 sub sp, sp, #128
2161 @ i := 0;
2162 mov r5, #0
2163 .L221:
2164 @ while name[i] <> ' ' do
2165 ldr r0, [fp, #40]
2166 add r0, r0, r5
2167 ldrb r6, [r0]
2168 cmp r6, #32
2169 beq .L223
2170 @ temp[i] := name[i]; i := i+1
2171 add r0, fp, #-128
2172 add r0, r0, r5
2173 strb r6, [r0]
2174 add r5, r5, #1
2175 b .L221
2176 .L223:
2177 @ temp[i] := ENDSTR; s := Lookup(temp);
2178 mov r0, #0
2179 add r1, fp, #-128
2180 add r1, r1, r5
2181 strb r0, [r1]
2182 add r0, fp, #-128
2183 bl _Lookup
2184 mov r4, r0
2185 @ symtab[s].arity := arity; symtab[s].action := action;
2186 set r0, _symtab
2187 lsl r1, r4, #4
2188 add r6, r0, r1
2189 ldr r0, [fp, #44]
2190 str r0, [r6, #4]
2191 ldr r0, [fp, #48]
2192 str r0, [r6, #8]
2193 @ return s
2194 mov r0, r4
2195 ldmfd fp, {r4-r10, fp, sp, pc}
2196 .ltorg
2197
2198 @ proc InitSymbols();
2199 _InitSymbols:
2200 mov ip, sp
2201 stmfd sp!, {r4-r10, fp, ip, lr}
2202 mov fp, sp
2203 @ nsymbols := 0;
2204 mov r0, #0
2205 set r1, _nsymbols
2206 str r0, [r1]
2207 @ for i := 1 to MAXSYMBOLS do symtab[i].name := -1 end;
2208 mov r4, #1
2209 set r6, #511
2210 .L225:
2211 cmp r4, r6
2212 bgt .L226
2213 mov r0, #-1
2214 set r1, _symtab
2215 lsl r2, r4, #4
2216 add r1, r1, r2
2217 str r0, [r1]
2218 add r4, r4, #1
2219 b .L225
2220 .L226:
2221 @ cons := Enter(": ", 2, 0);
2222 mov r2, #0
2223 mov r1, #2
2224 set r0, g13
2225 bl _Enter
2226 set r1, _cons
2227 str r0, [r1]
2228 @ cutsym := Enter("! ", 0, CUT);
2229 mov r2, #1
2230 mov r1, #0
2231 set r0, g14
2232 bl _Enter
2233 set r1, _cutsym
2234 str r0, [r1]
2235 @ eqsym := Enter("= ", 2, EQUALITY);
2236 mov r2, #8
2237 mov r1, #2
2238 set r0, g15
2239 bl _Enter
2240 set r1, _eqsym
2241 str r0, [r1]
2242 @ nilsym := Enter("nil ", 0, 0);
2243 mov r2, #0
2244 mov r1, #0
2245 set r0, g16
2246 bl _Enter
2247 set r1, _nilsym
2248 str r0, [r1]
2249 @ notsym := Enter("not ", 1, NAFF);
2250 mov r2, #7
2251 mov r1, #1
2252 set r0, g17
2253 bl _Enter
2254 set r1, _notsym
2255 str r0, [r1]
2256 @ node := Enter("node ", 2, 0);
2257 mov r2, #0
2258 mov r1, #2
2259 set r0, g18
2260 bl _Enter
2261 set r1, _node
2262 str r0, [r1]
2263 @ dummy := Enter("call ", 1, CALL);
2264 mov r2, #2
2265 mov r1, #1
2266 set r0, g19
2267 bl _Enter
2268 mov r5, r0
2269 @ dummy := Enter("plus ", 3, PLUS);
2270 mov r2, #3
2271 mov r1, #3
2272 set r0, g20
2273 bl _Enter
2274 mov r5, r0
2275 @ dummy := Enter("times ", 3, TIMES);
2276 mov r2, #4
2277 mov r1, #3
2278 set r0, g21
2279 bl _Enter
2280 mov r5, r0
2281 @ dummy := Enter("integer ", 1, ISINT);
2282 mov r2, #5
2283 mov r1, #1
2284 set r0, g22
2285 bl _Enter
2286 mov r5, r0
2287 @ dummy := Enter("char ", 1, ISCHAR);
2288 mov r2, #6
2289 mov r1, #1
2290 set r0, g23
2291 bl _Enter
2292 mov r5, r0
2293 @ dummy := Enter("false ", 0, FAIL);
2294 mov r2, #9
2295 mov r1, #0
2296 set r0, g24
2297 bl _Enter
2298 mov r5, r0
2299 @ dummy := Enter("print ", 1, PRINT);
2300 mov r2, #10
2301 mov r1, #1
2302 set r0, g25
2303 bl _Enter
2304 mov r5, r0
2305 @ dummy := Enter("nl ", 0, NL)
2306 mov r2, #11
2307 mov r1, #0
2308 set r0, g26
2309 bl _Enter
2310 mov r5, r0
2311 ldmfd fp, {r4-r10, fp, sp, pc}
2312 .ltorg
2313
2314 @ proc AddClause(c: clause);
2315 _AddClause:
2316 mov ip, sp
2317 stmfd sp!, {r0-r1}
2318 stmfd sp!, {r4-r10, fp, ip, lr}
2319 mov fp, sp
2320 @ s := mem[mem[c+3]+1];
2321 set r6, _mem
2322 ldr r0, [fp, #40]
2323 lsl r0, r0, #2
2324 add r0, r6, r0
2325 ldr r0, [r0, #12]
2326 lsl r0, r0, #2
2327 add r0, r6, r0
2328 ldr r4, [r0, #4]
2329 @ if symtab[s].action <> 0 then
2330 set r0, _symtab
2331 lsl r1, r4, #4
2332 add r0, r0, r1
2333 ldr r0, [r0, #8]
2334 cmp r0, #0
2335 beq .L229
2336 @ newline(); print_string("Error: "); print_string("cannot add clauses to built-in relation "); run := false;
2337 bl newline
2338 mov r1, #7
2339 set r0, g27
2340 bl print_string
2341 mov r1, #40
2342 set r0, g28
2343 bl print_string
2344 mov r0, #0
2345 set r1, _run
2346 strb r0, [r1]
2347 @ WriteString(symtab[s].name)
2348 set r0, _symtab
2349 lsl r1, r4, #4
2350 add r0, r0, r1
2351 ldr r0, [r0]
2352 bl _WriteString
2353 b .L227
2354 .L229:
2355 @ elsif symtab[s].prok = NULL then
2356 set r0, _symtab
2357 lsl r1, r4, #4
2358 add r0, r0, r1
2359 add r6, r0, #12
2360 ldr r0, [r6]
2361 cmp r0, #0
2362 bne .L232
2363 @ symtab[s].prok := c
2364 ldr r0, [fp, #40]
2365 str r0, [r6]
2366 b .L227
2367 .L232:
2368 @ p := symtab[s].prok;
2369 set r0, _symtab
2370 lsl r1, r4, #4
2371 add r0, r0, r1
2372 ldr r5, [r0, #12]
2373 .L234:
2374 @ while mem[p+2] <> NULL do p := mem[p+2] end;
2375 set r0, _mem
2376 lsl r1, r5, #2
2377 add r0, r0, r1
2378 ldr r6, [r0, #8]
2379 cmp r6, #0
2380 beq .L236
2381 mov r5, r6
2382 b .L234
2383 .L236:
2384 @ mem[p+2] := c
2385 ldr r0, [fp, #40]
2386 set r1, _mem
2387 lsl r2, r5, #2
2388 add r1, r1, r2
2389 str r0, [r1, #8]
2390 .L227:
2391 ldmfd fp, {r4-r10, fp, sp, pc}
2392 .ltorg
2393
2394 @ proc MakeCompound(fun: symbol; var arg: argbuf): term;
2395 _MakeCompound:
2396 mov ip, sp
2397 stmfd sp!, {r0-r1}
2398 stmfd sp!, {r4-r10, fp, ip, lr}
2399 mov fp, sp
2400 sub sp, sp, #8
2401 @ n := symtab[fun].arity;
2402 set r0, _symtab
2403 ldr r1, [fp, #40]
2404 lsl r1, r1, #4
2405 add r0, r0, r1
2406 ldr r6, [r0, #4]
2407 @ p := HeapAlloc(TERM_SIZE+n);
2408 add r0, r6, #2
2409 bl _HeapAlloc
2410 mov r4, r0
2411 @ mem[p] := lsl(FUNC, 8) + TERM_SIZE+n;
2412 set r0, _mem
2413 lsl r1, r4, #2
2414 add r7, r0, r1
2415 set r0, #258
2416 add r0, r6, r0
2417 str r0, [r7]
2418 @ mem[p+1] := fun;
2419 ldr r0, [fp, #40]
2420 str r0, [r7, #4]
2421 @ for i := 1 to n do mem[p+i+1] := arg[i] end;
2422 mov r5, #1
2423 str r6, [fp, #-4]
2424 .L238:
2425 ldr r0, [fp, #-4]
2426 cmp r5, r0
2427 bgt .L239
2428 ldr r0, [fp, #44]
2429 lsl r1, r5, #2
2430 add r0, r0, r1
2431 ldr r0, [r0]
2432 set r1, _mem
2433 add r2, r4, r5
2434 lsl r2, r2, #2
2435 add r1, r1, r2
2436 str r0, [r1, #4]
2437 add r5, r5, #1
2438 b .L238
2439 .L239:
2440 @ return p
2441 mov r0, r4
2442 ldmfd fp, {r4-r10, fp, sp, pc}
2443 .ltorg
2444
2445 @ proc MakeNode(fun: symbol; a1, a2: term): term;
2446 _MakeNode:
2447 mov ip, sp
2448 stmfd sp!, {r0-r3}
2449 stmfd sp!, {r4-r10, fp, ip, lr}
2450 mov fp, sp
2451 sub sp, sp, #256
2452 @ arg[1] := a1; arg[2] := a2;
2453 ldr r0, [fp, #44]
2454 str r0, [fp, #-252]
2455 ldr r0, [fp, #48]
2456 str r0, [fp, #-248]
2457 @ return MakeCompound(fun, arg)
2458 add r1, fp, #-256
2459 ldr r0, [fp, #40]
2460 bl _MakeCompound
2461 ldmfd fp, {r4-r10, fp, sp, pc}
2462 .ltorg
2463
2464 @ proc MakeRef(offset: integer): term;
2465 _MakeRef:
2466 mov ip, sp
2467 stmfd sp!, {r0-r1}
2468 stmfd sp!, {r4-r10, fp, ip, lr}
2469 mov fp, sp
2470 @ return refnode[offset]
2471 set r0, _refnode
2472 ldr r1, [fp, #40]
2473 lsl r1, r1, #2
2474 add r0, r0, r1
2475 ldr r0, [r0]
2476 ldmfd fp, {r4-r10, fp, sp, pc}
2477 .ltorg
2478
2479 @ proc MakeInt(i: integer): term;
2480 _MakeInt:
2481 mov ip, sp
2482 stmfd sp!, {r0-r1}
2483 stmfd sp!, {r4-r10, fp, ip, lr}
2484 mov fp, sp
2485 @ p := HeapAlloc(TERM_SIZE);
2486 mov r0, #2
2487 bl _HeapAlloc
2488 mov r4, r0
2489 @ mem[p] := lsl(INT, 8) + TERM_SIZE;
2490 set r0, _mem
2491 lsl r1, r4, #2
2492 add r5, r0, r1
2493 set r0, #514
2494 str r0, [r5]
2495 @ mem[p+1] := i; return p
2496 ldr r0, [fp, #40]
2497 str r0, [r5, #4]
2498 mov r0, r4
2499 ldmfd fp, {r4-r10, fp, sp, pc}
2500 .ltorg
2501
2502 @ proc MakeChar(c: char): term;
2503 _MakeChar:
2504 mov ip, sp
2505 stmfd sp!, {r0-r1}
2506 stmfd sp!, {r4-r10, fp, ip, lr}
2507 mov fp, sp
2508 @ p := HeapAlloc(TERM_SIZE);
2509 mov r0, #2
2510 bl _HeapAlloc
2511 mov r4, r0
2512 @ mem[p] := lsl(CHRCTR, 8) + TERM_SIZE;
2513 set r0, _mem
2514 lsl r1, r4, #2
2515 add r5, r0, r1
2516 set r0, #770
2517 str r0, [r5]
2518 @ mem[p+1] := ord(c); return p
2519 ldrb r0, [fp, #40]
2520 str r0, [r5, #4]
2521 mov r0, r4
2522 ldmfd fp, {r4-r10, fp, sp, pc}
2523 .ltorg
2524
2525 @ proc MakeString(var s: tempstring): term;
2526 _MakeString:
2527 mov ip, sp
2528 stmfd sp!, {r0-r1}
2529 stmfd sp!, {r4-r10, fp, ip, lr}
2530 mov fp, sp
2531 @ i := StringLength(s);
2532 ldr r0, [fp, #40]
2533 bl _StringLength
2534 mov r5, r0
2535 @ p := MakeNode(nilsym, NULL, NULL);
2536 mov r2, #0
2537 mov r1, #0
2538 set r0, _nilsym
2539 ldr r0, [r0]
2540 bl _MakeNode
2541 mov r4, r0
2542 .L245:
2543 @ while i > 0 do
2544 cmp r5, #0
2545 ble .L247
2546 @ i := i-1; p := MakeNode(cons, MakeChar(s[i]), p)
2547 sub r5, r5, #1
2548 ldr r0, [fp, #40]
2549 add r0, r0, r5
2550 ldrb r0, [r0]
2551 bl _MakeChar
2552 mov r2, r4
2553 mov r1, r0
2554 set r0, _cons
2555 ldr r0, [r0]
2556 bl _MakeNode
2557 mov r4, r0
2558 b .L245
2559 .L247:
2560 @ return p
2561 mov r0, r4
2562 ldmfd fp, {r4-r10, fp, sp, pc}
2563 .ltorg
2564
2565 @ proc MakeClause(nvars: integer; head: term;
2566 _MakeClause:
2567 mov ip, sp
2568 stmfd sp!, {r0-r3}
2569 stmfd sp!, {r4-r10, fp, ip, lr}
2570 mov fp, sp
2571 @ p := HeapAlloc(CLAUSE_SIZE + nbody + 1);
2572 ldr r0, [fp, #52]
2573 add r0, r0, #4
2574 add r0, r0, #1
2575 bl _HeapAlloc
2576 mov r4, r0
2577 @ mem[p] := nvars; mem[p+2] := NULL; mem[p+3] := head;
2578 set r0, _mem
2579 lsl r1, r4, #2
2580 add r7, r0, r1
2581 ldr r0, [fp, #40]
2582 str r0, [r7]
2583 mov r0, #0
2584 str r0, [r7, #8]
2585 ldr r0, [fp, #44]
2586 str r0, [r7, #12]
2587 @ for i := 1 to nbody do mem[(p+4)+i-1] := body[i] end;
2588 mov r5, #1
2589 ldr r6, [fp, #52]
2590 .L249:
2591 cmp r5, r6
2592 bgt .L250
2593 ldr r0, [fp, #48]
2594 lsl r1, r5, #2
2595 add r0, r0, r1
2596 ldr r0, [r0]
2597 set r1, _mem
2598 add r2, r4, #4
2599 add r2, r2, r5
2600 lsl r2, r2, #2
2601 add r1, r1, r2
2602 str r0, [r1, #-4]
2603 add r5, r5, #1
2604 b .L249
2605 .L250:
2606 @ mem[(p+4)+nbody+1-1] := NULL;
2607 set r7, _mem
2608 mov r0, #0
2609 add r1, r4, #4
2610 ldr r2, [fp, #52]
2611 add r1, r1, r2
2612 lsl r1, r1, #2
2613 add r1, r7, r1
2614 str r0, [r1]
2615 @ if head = NULL then
2616 ldr r0, [fp, #44]
2617 cmp r0, #0
2618 bne .L252
2619 @ mem[p+1] := 0
2620 mov r0, #0
2621 lsl r1, r4, #2
2622 add r1, r7, r1
2623 str r0, [r1, #4]
2624 b .L253
2625 .L252:
2626 @ mem[p+1] := Key(head, NULL)
2627 mov r1, #0
2628 ldr r0, [fp, #44]
2629 bl _Key
2630 set r1, _mem
2631 lsl r2, r4, #2
2632 add r1, r1, r2
2633 str r0, [r1, #4]
2634 .L253:
2635 @ return p
2636 mov r0, r4
2637 ldmfd fp, {r4-r10, fp, sp, pc}
2638 .ltorg
2639
2640 @ proc IsString(t: term; e: frame): boolean;
2641 _IsString:
2642 mov ip, sp
2643 stmfd sp!, {r0-r1}
2644 stmfd sp!, {r4-r10, fp, ip, lr}
2645 mov fp, sp
2646 @ i := 0; t := Deref(t, e);
2647 mov r4, #0
2648 ldr r1, [fp, #44]
2649 ldr r0, [fp, #40]
2650 bl _Deref
2651 str r0, [fp, #40]
2652 .L255:
2653 @ while i < limit do
2654 cmp r4, #128
2655 bge .L257
2656 @ if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
2657 set r0, _mem
2658 ldr r1, [fp, #40]
2659 lsl r1, r1, #2
2660 add r5, r0, r1
2661 ldr r0, [r5]
2662 lsr r0, r0, #8
2663 cmp r0, #1
2664 bne .L258
2665 ldr r0, [r5, #4]
2666 set r1, _cons
2667 ldr r1, [r1]
2668 cmp r0, r1
2669 beq .L259
2670 .L258:
2671 @ return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
2672 set r0, _mem
2673 ldr r1, [fp, #40]
2674 lsl r1, r1, #2
2675 add r5, r0, r1
2676 ldr r0, [r5]
2677 lsr r0, r0, #8
2678 cmp r0, #1
2679 mov r0, #0
2680 moveq r0, #1
2681 ldr r1, [r5, #4]
2682 set r2, _nilsym
2683 ldr r2, [r2]
2684 cmp r1, r2
2685 mov r1, #0
2686 moveq r1, #1
2687 and r0, r0, r1
2688 b .L254
2689 .L259:
2690 @ elsif lsr(mem[Deref(mem[t+1+1], e)], 8) <> CHRCTR then
2691 set r5, _mem
2692 ldr r1, [fp, #44]
2693 ldr r0, [fp, #40]
2694 lsl r0, r0, #2
2695 add r0, r5, r0
2696 ldr r0, [r0, #8]
2697 bl _Deref
2698 lsl r0, r0, #2
2699 add r0, r5, r0
2700 ldr r0, [r0]
2701 lsr r0, r0, #8
2702 cmp r0, #3
2703 beq .L262
2704 @ return false
2705 mov r0, #0
2706 b .L254
2707 .L262:
2708 @ i := i+1; t := Deref(mem[t+2+1], e)
2709 add r4, r4, #1
2710 ldr r1, [fp, #44]
2711 set r0, _mem
2712 ldr r2, [fp, #40]
2713 lsl r2, r2, #2
2714 add r0, r0, r2
2715 ldr r0, [r0, #12]
2716 bl _Deref
2717 str r0, [fp, #40]
2718 b .L255
2719 .L257:
2720 @ return false
2721 mov r0, #0
2722 .L254:
2723 ldmfd fp, {r4-r10, fp, sp, pc}
2724 .ltorg
2725
2726 @ proc IsList(t: term; e: frame): boolean;
2727 _IsList:
2728 mov ip, sp
2729 stmfd sp!, {r0-r1}
2730 stmfd sp!, {r4-r10, fp, ip, lr}
2731 mov fp, sp
2732 @ i := 0; t := Deref(t, e);
2733 mov r4, #0
2734 ldr r1, [fp, #44]
2735 ldr r0, [fp, #40]
2736 bl _Deref
2737 str r0, [fp, #40]
2738 .L266:
2739 @ while i < limit do
2740 cmp r4, #128
2741 bge .L268
2742 @ if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
2743 set r0, _mem
2744 ldr r1, [fp, #40]
2745 lsl r1, r1, #2
2746 add r5, r0, r1
2747 ldr r0, [r5]
2748 lsr r0, r0, #8
2749 cmp r0, #1
2750 bne .L269
2751 ldr r0, [r5, #4]
2752 set r1, _cons
2753 ldr r1, [r1]
2754 cmp r0, r1
2755 beq .L270
2756 .L269:
2757 @ return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
2758 set r0, _mem
2759 ldr r1, [fp, #40]
2760 lsl r1, r1, #2
2761 add r5, r0, r1
2762 ldr r0, [r5]
2763 lsr r0, r0, #8
2764 cmp r0, #1
2765 mov r0, #0
2766 moveq r0, #1
2767 ldr r1, [r5, #4]
2768 set r2, _nilsym
2769 ldr r2, [r2]
2770 cmp r1, r2
2771 mov r1, #0
2772 moveq r1, #1
2773 and r0, r0, r1
2774 b .L265
2775 .L270:
2776 @ i := i+1; t := Deref(mem[t+2+1], e)
2777 add r4, r4, #1
2778 ldr r1, [fp, #44]
2779 set r0, _mem
2780 ldr r2, [fp, #40]
2781 lsl r2, r2, #2
2782 add r0, r0, r2
2783 ldr r0, [r0, #12]
2784 bl _Deref
2785 str r0, [fp, #40]
2786 b .L266
2787 .L268:
2788 @ return false
2789 mov r0, #0
2790 .L265:
2791 ldmfd fp, {r4-r10, fp, sp, pc}
2792 .ltorg
2793
2794 @ proc ShowString(t: term; e: frame);
2795 _ShowString:
2796 mov ip, sp
2797 stmfd sp!, {r0-r1}
2798 stmfd sp!, {r4-r10, fp, ip, lr}
2799 mov fp, sp
2800 @ t := Deref(t, e);
2801 ldr r1, [fp, #44]
2802 ldr r0, [fp, #40]
2803 bl _Deref
2804 str r0, [fp, #40]
2805 @ print_char('"');
2806 mov r0, #34
2807 bl print_char
2808 .L274:
2809 @ while mem[t+1] <> nilsym do
2810 set r4, _mem
2811 ldr r0, [fp, #40]
2812 lsl r0, r0, #2
2813 add r5, r4, r0
2814 ldr r0, [r5, #4]
2815 set r1, _nilsym
2816 ldr r1, [r1]
2817 cmp r0, r1
2818 beq .L276
2819 @ print_char(chr(mem[Deref(mem[t+1+1], e)+1]));
2820 ldr r1, [fp, #44]
2821 ldr r0, [r5, #8]
2822 bl _Deref
2823 mov r5, r0
2824 lsl r0, r5, #2
2825 add r0, r4, r0
2826 ldr r0, [r0, #4]
2827 bl print_char
2828 @ t := Deref(mem[t+2+1], e)
2829 ldr r1, [fp, #44]
2830 set r0, _mem
2831 ldr r2, [fp, #40]
2832 lsl r2, r2, #2
2833 add r0, r0, r2
2834 ldr r0, [r0, #12]
2835 bl _Deref
2836 str r0, [fp, #40]
2837 b .L274
2838 .L276:
2839 @ print_char('"')
2840 mov r0, #34
2841 bl print_char
2842 ldmfd fp, {r4-r10, fp, sp, pc}
2843 .ltorg
2844
2845 @ proc PrintCompound(t: term; e: frame; prio: integer);
2846 _PrintCompound:
2847 mov ip, sp
2848 stmfd sp!, {r0-r3}
2849 stmfd sp!, {r4-r10, fp, ip, lr}
2850 mov fp, sp
2851 @ f := mem[t+1];
2852 ldr r7, [fp, #40]
2853 set r0, _mem
2854 lsl r1, r7, #2
2855 add r0, r0, r1
2856 ldr r4, [r0, #4]
2857 @ if f = cons then
2858 set r0, _cons
2859 ldr r0, [r0]
2860 cmp r4, r0
2861 bne .L279
2862 @ if IsString(t, e) then
2863 ldr r1, [fp, #44]
2864 mov r0, r7
2865 bl _IsString
2866 cmp r0, #0
2867 beq .L303
2868 @ ShowString(t, e)
2869 ldr r1, [fp, #44]
2870 ldr r0, [fp, #40]
2871 bl _ShowString
2872 b .L277
2873 .L303:
2874 @ if prio < CONSPRIO then print_char('(') end;
2875 ldr r0, [fp, #48]
2876 cmp r0, #1
2877 bge .L307
2878 mov r0, #40
2879 bl print_char
2880 .L307:
2881 @ PrintTerm(mem[t+1+1], e, CONSPRIO-1);
2882 mov r2, #0
2883 ldr r1, [fp, #44]
2884 set r0, _mem
2885 ldr r3, [fp, #40]
2886 lsl r3, r3, #2
2887 add r0, r0, r3
2888 ldr r0, [r0, #8]
2889 bl _PrintTerm
2890 @ print_char(':');
2891 mov r0, #58
2892 bl print_char
2893 @ PrintTerm(mem[t+2+1], e, CONSPRIO);
2894 mov r2, #1
2895 ldr r1, [fp, #44]
2896 set r0, _mem
2897 ldr r3, [fp, #40]
2898 lsl r3, r3, #2
2899 add r0, r0, r3
2900 ldr r0, [r0, #12]
2901 bl _PrintTerm
2902 @ if prio < CONSPRIO then print_char(')') end
2903 ldr r0, [fp, #48]
2904 cmp r0, #1
2905 bge .L277
2906 mov r0, #41
2907 bl print_char
2908 b .L277
2909 .L279:
2910 @ elsif f = eqsym then
2911 set r0, _eqsym
2912 ldr r0, [r0]
2913 cmp r4, r0
2914 bne .L282
2915 @ if prio < EQPRIO then print_char('(') end;
2916 ldr r0, [fp, #48]
2917 cmp r0, #2
2918 bge .L298
2919 mov r0, #40
2920 bl print_char
2921 .L298:
2922 @ PrintTerm(mem[t+1+1], e, EQPRIO-1);
2923 mov r2, #1
2924 ldr r1, [fp, #44]
2925 set r0, _mem
2926 ldr r3, [fp, #40]
2927 lsl r3, r3, #2
2928 add r0, r0, r3
2929 ldr r0, [r0, #8]
2930 bl _PrintTerm
2931 @ print_string(" = ");
2932 mov r1, #3
2933 set r0, g29
2934 bl print_string
2935 @ PrintTerm(mem[t+2+1], e, EQPRIO-1);
2936 mov r2, #1
2937 ldr r1, [fp, #44]
2938 set r0, _mem
2939 ldr r3, [fp, #40]
2940 lsl r3, r3, #2
2941 add r0, r0, r3
2942 ldr r0, [r0, #12]
2943 bl _PrintTerm
2944 @ if prio < EQPRIO then print_char(')') end
2945 ldr r0, [fp, #48]
2946 cmp r0, #2
2947 bge .L277
2948 mov r0, #41
2949 bl print_char
2950 b .L277
2951 .L282:
2952 @ elsif f = notsym then
2953 set r0, _notsym
2954 ldr r0, [r0]
2955 cmp r4, r0
2956 bne .L285
2957 @ print_string("not ");
2958 mov r1, #4
2959 set r0, g30
2960 bl print_string
2961 @ PrintTerm(mem[t+1+1], e, MAXPRIO)
2962 mov r2, #2
2963 ldr r1, [fp, #44]
2964 set r0, _mem
2965 ldr r3, [fp, #40]
2966 lsl r3, r3, #2
2967 add r0, r0, r3
2968 ldr r0, [r0, #8]
2969 bl _PrintTerm
2970 b .L277
2971 .L285:
2972 @ elsif (f = node) and IsList(mem[t+2+1], e) then
2973 set r0, _node
2974 ldr r0, [r0]
2975 cmp r4, r0
2976 bne .L288
2977 ldr r1, [fp, #44]
2978 set r0, _mem
2979 ldr r2, [fp, #40]
2980 lsl r2, r2, #2
2981 add r0, r0, r2
2982 ldr r0, [r0, #12]
2983 bl _IsList
2984 cmp r0, #0
2985 beq .L288
2986 @ PrintNode(t, e)
2987 ldr r1, [fp, #44]
2988 ldr r0, [fp, #40]
2989 bl _PrintNode
2990 b .L277
2991 .L288:
2992 @ WriteString(symtab[f].name);
2993 set r0, _symtab
2994 lsl r1, r4, #4
2995 add r0, r0, r1
2996 ldr r0, [r0]
2997 bl _WriteString
2998 @ if symtab[f].arity > 0 then
2999 set r0, _symtab
3000 lsl r1, r4, #4
3001 add r0, r0, r1
3002 ldr r0, [r0, #4]
3003 cmp r0, #0
3004 ble .L277
3005 @ print_char('(');
3006 mov r0, #40
3007 bl print_char
3008 @ PrintTerm(mem[t+1+1], e, ARGPRIO);
3009 mov r2, #2
3010 ldr r1, [fp, #44]
3011 set r0, _mem
3012 ldr r3, [fp, #40]
3013 lsl r3, r3, #2
3014 add r0, r0, r3
3015 ldr r0, [r0, #8]
3016 bl _PrintTerm
3017 @ for i := 2 to symtab[f].arity do
3018 mov r5, #2
3019 set r0, _symtab
3020 lsl r1, r4, #4
3021 add r0, r0, r1
3022 ldr r6, [r0, #4]
3023 .L293:
3024 cmp r5, r6
3025 bgt .L294
3026 @ print_string(", ");
3027 mov r1, #2
3028 set r0, g31
3029 bl print_string
3030 @ PrintTerm(mem[t+i+1], e, ARGPRIO)
3031 mov r2, #2
3032 ldr r1, [fp, #44]
3033 set r0, _mem
3034 ldr r3, [fp, #40]
3035 add r3, r3, r5
3036 lsl r3, r3, #2
3037 add r0, r0, r3
3038 ldr r0, [r0, #4]
3039 bl _PrintTerm
3040 add r5, r5, #1
3041 b .L293
3042 .L294:
3043 @ print_char(')')
3044 mov r0, #41
3045 bl print_char
3046 .L277:
3047 ldmfd fp, {r4-r10, fp, sp, pc}
3048 .ltorg
3049
3050 @ proc PrintNode(t: term; e: frame);
3051 _PrintNode:
3052 mov ip, sp
3053 stmfd sp!, {r0-r1}
3054 stmfd sp!, {r4-r10, fp, ip, lr}
3055 mov fp, sp
3056 @ print_char('<');
3057 mov r0, #60
3058 bl print_char
3059 @ PrintTerm(mem[t+1+1], e, MAXPRIO);
3060 mov r2, #2
3061 ldr r1, [fp, #44]
3062 set r0, _mem
3063 ldr r3, [fp, #40]
3064 lsl r3, r3, #2
3065 add r0, r0, r3
3066 ldr r0, [r0, #8]
3067 bl _PrintTerm
3068 @ u := Deref(mem[t+2+1], e);
3069 ldr r1, [fp, #44]
3070 set r0, _mem
3071 ldr r2, [fp, #40]
3072 lsl r2, r2, #2
3073 add r0, r0, r2
3074 ldr r0, [r0, #12]
3075 bl _Deref
3076 mov r4, r0
3077 .L312:
3078 @ while mem[u+1] <> nilsym do
3079 set r0, _mem
3080 lsl r1, r4, #2
3081 add r0, r0, r1
3082 ldr r0, [r0, #4]
3083 set r1, _nilsym
3084 ldr r1, [r1]
3085 cmp r0, r1
3086 beq .L314
3087 @ print_string(", ");
3088 mov r1, #2
3089 set r0, g32
3090 bl print_string
3091 @ PrintTerm(mem[u+1+1], e, MAXPRIO);
3092 mov r2, #2
3093 ldr r1, [fp, #44]
3094 set r0, _mem
3095 lsl r3, r4, #2
3096 add r0, r0, r3
3097 ldr r0, [r0, #8]
3098 bl _PrintTerm
3099 @ u := Deref(mem[u+2+1], e)
3100 ldr r1, [fp, #44]
3101 set r0, _mem
3102 lsl r2, r4, #2
3103 add r0, r0, r2
3104 ldr r0, [r0, #12]
3105 bl _Deref
3106 mov r4, r0
3107 b .L312
3108 .L314:
3109 @ print_char('>');
3110 mov r0, #62
3111 bl print_char
3112 ldmfd fp, {r4-r10, fp, sp, pc}
3113 .ltorg
3114
3115 @ proc PrintTerm(t: term; e: frame; prio: integer);
3116 _PrintTerm:
3117 mov ip, sp
3118 stmfd sp!, {r0-r3}
3119 stmfd sp!, {r4-r10, fp, ip, lr}
3120 mov fp, sp
3121 @ t := Deref(t, e);
3122 ldr r1, [fp, #44]
3123 ldr r0, [fp, #40]
3124 bl _Deref
3125 str r0, [fp, #40]
3126 @ if t = NULL then
3127 cmp r0, #0
3128 bne .L317
3129 @ print_string("*null-term*")
3130 mov r1, #11
3131 set r0, g33
3132 bl print_string
3133 b .L315
3134 .L317:
3135 @ case lsr(mem[t], 8) of
3136 set r0, _mem
3137 ldr r1, [fp, #40]
3138 lsl r1, r1, #2
3139 add r0, r0, r1
3140 ldr r0, [r0]
3141 lsr r0, r0, #8
3142 sub r0, r0, #1
3143 cmp r0, #5
3144 ldrlo pc, [pc, r0, LSL #2]
3145 b .L319
3146 .word .L321
3147 .word .L322
3148 .word .L323
3149 .word .L324
3150 .word .L325
3151 .L321:
3152 @ PrintCompound(t, e, prio)
3153 ldr r2, [fp, #48]
3154 ldr r1, [fp, #44]
3155 ldr r0, [fp, #40]
3156 bl _PrintCompound
3157 b .L315
3158 .L322:
3159 @ print_num(mem[t+1])
3160 set r0, _mem
3161 ldr r1, [fp, #40]
3162 lsl r1, r1, #2
3163 add r0, r0, r1
3164 ldr r0, [r0, #4]
3165 bl print_num
3166 b .L315
3167 .L323:
3168 @ print_char(''''); print_char(chr(mem[t+1])); print_char('''')
3169 mov r0, #39
3170 bl print_char
3171 set r0, _mem
3172 ldr r1, [fp, #40]
3173 lsl r1, r1, #2
3174 add r0, r0, r1
3175 ldr r0, [r0, #4]
3176 bl print_char
3177 mov r0, #39
3178 bl print_char
3179 b .L315
3180 .L324:
3181 @ if (t >= gsp) then
3182 ldr r0, [fp, #40]
3183 set r1, _gsp
3184 ldr r1, [r1]
3185 cmp r0, r1
3186 blt .L327
3187 @ print_char('G'); print_num((MEMSIZE - t) div TERM_SIZE)
3188 mov r0, #71
3189 bl print_char
3190 mov r1, #2
3191 set r0, #25000
3192 ldr r2, [fp, #40]
3193 sub r0, r0, r2
3194 bl int_div
3195 bl print_num
3196 b .L315
3197 .L327:
3198 @ print_char('L'); print_num((t - hp) div TERM_SIZE)
3199 mov r0, #76
3200 bl print_char
3201 mov r1, #2
3202 ldr r0, [fp, #40]
3203 set r2, _hp
3204 ldr r2, [r2]
3205 sub r0, r0, r2
3206 bl int_div
3207 bl print_num
3208 b .L315
3209 .L325:
3210 @ print_char('@'); print_num(mem[t+1])
3211 mov r0, #64
3212 bl print_char
3213 set r0, _mem
3214 ldr r1, [fp, #40]
3215 lsl r1, r1, #2
3216 add r0, r0, r1
3217 ldr r0, [r0, #4]
3218 bl print_num
3219 b .L315
3220 .L319:
3221 @ print_string("*unknown-term(tag=");
3222 mov r1, #18
3223 set r0, g34
3224 bl print_string
3225 @ print_num(lsr(mem[t], 8)); print_string(")*")
3226 set r0, _mem
3227 ldr r1, [fp, #40]
3228 lsl r1, r1, #2
3229 add r0, r0, r1
3230 ldr r0, [r0]
3231 lsr r0, r0, #8
3232 bl print_num
3233 mov r1, #2
3234 set r0, g35
3235 bl print_string
3236 .L315:
3237 ldmfd fp, {r4-r10, fp, sp, pc}
3238 .ltorg
3239
3240 @ proc PrintClause(c: clause);
3241 _PrintClause:
3242 mov ip, sp
3243 stmfd sp!, {r0-r1}
3244 stmfd sp!, {r4-r10, fp, ip, lr}
3245 mov fp, sp
3246 @ if c = NULL then
3247 ldr r0, [fp, #40]
3248 cmp r0, #0
3249 bne .L331
3250 @ print_string("*null-clause*"); newline();
3251 mov r1, #13
3252 set r0, g36
3253 bl print_string
3254 bl newline
3255 b .L329
3256 .L331:
3257 @ if mem[c+3] <> NULL then
3258 set r0, _mem
3259 ldr r1, [fp, #40]
3260 lsl r1, r1, #2
3261 add r0, r0, r1
3262 ldr r5, [r0, #12]
3263 cmp r5, #0
3264 beq .L335
3265 @ PrintTerm(mem[c+3], NULL, MAXPRIO);
3266 mov r2, #2
3267 mov r1, #0
3268 mov r0, r5
3269 bl _PrintTerm
3270 @ print_char(' ')
3271 mov r0, #32
3272 bl print_char
3273 .L335:
3274 @ print_string(":- ");
3275 mov r1, #3
3276 set r0, g37
3277 bl print_string
3278 @ if mem[(c+4)+1-1] <> NULL then
3279 set r0, _mem
3280 ldr r1, [fp, #40]
3281 lsl r1, r1, #2
3282 add r0, r0, r1
3283 ldr r5, [r0, #16]
3284 cmp r5, #0
3285 beq .L338
3286 @ PrintTerm(mem[(c+4)+1-1], NULL, MAXPRIO);
3287 mov r2, #2
3288 mov r1, #0
3289 mov r0, r5
3290 bl _PrintTerm
3291 @ i := 2;
3292 mov r4, #2
3293 .L339:
3294 @ while mem[(c+4)+i-1] <> NULL do
3295 set r0, _mem
3296 ldr r1, [fp, #40]
3297 add r1, r1, #4
3298 add r1, r1, r4
3299 lsl r1, r1, #2
3300 add r0, r0, r1
3301 ldr r0, [r0, #-4]
3302 cmp r0, #0
3303 beq .L338
3304 @ print_string(", ");
3305 mov r1, #2
3306 set r0, g38
3307 bl print_string
3308 @ PrintTerm(mem[(c+4)+i-1], NULL, MAXPRIO);
3309 mov r2, #2
3310 mov r1, #0
3311 set r0, _mem
3312 ldr r3, [fp, #40]
3313 add r3, r3, #4
3314 add r3, r3, r4
3315 lsl r3, r3, #2
3316 add r0, r0, r3
3317 ldr r0, [r0, #-4]
3318 bl _PrintTerm
3319 @ i := i+1
3320 add r4, r4, #1
3321 b .L339
3322 .L338:
3323 @ print_char('.'); newline()
3324 mov r0, #46
3325 bl print_char
3326 bl newline
3327 .L329:
3328 ldmfd fp, {r4-r10, fp, sp, pc}
3329 .ltorg
3330
3331 @ proc ShowError();
3332 _ShowError:
3333 mov ip, sp
3334 stmfd sp!, {r4-r10, fp, ip, lr}
3335 mov fp, sp
3336 @ errflag := true; errcount := errcount+1;
3337 mov r0, #1
3338 set r1, _errflag
3339 strb r0, [r1]
3340 set r4, _errcount
3341 ldr r0, [r4]
3342 add r0, r0, #1
3343 str r0, [r4]
3344 @ print_string("Line "); print_num(lineno); print_char(' ');
3345 mov r1, #5
3346 set r0, g39
3347 bl print_string
3348 set r0, _lineno
3349 ldr r0, [r0]
3350 bl print_num
3351 mov r0, #32
3352 bl print_char
3353 @ print_string("Syntax error - ")
3354 mov r1, #15
3355 set r0, g40
3356 bl print_string
3357 ldmfd fp, {r4-r10, fp, sp, pc}
3358 .ltorg
3359
3360 @ proc Recover();
3361 _Recover:
3362 mov ip, sp
3363 stmfd sp!, {r4-r10, fp, ip, lr}
3364 mov fp, sp
3365 @ if errcount >= 20 then
3366 set r0, _errcount
3367 ldr r0, [r0]
3368 cmp r0, #20
3369 blt .L346
3370 @ print_string("Too many errors: I am giving up"); newline(); exit(2)
3371 mov r1, #31
3372 set r0, g41
3373 bl print_string
3374 bl newline
3375 mov r0, #2
3376 bl exit
3377 .L346:
3378 @ if token <> DOT then
3379 set r0, _token
3380 ldr r0, [r0]
3381 cmp r0, #10
3382 beq .L343
3383 .L350:
3384 @ ch := GetChar()
3385 bl _GetChar
3386 mov r4, r0
3387 cmp r4, #46
3388 beq .L351
3389 cmp r4, #127
3390 bne .L350
3391 .L351:
3392 @ token := DOT
3393 mov r0, #10
3394 set r1, _token
3395 str r0, [r1]
3396 .L343:
3397 ldmfd fp, {r4-r10, fp, sp, pc}
3398 .ltorg
3399
3400 @ proc Scan();
3401 _Scan:
3402 mov ip, sp
3403 stmfd sp!, {r4-r10, fp, ip, lr}
3404 mov fp, sp
3405 @ ch := GetChar(); token := 0;
3406 bl _GetChar
3407 mov r4, r0
3408 mov r0, #0
3409 set r1, _token
3410 str r0, [r1]
3411 .L354:
3412 @ while token = 0 do
3413 set r7, _token
3414 ldr r0, [r7]
3415 cmp r0, #0
3416 bne .L353
3417 @ if ch = ENDFILE then
3418 cmp r4, #127
3419 bne .L358
3420 @ token := EOFTOK
3421 mov r0, #14
3422 str r0, [r7]
3423 b .L354
3424 .L358:
3425 @ elsif (ch = ' ') or (ch = TAB) or (ch = ENDLINE) then
3426 cmp r4, #32
3427 beq .L360
3428 cmp r4, #9
3429 beq .L360
3430 cmp r4, #10
3431 bne .L361
3432 .L360:
3433 @ ch := GetChar()
3434 bl _GetChar
3435 mov r4, r0
3436 b .L354
3437 .L361:
3438 @ elsif ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) then
3439 cmp r4, #65
3440 blt .L450
3441 cmp r4, #90
3442 ble .L363
3443 .L450:
3444 cmp r4, #95
3445 beq .L363
3446 cmp r4, #97
3447 blt .L364
3448 cmp r4, #122
3449 bgt .L364
3450 .L363:
3451 @ if (((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) then
3452 cmp r4, #65
3453 blt .L431
3454 cmp r4, #90
3455 ble .L428
3456 .L431:
3457 cmp r4, #95
3458 bne .L429
3459 .L428:
3460 @ token := VARIABLE
3461 mov r0, #2
3462 set r1, _token
3463 str r0, [r1]
3464 b .L430
3465 .L429:
3466 @ token := IDENT
3467 mov r0, #1
3468 set r1, _token
3469 str r0, [r1]
3470 .L430:
3471 @ i := 0;
3472 mov r6, #0
3473 .L433:
3474 @ while ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) or ((ch >= '0') and (ch <= '9')) do
3475 cmp r4, #65
3476 blt .L443
3477 cmp r4, #90
3478 ble .L434
3479 .L443:
3480 cmp r4, #95
3481 beq .L434
3482 cmp r4, #97
3483 blt .L439
3484 cmp r4, #122
3485 ble .L434
3486 .L439:
3487 cmp r4, #48
3488 blt .L435
3489 cmp r4, #57
3490 bgt .L435
3491 .L434:
3492 @ if i > MAXSTRING then
3493 cmp r6, #128
3494 ble .L438
3495 @ newline(); print_string("Panic: "); print_string("identifier too long"); newline(); exit(2)
3496 bl newline
3497 mov r1, #7
3498 set r0, g42
3499 bl print_string
3500 mov r1, #19
3501 set r0, g43
3502 bl print_string
3503 bl newline
3504 mov r0, #2
3505 bl exit
3506 .L438:
3507 @ toksval[i] := ch; ch := GetChar(); i := i+1
3508 set r0, _toksval
3509 add r0, r0, r6
3510 strb r4, [r0]
3511 bl _GetChar
3512 mov r4, r0
3513 add r6, r6, #1
3514 b .L433
3515 .L435:
3516 @ PushBack(ch);
3517 mov r0, r4
3518 bl _PushBack
3519 @ toksval[i] := ENDSTR; tokval := Lookup(toksval);
3520 set r7, _toksval
3521 mov r0, #0
3522 add r1, r7, r6
3523 strb r0, [r1]
3524 mov r0, r7
3525 bl _Lookup
3526 set r1, _tokval
3527 str r0, [r1]
3528 @ if tokval = notsym then token := NEGATE end
3529 set r1, _notsym
3530 ldr r1, [r1]
3531 cmp r0, r1
3532 bne .L354
3533 mov r0, #13
3534 set r1, _token
3535 str r0, [r1]
3536 b .L354
3537 .L364:
3538 @ elsif ((ch >= '0') and (ch <= '9')) then
3539 cmp r4, #48
3540 blt .L367
3541 cmp r4, #57
3542 bgt .L367
3543 @ token := NUMBER; tokival := 0;
3544 mov r0, #3
3545 set r1, _token
3546 str r0, [r1]
3547 mov r0, #0
3548 set r1, _tokival
3549 str r0, [r1]
3550 .L423:
3551 @ while ((ch >= '0') and (ch <= '9')) do
3552 cmp r4, #48
3553 blt .L425
3554 cmp r4, #57
3555 bgt .L425
3556 @ tokival := 10 * tokival + (ord(ch) - ord('0'));
3557 set r7, _tokival
3558 ldr r0, [r7]
3559 mov r1, #10
3560 mul r0, r0, r1
3561 sub r1, r4, #48
3562 add r0, r0, r1
3563 str r0, [r7]
3564 @ ch := GetChar()
3565 bl _GetChar
3566 mov r4, r0
3567 b .L423
3568 .L425:
3569 @ PushBack(ch)
3570 mov r0, r4
3571 bl _PushBack
3572 b .L354
3573 .L367:
3574 @ case ch of
3575 sub r0, r4, #33
3576 cmp r0, #30
3577 ldrlo pc, [pc, r0, LSL #2]
3578 b .L369
3579 .word .L379
3580 .word .L383
3581 .word .L378
3582 .word .L369
3583 .word .L369
3584 .word .L369
3585 .word .L382
3586 .word .L371
3587 .word .L372
3588 .word .L369
3589 .word .L369
3590 .word .L373
3591 .word .L369
3592 .word .L374
3593 .word .L380
3594 .word .L369
3595 .word .L369
3596 .word .L369
3597 .word .L369
3598 .word .L369
3599 .word .L369
3600 .word .L369
3601 .word .L369
3602 .word .L369
3603 .word .L369
3604 .word .L381
3605 .word .L369
3606 .word .L376
3607 .word .L375
3608 .word .L377
3609 .L371:
3610 @ '(': token := LPAR
3611 mov r0, #7
3612 set r1, _token
3613 str r0, [r1]
3614 b .L354
3615 .L372:
3616 @ | ')': token := RPAR
3617 mov r0, #8
3618 set r1, _token
3619 str r0, [r1]
3620 b .L354
3621 .L373:
3622 @ | ',': token := COMMA
3623 mov r0, #9
3624 set r1, _token
3625 str r0, [r1]
3626 b .L354
3627 .L374:
3628 @ | '.': token := DOT
3629 mov r0, #10
3630 set r1, _token
3631 str r0, [r1]
3632 b .L354
3633 .L375:
3634 @ | '=': token := EQUAL
3635 mov r0, #12
3636 set r1, _token
3637 str r0, [r1]
3638 b .L354
3639 .L376:
3640 @ | '<': token := LANGLE
3641 mov r0, #15
3642 set r1, _token
3643 str r0, [r1]
3644 b .L354
3645 .L377:
3646 @ | '>': token := RANGLE
3647 mov r0, #16
3648 set r1, _token
3649 str r0, [r1]
3650 b .L354
3651 .L378:
3652 @ | '#': token := HASH
3653 mov r0, #17
3654 set r1, _token
3655 str r0, [r1]
3656 b .L354
3657 .L379:
3658 @ | '!': token := IDENT; tokval := cutsym
3659 mov r0, #1
3660 set r1, _token
3661 str r0, [r1]
3662 set r0, _cutsym
3663 ldr r0, [r0]
3664 set r1, _tokval
3665 str r0, [r1]
3666 b .L354
3667 .L380:
3668 @ ch := GetChar();
3669 bl _GetChar
3670 mov r4, r0
3671 @ if ch <> '*' then
3672 cmp r4, #42
3673 beq .L388
3674 @ if not errflag then ShowError(); print_string("bad token /"); newline(); Recover() end
3675 set r0, _errflag
3676 ldrb r0, [r0]
3677 cmp r0, #0
3678 bne .L354
3679 bl _ShowError
3680 mov r1, #11
3681 set r0, g44
3682 bl print_string
3683 bl newline
3684 bl _Recover
3685 b .L354
3686 .L388:
3687 @ ch2 := ' '; ch := GetChar();
3688 mov r5, #32
3689 bl _GetChar
3690 mov r4, r0
3691 .L390:
3692 @ while (ch <> ENDFILE) and not ((ch2 = '*') and (ch = '/')) do
3693 cmp r4, #127
3694 beq .L392
3695 cmp r5, #42
3696 bne .L391
3697 cmp r4, #47
3698 beq .L392
3699 .L391:
3700 @ ch2 := ch; ch := GetChar()
3701 mov r5, r4
3702 bl _GetChar
3703 mov r4, r0
3704 b .L390
3705 .L392:
3706 @ if ch = ENDFILE then
3707 cmp r4, #127
3708 bne .L396
3709 @ if not errflag then ShowError(); print_string("end of file in comment"); newline(); Recover() end
3710 set r0, _errflag
3711 ldrb r0, [r0]
3712 cmp r0, #0
3713 bne .L354
3714 bl _ShowError
3715 mov r1, #22
3716 set r0, g45
3717 bl print_string
3718 bl newline
3719 bl _Recover
3720 b .L354
3721 .L396:
3722 @ ch := GetChar()
3723 bl _GetChar
3724 mov r4, r0
3725 b .L354
3726 .L381:
3727 @ ch := GetChar();
3728 bl _GetChar
3729 mov r4, r0
3730 @ if ch = '-' then
3731 cmp r4, #45
3732 bne .L405
3733 @ token := ARROW
3734 mov r0, #6
3735 set r1, _token
3736 str r0, [r1]
3737 b .L354
3738 .L405:
3739 @ PushBack(ch); token := COLON
3740 mov r0, r4
3741 bl _PushBack
3742 mov r0, #11
3743 set r1, _token
3744 str r0, [r1]
3745 b .L354
3746 .L382:
3747 @ token := CHCON; tokival := ord(GetChar()); ch := GetChar();
3748 mov r0, #4
3749 set r1, _token
3750 str r0, [r1]
3751 bl _GetChar
3752 set r1, _tokival
3753 str r0, [r1]
3754 bl _GetChar
3755 mov r4, r0
3756 @ if ch <> '''' then if not errflag then ShowError(); print_string("missing quote"); newline(); Recover() end end
3757 cmp r4, #39
3758 beq .L354
3759 set r0, _errflag
3760 ldrb r0, [r0]
3761 cmp r0, #0
3762 bne .L354
3763 bl _ShowError
3764 mov r1, #13
3765 set r0, g46
3766 bl print_string
3767 bl newline
3768 bl _Recover
3769 b .L354
3770 .L383:
3771 @ token := STRCON; i := 0; ch := GetChar();
3772 mov r0, #5
3773 set r1, _token
3774 str r0, [r1]
3775 mov r6, #0
3776 bl _GetChar
3777 mov r4, r0
3778 .L413:
3779 @ while (ch <> '"') and (ch <> ENDLINE) do
3780 cmp r4, #34
3781 beq .L415
3782 cmp r4, #10
3783 beq .L415
3784 @ toksval[i] := ch; ch := GetChar(); i := i+1
3785 set r0, _toksval
3786 add r0, r0, r6
3787 strb r4, [r0]
3788 bl _GetChar
3789 mov r4, r0
3790 add r6, r6, #1
3791 b .L413
3792 .L415:
3793 @ toksval[i] := ENDSTR;
3794 mov r0, #0
3795 set r1, _toksval
3796 add r1, r1, r6
3797 strb r0, [r1]
3798 @ if ch = ENDLINE then
3799 cmp r4, #10
3800 bne .L354
3801 @ if not errflag then ShowError(); print_string("unterminated string"); newline(); Recover() end;
3802 set r0, _errflag
3803 ldrb r0, [r0]
3804 cmp r0, #0
3805 bne .L422
3806 bl _ShowError
3807 mov r1, #19
3808 set r0, g47
3809 bl print_string
3810 bl newline
3811 bl _Recover
3812 .L422:
3813 @ PushBack(ch)
3814 mov r0, r4
3815 bl _PushBack
3816 b .L354
3817 .L369:
3818 @ if not errflag then ShowError(); print_string("illegal character"); newline(); Recover() end; print_char(ch); newline()
3819 set r0, _errflag
3820 ldrb r0, [r0]
3821 cmp r0, #0
3822 bne .L386
3823 bl _ShowError
3824 mov r1, #17
3825 set r0, g48
3826 bl print_string
3827 bl newline
3828 bl _Recover
3829 .L386:
3830 mov r0, r4
3831 bl print_char
3832 bl newline
3833 b .L354
3834 .L353:
3835 ldmfd fp, {r4-r10, fp, sp, pc}
3836 .ltorg
3837
3838 @ proc PrintToken(t: integer);
3839 _PrintToken:
3840 mov ip, sp
3841 stmfd sp!, {r0-r1}
3842 stmfd sp!, {r4-r10, fp, ip, lr}
3843 mov fp, sp
3844 @ case t of
3845 ldr r0, [fp, #40]
3846 sub r0, r0, #1
3847 cmp r0, #17
3848 ldrlo pc, [pc, r0, LSL #2]
3849 b .L455
3850 .word .L457
3851 .word .L458
3852 .word .L459
3853 .word .L460
3854 .word .L468
3855 .word .L461
3856 .word .L462
3857 .word .L463
3858 .word .L464
3859 .word .L465
3860 .word .L466
3861 .word .L467
3862 .word .L455
3863 .word .L455
3864 .word .L469
3865 .word .L470
3866 .word .L471
3867 .L457:
3868 @ print_string("identifier "); WriteString(symtab[tokval].name)
3869 mov r1, #11
3870 set r0, g49
3871 bl print_string
3872 set r0, _symtab
3873 set r1, _tokval
3874 ldr r1, [r1]
3875 lsl r1, r1, #4
3876 add r0, r0, r1
3877 ldr r0, [r0]
3878 bl _WriteString
3879 b .L454
3880 .L458:
3881 @ print_string("variable "); WriteString(symtab[tokval].name)
3882 mov r1, #9
3883 set r0, g50
3884 bl print_string
3885 set r0, _symtab
3886 set r1, _tokval
3887 ldr r1, [r1]
3888 lsl r1, r1, #4
3889 add r0, r0, r1
3890 ldr r0, [r0]
3891 bl _WriteString
3892 b .L454
3893 .L459:
3894 @ | NUMBER: print_string("number");
3895 mov r1, #6
3896 set r0, g51
3897 bl print_string
3898 b .L454
3899 .L460:
3900 @ | CHCON: print_string("char constant");
3901 mov r1, #13
3902 set r0, g52
3903 bl print_string
3904 b .L454
3905 .L461:
3906 @ | ARROW: print_string(":-");
3907 mov r1, #2
3908 set r0, g53
3909 bl print_string
3910 b .L454
3911 .L462:
3912 @ | LPAR: print_string("(");
3913 mov r1, #1
3914 set r0, g54
3915 bl print_string
3916 b .L454
3917 .L463:
3918 @ | RPAR: print_string(")");
3919 mov r1, #1
3920 set r0, g55
3921 bl print_string
3922 b .L454
3923 .L464:
3924 @ | COMMA: print_string(",");
3925 mov r1, #1
3926 set r0, g56
3927 bl print_string
3928 b .L454
3929 .L465:
3930 @ | DOT: print_string(".");
3931 mov r1, #1
3932 set r0, g57
3933 bl print_string
3934 b .L454
3935 .L466:
3936 @ | COLON: print_string(":");
3937 mov r1, #1
3938 set r0, g58
3939 bl print_string
3940 b .L454
3941 .L467:
3942 @ | EQUAL: print_string("=");
3943 mov r1, #1
3944 set r0, g59
3945 bl print_string
3946 b .L454
3947 .L468:
3948 @ | STRCON: print_string("string constant")
3949 mov r1, #15
3950 set r0, g60
3951 bl print_string
3952 b .L454
3953 .L469:
3954 @ | LANGLE: print_string("<")
3955 mov r1, #1
3956 set r0, g61
3957 bl print_string
3958 b .L454
3959 .L470:
3960 @ | RANGLE: print_string(">")
3961 mov r1, #1
3962 set r0, g62
3963 bl print_string
3964 b .L454
3965 .L471:
3966 @ | HASH: print_string("#")
3967 mov r1, #1
3968 set r0, g63
3969 bl print_string
3970 b .L454
3971 .L455:
3972 @ print_string("unknown token")
3973 mov r1, #13
3974 set r0, g64
3975 bl print_string
3976 .L454:
3977 ldmfd fp, {r4-r10, fp, sp, pc}
3978 .ltorg
3979
3980 @ proc VarRep(name: symbol): term;
3981 _VarRep:
3982 mov ip, sp
3983 stmfd sp!, {r0-r1}
3984 stmfd sp!, {r4-r10, fp, ip, lr}
3985 mov fp, sp
3986 @ if nvars = MAXARITY then newline(); print_string("Panic: "); print_string("too many variables"); newline(); exit(2) end;
3987 set r0, _nvars
3988 ldr r0, [r0]
3989 cmp r0, #63
3990 bne .L475
3991 bl newline
3992 mov r1, #7
3993 set r0, g65
3994 bl print_string
3995 mov r1, #18
3996 set r0, g66
3997 bl print_string
3998 bl newline
3999 mov r0, #2
4000 bl exit
4001 .L475:
4002 @ i := 1; vartable[nvars+1] := name; (* sentinel *)
4003 mov r4, #1
4004 ldr r0, [fp, #40]
4005 set r1, _vartable
4006 set r2, _nvars
4007 ldr r2, [r2]
4008 lsl r2, r2, #2
4009 add r1, r1, r2
4010 str r0, [r1, #4]
4011 .L476:
4012 @ while name <> vartable[i] do i := i+1 end;
4013 ldr r0, [fp, #40]
4014 set r1, _vartable
4015 lsl r2, r4, #2
4016 add r1, r1, r2
4017 ldr r1, [r1]
4018 cmp r0, r1
4019 beq .L478
4020 add r4, r4, #1
4021 b .L476
4022 .L478:
4023 @ if i = nvars+1 then nvars := nvars+1 end;
4024 set r5, _nvars
4025 ldr r0, [r5]
4026 add r6, r0, #1
4027 cmp r4, r6
4028 bne .L481
4029 str r6, [r5]
4030 .L481:
4031 @ return MakeRef(i)
4032 mov r0, r4
4033 bl _MakeRef
4034 ldmfd fp, {r4-r10, fp, sp, pc}
4035 .ltorg
4036
4037 @ proc ShowAnswer(bindings: frame);
4038 _ShowAnswer:
4039 mov ip, sp
4040 stmfd sp!, {r0-r1}
4041 stmfd sp!, {r4-r10, fp, ip, lr}
4042 mov fp, sp
4043 sub sp, sp, #8
4044 @ if nvars = 0 then
4045 set r0, _nvars
4046 ldr r0, [r0]
4047 cmp r0, #0
4048 bne .L484
4049 @ print_string("yes"); newline()
4050 mov r1, #3
4051 set r0, g67
4052 bl print_string
4053 bl newline
4054 b .L482
4055 .L484:
4056 @ for i := 1 to nvars do
4057 mov r4, #1
4058 set r0, _nvars
4059 ldr r0, [r0]
4060 str r0, [fp, #-4]
4061 .L486:
4062 ldr r0, [fp, #-4]
4063 cmp r4, r0
4064 bgt .L482
4065 @ WriteString(symtab[vartable[i]].name); print_string(" = ");
4066 set r0, _symtab
4067 set r1, _vartable
4068 lsl r2, r4, #2
4069 add r1, r1, r2
4070 ldr r1, [r1]
4071 lsl r1, r1, #4
4072 add r0, r0, r1
4073 ldr r0, [r0]
4074 bl _WriteString
4075 mov r1, #3
4076 set r0, g68
4077 bl print_string
4078 @ PrintTerm((bindings+7+(i-1)*TERM_SIZE), NULL, EQPRIO-1);
4079 mov r2, #1
4080 mov r1, #0
4081 ldr r0, [fp, #40]
4082 add r0, r0, #7
4083 lsl r3, r4, #1
4084 sub r3, r3, #2
4085 add r0, r0, r3
4086 bl _PrintTerm
4087 @ newline()
4088 bl newline
4089 add r4, r4, #1
4090 b .L486
4091 .L482:
4092 ldmfd fp, {r4-r10, fp, sp, pc}
4093 .ltorg
4094
4095 @ proc Eat(expected: integer);
4096 _Eat:
4097 mov ip, sp
4098 stmfd sp!, {r0-r1}
4099 stmfd sp!, {r4-r10, fp, ip, lr}
4100 mov fp, sp
4101 @ if token = expected then
4102 set r0, _token
4103 ldr r4, [r0]
4104 ldr r0, [fp, #40]
4105 cmp r4, r0
4106 bne .L490
4107 @ if token <> DOT then Scan() end
4108 cmp r4, #10
4109 beq .L488
4110 bl _Scan
4111 b .L488
4112 .L490:
4113 @ elsif not errflag then
4114 set r0, _errflag
4115 ldrb r0, [r0]
4116 cmp r0, #0
4117 bne .L488
4118 @ ShowError();
4119 bl _ShowError
4120 @ print_string("expected "); PrintToken(expected);
4121 mov r1, #9
4122 set r0, g69
4123 bl print_string
4124 ldr r0, [fp, #40]
4125 bl _PrintToken
4126 @ print_string(", found "); PrintToken(token); newline();
4127 mov r1, #8
4128 set r0, g70
4129 bl print_string
4130 set r0, _token
4131 ldr r0, [r0]
4132 bl _PrintToken
4133 bl newline
4134 @ Recover()
4135 bl _Recover
4136 .L488:
4137 ldmfd fp, {r4-r10, fp, sp, pc}
4138 .ltorg
4139
4140 @ proc ParseCompound(): term;
4141 _ParseCompound:
4142 mov ip, sp
4143 stmfd sp!, {r4-r10, fp, ip, lr}
4144 mov fp, sp
4145 sub sp, sp, #256
4146 @ fun := tokval; n := 0; Eat(IDENT);
4147 set r0, _tokval
4148 ldr r4, [r0]
4149 mov r5, #0
4150 mov r0, #1
4151 bl _Eat
4152 @ if token = LPAR then
4153 set r0, _token
4154 ldr r0, [r0]
4155 cmp r0, #7
4156 bne .L501
4157 @ Eat(LPAR); n := 1; arg[1] := ParseTerm();
4158 mov r0, #7
4159 bl _Eat
4160 mov r5, #1
4161 bl _ParseTerm
4162 str r0, [fp, #-252]
4163 .L502:
4164 @ while token = COMMA do
4165 set r0, _token
4166 ldr r0, [r0]
4167 cmp r0, #9
4168 bne .L504
4169 @ Eat(COMMA); n := n+1; arg[n] := ParseTerm()
4170 mov r0, #9
4171 bl _Eat
4172 add r5, r5, #1
4173 bl _ParseTerm
4174 add r1, fp, #-256
4175 lsl r2, r5, #2
4176 add r1, r1, r2
4177 str r0, [r1]
4178 b .L502
4179 .L504:
4180 @ Eat(RPAR)
4181 mov r0, #8
4182 bl _Eat
4183 .L501:
4184 @ if symtab[fun].arity = -1 then
4185 set r0, _symtab
4186 lsl r1, r4, #4
4187 add r0, r0, r1
4188 add r6, r0, #4
4189 ldr r0, [r6]
4190 mov r1, #-1
4191 cmp r0, r1
4192 bne .L506
4193 @ symtab[fun].arity := n
4194 str r5, [r6]
4195 b .L507
4196 .L506:
4197 @ elsif symtab[fun].arity <> n then
4198 set r0, _symtab
4199 lsl r1, r4, #4
4200 add r0, r0, r1
4201 ldr r0, [r0, #4]
4202 cmp r0, r5
4203 beq .L507
4204 @ if not errflag then ShowError(); print_string("wrong number of args"); newline(); Recover() end
4205 set r0, _errflag
4206 ldrb r0, [r0]
4207 cmp r0, #0
4208 bne .L507
4209 bl _ShowError
4210 mov r1, #20
4211 set r0, g71
4212 bl print_string
4213 bl newline
4214 bl _Recover
4215 .L507:
4216 @ return MakeCompound(fun, arg)
4217 add r1, fp, #-256
4218 mov r0, r4
4219 bl _MakeCompound
4220 ldmfd fp, {r4-r10, fp, sp, pc}
4221 .ltorg
4222
4223 @ proc ParsePrimary(): term;
4224 _ParsePrimary:
4225 mov ip, sp
4226 stmfd sp!, {r4-r10, fp, ip, lr}
4227 mov fp, sp
4228 @ if token = IDENT then t := ParseCompound()
4229 set r0, _token
4230 ldr r0, [r0]
4231 cmp r0, #1
4232 bne .L516
4233 bl _ParseCompound
4234 mov r4, r0
4235 b .L517
4236 .L516:
4237 @ elsif token = VARIABLE then
4238 set r0, _token
4239 ldr r0, [r0]
4240 cmp r0, #2
4241 bne .L519
4242 @ t := VarRep(tokval); Eat(VARIABLE)
4243 set r0, _tokval
4244 ldr r0, [r0]
4245 bl _VarRep
4246 mov r4, r0
4247 mov r0, #2
4248 bl _Eat
4249 b .L517
4250 .L519:
4251 @ elsif token = NUMBER then
4252 set r0, _token
4253 ldr r0, [r0]
4254 cmp r0, #3
4255 bne .L522
4256 @ t := MakeInt(tokival); Eat(NUMBER)
4257 set r0, _tokival
4258 ldr r0, [r0]
4259 bl _MakeInt
4260 mov r4, r0
4261 mov r0, #3
4262 bl _Eat
4263 b .L517
4264 .L522:
4265 @ elsif token = CHCON then
4266 set r0, _token
4267 ldr r0, [r0]
4268 cmp r0, #4
4269 bne .L525
4270 @ t := MakeChar(chr(tokival)); Eat(CHCON)
4271 set r0, _tokival
4272 ldr r0, [r0]
4273 bl _MakeChar
4274 mov r4, r0
4275 mov r0, #4
4276 bl _Eat
4277 b .L517
4278 .L525:
4279 @ elsif token = STRCON then
4280 set r0, _token
4281 ldr r0, [r0]
4282 cmp r0, #5
4283 bne .L528
4284 @ t := MakeString(toksval); Eat(STRCON)
4285 set r0, _toksval
4286 bl _MakeString
4287 mov r4, r0
4288 mov r0, #5
4289 bl _Eat
4290 b .L517
4291 .L528:
4292 @ elsif token = LPAR then
4293 set r0, _token
4294 ldr r0, [r0]
4295 cmp r0, #7
4296 bne .L531
4297 @ Eat(LPAR); t := ParseTerm(); Eat(RPAR)
4298 mov r0, #7
4299 bl _Eat
4300 bl _ParseTerm
4301 mov r4, r0
4302 mov r0, #8
4303 bl _Eat
4304 b .L517
4305 .L531:
4306 @ elsif token = LANGLE then
4307 set r0, _token
4308 ldr r0, [r0]
4309 cmp r0, #15
4310 bne .L534
4311 @ t := ParseNode()
4312 bl _ParseNode
4313 mov r4, r0
4314 b .L517
4315 .L534:
4316 @ if not errflag then ShowError(); print_string("expected a term"); newline(); Recover() end; t := NULL
4317 set r0, _errflag
4318 ldrb r0, [r0]
4319 cmp r0, #0
4320 bne .L538
4321 bl _ShowError
4322 mov r1, #15
4323 set r0, g72
4324 bl print_string
4325 bl newline
4326 bl _Recover
4327 .L538:
4328 mov r4, #0
4329 .L517:
4330 @ return t
4331 mov r0, r4
4332 ldmfd fp, {r4-r10, fp, sp, pc}
4333 .ltorg
4334
4335 @ proc ParseNode(): term;
4336 _ParseNode:
4337 mov ip, sp
4338 stmfd sp!, {r4-r10, fp, ip, lr}
4339 mov fp, sp
4340 @ Eat(LANGLE);
4341 mov r0, #15
4342 bl _Eat
4343 @ tag := ParseTerm();
4344 bl _ParseTerm
4345 mov r4, r0
4346 @ kids := ParseKids();
4347 bl _ParseKids
4348 mov r5, r0
4349 @ Eat(RANGLE);
4350 mov r0, #16
4351 bl _Eat
4352 @ return MakeNode(node, tag, kids)
4353 mov r2, r5
4354 mov r1, r4
4355 set r0, _node
4356 ldr r0, [r0]
4357 bl _MakeNode
4358 ldmfd fp, {r4-r10, fp, sp, pc}
4359 .ltorg
4360
4361 @ proc ParseKids(): term;
4362 _ParseKids:
4363 mov ip, sp
4364 stmfd sp!, {r4-r10, fp, ip, lr}
4365 mov fp, sp
4366 @ if token <> COMMA then
4367 set r0, _token
4368 ldr r0, [r0]
4369 cmp r0, #9
4370 beq .L542
4371 @ return MakeNode(nilsym, NULL, NULL)
4372 mov r2, #0
4373 mov r1, #0
4374 set r0, _nilsym
4375 ldr r0, [r0]
4376 bl _MakeNode
4377 b .L540
4378 .L542:
4379 @ Eat(COMMA);
4380 mov r0, #9
4381 bl _Eat
4382 @ head := ParseTerm();
4383 bl _ParseTerm
4384 mov r4, r0
4385 @ tail := ParseKids();
4386 bl _ParseKids
4387 mov r5, r0
4388 @ return MakeNode(cons, head, tail)
4389 mov r2, r5
4390 mov r1, r4
4391 set r0, _cons
4392 ldr r0, [r0]
4393 bl _MakeNode
4394 .L540:
4395 ldmfd fp, {r4-r10, fp, sp, pc}
4396 .ltorg
4397
4398 @ proc ParseFactor(): term;
4399 _ParseFactor:
4400 mov ip, sp
4401 stmfd sp!, {r4-r10, fp, ip, lr}
4402 mov fp, sp
4403 @ t := ParsePrimary();
4404 bl _ParsePrimary
4405 mov r4, r0
4406 @ if token <> COLON then
4407 set r0, _token
4408 ldr r0, [r0]
4409 cmp r0, #11
4410 beq .L546
4411 @ return t
4412 mov r0, r4
4413 b .L544
4414 .L546:
4415 @ Eat(COLON);
4416 mov r0, #11
4417 bl _Eat
4418 @ return MakeNode(cons, t, ParseFactor())
4419 bl _ParseFactor
4420 mov r2, r0
4421 mov r1, r4
4422 set r0, _cons
4423 ldr r0, [r0]
4424 bl _MakeNode
4425 .L544:
4426 ldmfd fp, {r4-r10, fp, sp, pc}
4427 .ltorg
4428
4429 @ proc ParseTerm(): term;
4430 _ParseTerm:
4431 mov ip, sp
4432 stmfd sp!, {r4-r10, fp, ip, lr}
4433 mov fp, sp
4434 @ t := ParseFactor();
4435 bl _ParseFactor
4436 mov r4, r0
4437 @ if token <> EQUAL then
4438 set r0, _token
4439 ldr r0, [r0]
4440 cmp r0, #12
4441 beq .L550
4442 @ return t
4443 mov r0, r4
4444 b .L548
4445 .L550:
4446 @ Eat(EQUAL);
4447 mov r0, #12
4448 bl _Eat
4449 @ return MakeNode(eqsym, t, ParseFactor())
4450 bl _ParseFactor
4451 mov r2, r0
4452 mov r1, r4
4453 set r0, _eqsym
4454 ldr r0, [r0]
4455 bl _MakeNode
4456 .L548:
4457 ldmfd fp, {r4-r10, fp, sp, pc}
4458 .ltorg
4459
4460 @ proc CheckAtom(a: term);
4461 _CheckAtom:
4462 mov ip, sp
4463 stmfd sp!, {r0-r1}
4464 stmfd sp!, {r4-r10, fp, ip, lr}
4465 mov fp, sp
4466 @ if lsr(mem[a], 8) <> FUNC then
4467 set r0, _mem
4468 ldr r1, [fp, #40]
4469 lsl r1, r1, #2
4470 add r0, r0, r1
4471 ldr r0, [r0]
4472 lsr r0, r0, #8
4473 cmp r0, #1
4474 beq .L552
4475 @ if not errflag then ShowError(); print_string("literal must be a compound term"); newline(); Recover() end
4476 set r0, _errflag
4477 ldrb r0, [r0]
4478 cmp r0, #0
4479 bne .L552
4480 bl _ShowError
4481 mov r1, #31
4482 set r0, g73
4483 bl print_string
4484 bl newline
4485 bl _Recover
4486 .L552:
4487 ldmfd fp, {r4-r10, fp, sp, pc}
4488 .ltorg
4489
4490 @ proc ParseClause(): clause;
4491 _ParseClause:
4492 mov ip, sp
4493 stmfd sp!, {r4-r10, fp, ip, lr}
4494 mov fp, sp
4495 sub sp, sp, #264
4496 @ if token = HASH then
4497 set r0, _token
4498 ldr r0, [r0]
4499 cmp r0, #17
4500 bne .L561
4501 @ Eat(HASH); head := NULL
4502 mov r0, #17
4503 bl _Eat
4504 mov r4, #0
4505 b .L562
4506 .L561:
4507 @ head := ParseTerm();
4508 bl _ParseTerm
4509 mov r4, r0
4510 @ CheckAtom(head)
4511 mov r0, r4
4512 bl _CheckAtom
4513 .L562:
4514 @ Eat(ARROW);
4515 mov r0, #6
4516 bl _Eat
4517 @ n := 0;
4518 mov r6, #0
4519 @ if token <> DOT then
4520 set r0, _token
4521 ldr r0, [r0]
4522 cmp r0, #10
4523 beq .L565
4524 @ more := true;
4525 mov r0, #1
4526 strb r0, [fp, #-258]
4527 .L566:
4528 @ while more do
4529 ldrb r0, [fp, #-258]
4530 cmp r0, #0
4531 beq .L565
4532 @ n := n+1; minus := false;
4533 add r6, r6, #1
4534 mov r0, #0
4535 strb r0, [fp, #-257]
4536 @ if token = NEGATE then
4537 set r0, _token
4538 ldr r0, [r0]
4539 cmp r0, #13
4540 bne .L571
4541 @ Eat(NEGATE); minus := true
4542 mov r0, #13
4543 bl _Eat
4544 mov r0, #1
4545 strb r0, [fp, #-257]
4546 .L571:
4547 @ t := ParseTerm(); CheckAtom(t);
4548 bl _ParseTerm
4549 mov r5, r0
4550 mov r0, r5
4551 bl _CheckAtom
4552 @ if minus then
4553 ldrb r0, [fp, #-257]
4554 cmp r0, #0
4555 beq .L573
4556 @ body[n] := MakeNode(notsym, t, NULL)
4557 mov r2, #0
4558 mov r1, r5
4559 set r0, _notsym
4560 ldr r0, [r0]
4561 bl _MakeNode
4562 add r1, fp, #-256
4563 lsl r2, r6, #2
4564 add r1, r1, r2
4565 str r0, [r1]
4566 b .L574
4567 .L573:
4568 @ body[n] := t
4569 add r0, fp, #-256
4570 lsl r1, r6, #2
4571 add r0, r0, r1
4572 str r5, [r0]
4573 .L574:
4574 @ if token = COMMA then Eat(COMMA) else more := false end
4575 set r0, _token
4576 ldr r0, [r0]
4577 cmp r0, #9
4578 bne .L576
4579 mov r0, #9
4580 bl _Eat
4581 b .L566
4582 .L576:
4583 mov r0, #0
4584 strb r0, [fp, #-258]
4585 b .L566
4586 .L565:
4587 @ Eat(DOT);
4588 mov r0, #10
4589 bl _Eat
4590 @ if errflag then
4591 set r0, _errflag
4592 ldrb r0, [r0]
4593 cmp r0, #0
4594 beq .L579
4595 @ return NULL
4596 mov r0, #0
4597 b .L559
4598 .L579:
4599 @ return MakeClause(nvars, head, body, n)
4600 mov r3, r6
4601 add r2, fp, #-256
4602 mov r1, r4
4603 set r0, _nvars
4604 ldr r0, [r0]
4605 bl _MakeClause
4606 .L559:
4607 ldmfd fp, {r4-r10, fp, sp, pc}
4608 .ltorg
4609
4610 @ proc ReadClause(): clause;
4611 _ReadClause:
4612 mov ip, sp
4613 stmfd sp!, {r4-r10, fp, ip, lr}
4614 mov fp, sp
4615 .L582:
4616 @ hp := hmark; nvars := 0; errflag := false;
4617 set r0, _hmark
4618 ldr r0, [r0]
4619 set r1, _hp
4620 str r0, [r1]
4621 mov r0, #0
4622 set r1, _nvars
4623 str r0, [r1]
4624 mov r0, #0
4625 set r1, _errflag
4626 strb r0, [r1]
4627 @ Scan();
4628 bl _Scan
4629 @ if token = EOFTOK then
4630 set r0, _token
4631 ldr r0, [r0]
4632 cmp r0, #14
4633 bne .L586
4634 @ c := NULL
4635 mov r4, #0
4636 b .L587
4637 .L586:
4638 @ c := ParseClause()
4639 bl _ParseClause
4640 mov r4, r0
4641 .L587:
4642 set r0, _errflag
4643 ldrb r0, [r0]
4644 cmp r0, #0
4645 beq .L583
4646 set r0, _token
4647 ldr r0, [r0]
4648 cmp r0, #14
4649 bne .L582
4650 .L583:
4651 @ return c
4652 mov r0, r4
4653 ldmfd fp, {r4-r10, fp, sp, pc}
4654 .ltorg
4655
4656 @ proc Save(v: term);
4657 _Save:
4658 mov ip, sp
4659 stmfd sp!, {r0-r1}
4660 stmfd sp!, {r4-r10, fp, ip, lr}
4661 mov fp, sp
4662 @ if ((v < choice) or (v >= mem[choice+4])) then
4663 ldr r5, [fp, #40]
4664 set r0, _choice
4665 ldr r6, [r0]
4666 cmp r5, r6
4667 blt .L589
4668 set r0, _mem
4669 lsl r1, r6, #2
4670 add r0, r0, r1
4671 ldr r0, [r0, #16]
4672 cmp r5, r0
4673 blt .L588
4674 .L589:
4675 @ p := GloAlloc(UNDO, TRAIL_SIZE);
4676 mov r1, #3
4677 mov r0, #6
4678 bl _GloAlloc
4679 mov r4, r0
4680 @ mem[p+1] := v; mem[p+2] := trhead; trhead := p
4681 set r0, _mem
4682 lsl r1, r4, #2
4683 add r5, r0, r1
4684 ldr r0, [fp, #40]
4685 str r0, [r5, #4]
4686 set r6, _trhead
4687 ldr r0, [r6]
4688 str r0, [r5, #8]
4689 str r4, [r6]
4690 .L588:
4691 ldmfd fp, {r4-r10, fp, sp, pc}
4692 .ltorg
4693
4694 @ proc Restore();
4695 _Restore:
4696 mov ip, sp
4697 stmfd sp!, {r4-r10, fp, ip, lr}
4698 mov fp, sp
4699 .L594:
4700 @ while (trhead <> mem[choice+5]) do
4701 set r0, _trhead
4702 ldr r5, [r0]
4703 set r6, _mem
4704 set r0, _choice
4705 ldr r0, [r0]
4706 lsl r0, r0, #2
4707 add r0, r6, r0
4708 ldr r0, [r0, #20]
4709 cmp r5, r0
4710 beq .L593
4711 @ v := mem[trhead+1];
4712 lsl r0, r5, #2
4713 add r0, r6, r0
4714 ldr r4, [r0, #4]
4715 @ if v <> NULL then mem[v+1] := NULL end;
4716 cmp r4, #0
4717 beq .L599
4718 mov r0, #0
4719 lsl r1, r4, #2
4720 add r1, r6, r1
4721 str r0, [r1, #4]
4722 .L599:
4723 @ trhead := mem[trhead+2]
4724 set r5, _trhead
4725 set r0, _mem
4726 ldr r1, [r5]
4727 lsl r1, r1, #2
4728 add r0, r0, r1
4729 ldr r0, [r0, #8]
4730 str r0, [r5]
4731 b .L594
4732 .L593:
4733 ldmfd fp, {r4-r10, fp, sp, pc}
4734 .ltorg
4735
4736 @ proc Commit();
4737 _Commit:
4738 mov ip, sp
4739 stmfd sp!, {r4-r10, fp, ip, lr}
4740 mov fp, sp
4741 @ p := trhead;
4742 set r0, _trhead
4743 ldr r4, [r0]
4744 .L601:
4745 @ while (p <> NULL) and (p < mem[choice+4]) do
4746 cmp r4, #0
4747 beq .L600
4748 set r5, _mem
4749 set r0, _choice
4750 ldr r6, [r0]
4751 lsl r0, r6, #2
4752 add r0, r5, r0
4753 ldr r7, [r0, #16]
4754 cmp r4, r7
4755 bge .L600
4756 @ if (mem[p+1] <> NULL) and not ((mem[p+1] < choice) or (mem[p+1] >= mem[choice+4])) then
4757 lsl r0, r4, #2
4758 add r0, r5, r0
4759 add r5, r0, #4
4760 ldr r8, [r5]
4761 cmp r8, #0
4762 beq .L606
4763 cmp r8, r6
4764 blt .L606
4765 cmp r8, r7
4766 bge .L606
4767 @ mem[p+1] := NULL
4768 mov r0, #0
4769 str r0, [r5]
4770 .L606:
4771 @ p := mem[p+2]
4772 set r0, _mem
4773 lsl r1, r4, #2
4774 add r0, r0, r1
4775 ldr r4, [r0, #8]
4776 b .L601
4777 .L600:
4778 ldmfd fp, {r4-r10, fp, sp, pc}
4779 .ltorg
4780
4781 @ proc GloCopy(t: term; e: frame): term;
4782 _GloCopy:
4783 mov ip, sp
4784 stmfd sp!, {r0-r1}
4785 stmfd sp!, {r4-r10, fp, ip, lr}
4786 mov fp, sp
4787 sub sp, sp, #8
4788 @ t := Deref(t, e);
4789 ldr r1, [fp, #44]
4790 ldr r0, [fp, #40]
4791 bl _Deref
4792 str r0, [fp, #40]
4793 @ if (t >= gsp) then
4794 set r1, _gsp
4795 ldr r1, [r1]
4796 cmp r0, r1
4797 blt .L612
4798 @ return t
4799 b .L610
4800 .L612:
4801 @ case lsr(mem[t], 8) of
4802 set r0, _mem
4803 ldr r1, [fp, #40]
4804 lsl r1, r1, #2
4805 add r0, r0, r1
4806 ldr r0, [r0]
4807 lsr r0, r0, #8
4808 sub r0, r0, #1
4809 cmp r0, #4
4810 ldrlo pc, [pc, r0, LSL #2]
4811 b .L614
4812 .word .L616
4813 .word .L614
4814 .word .L614
4815 .word .L617
4816 .L616:
4817 @ n := symtab[mem[t+1]].arity;
4818 ldr r7, [fp, #40]
4819 set r0, _symtab
4820 set r1, _mem
4821 lsl r2, r7, #2
4822 add r1, r1, r2
4823 ldr r1, [r1, #4]
4824 lsl r1, r1, #4
4825 add r0, r0, r1
4826 ldr r6, [r0, #4]
4827 @ if (t <= hp) and (n = 0) then
4828 set r0, _hp
4829 ldr r0, [r0]
4830 cmp r7, r0
4831 bgt .L619
4832 cmp r6, #0
4833 bne .L619
4834 @ return t
4835 mov r0, r7
4836 b .L610
4837 .L619:
4838 @ tt := GloAlloc(FUNC, TERM_SIZE+n);
4839 add r1, r6, #2
4840 mov r0, #1
4841 bl _GloAlloc
4842 mov r4, r0
4843 @ mem[tt+1] := mem[t+1];
4844 set r7, _mem
4845 ldr r0, [fp, #40]
4846 lsl r0, r0, #2
4847 add r0, r7, r0
4848 ldr r0, [r0, #4]
4849 lsl r1, r4, #2
4850 add r1, r7, r1
4851 str r0, [r1, #4]
4852 @ for i := 1 to n do
4853 mov r5, #1
4854 str r6, [fp, #-4]
4855 .L621:
4856 ldr r0, [fp, #-4]
4857 cmp r5, r0
4858 bgt .L622
4859 @ mem[tt+i+1] := GloCopy(mem[t+i+1], e)
4860 ldr r1, [fp, #44]
4861 set r0, _mem
4862 ldr r2, [fp, #40]
4863 add r2, r2, r5
4864 lsl r2, r2, #2
4865 add r0, r0, r2
4866 ldr r0, [r0, #4]
4867 bl _GloCopy
4868 set r1, _mem
4869 add r2, r4, r5
4870 lsl r2, r2, #2
4871 add r1, r1, r2
4872 str r0, [r1, #4]
4873 add r5, r5, #1
4874 b .L621
4875 .L622:
4876 @ return tt
4877 mov r0, r4
4878 b .L610
4879 .L617:
4880 @ tt := GloAlloc(CELL, TERM_SIZE);
4881 mov r1, #2
4882 mov r0, #4
4883 bl _GloAlloc
4884 mov r4, r0
4885 @ mem[tt+1] := NULL;
4886 mov r0, #0
4887 set r1, _mem
4888 lsl r2, r4, #2
4889 add r1, r1, r2
4890 str r0, [r1, #4]
4891 @ Save(t); mem[t+1] := tt;
4892 ldr r0, [fp, #40]
4893 bl _Save
4894 set r0, _mem
4895 ldr r1, [fp, #40]
4896 lsl r1, r1, #2
4897 add r0, r0, r1
4898 str r4, [r0, #4]
4899 @ return tt
4900 mov r0, r4
4901 b .L610
4902 .L614:
4903 @ return t
4904 ldr r0, [fp, #40]
4905 .L610:
4906 ldmfd fp, {r4-r10, fp, sp, pc}
4907 .ltorg
4908
4909 @ proc Share(v1, v2: term);
4910 _Share:
4911 mov ip, sp
4912 stmfd sp!, {r0-r1}
4913 stmfd sp!, {r4-r10, fp, ip, lr}
4914 mov fp, sp
4915 @ if (v1 * (2 * ord((v1 >= gsp)) - 1)) <= (v2 * (2 * ord((v2 >= gsp)) - 1)) then
4916 ldr r4, [fp, #40]
4917 set r0, _gsp
4918 ldr r5, [r0]
4919 ldr r6, [fp, #44]
4920 cmp r4, r5
4921 mov r0, #0
4922 movge r0, #1
4923 lsl r0, r0, #1
4924 sub r0, r0, #1
4925 mul r0, r4, r0
4926 cmp r6, r5
4927 mov r1, #0
4928 movge r1, #1
4929 lsl r1, r1, #1
4930 sub r1, r1, #1
4931 mul r1, r6, r1
4932 cmp r0, r1
4933 bgt .L626
4934 @ Save(v1); mem[v1+1] := v2
4935 mov r0, r4
4936 bl _Save
4937 ldr r0, [fp, #44]
4938 set r1, _mem
4939 ldr r2, [fp, #40]
4940 lsl r2, r2, #2
4941 add r1, r1, r2
4942 str r0, [r1, #4]
4943 b .L624
4944 .L626:
4945 @ Save(v2); mem[v2+1] := v1
4946 ldr r0, [fp, #44]
4947 bl _Save
4948 ldr r0, [fp, #40]
4949 set r1, _mem
4950 ldr r2, [fp, #44]
4951 lsl r2, r2, #2
4952 add r1, r1, r2
4953 str r0, [r1, #4]
4954 .L624:
4955 ldmfd fp, {r4-r10, fp, sp, pc}
4956 .ltorg
4957
4958 @ proc Unify(t1: term; e1: frame; t2: term; e2: frame): boolean;
4959 _Unify:
4960 mov ip, sp
4961 stmfd sp!, {r0-r3}
4962 stmfd sp!, {r4-r10, fp, ip, lr}
4963 mov fp, sp
4964 @ t1 := Deref(t1, e1); t2 := Deref(t2, e2);
4965 ldr r1, [fp, #44]
4966 ldr r0, [fp, #40]
4967 bl _Deref
4968 str r0, [fp, #40]
4969 ldr r1, [fp, #52]
4970 ldr r0, [fp, #48]
4971 bl _Deref
4972 str r0, [fp, #48]
4973 @ if t1 = t2 then (* Includes unifying a var with itself *)
4974 ldr r1, [fp, #40]
4975 cmp r1, r0
4976 bne .L630
4977 @ return true
4978 mov r0, #1
4979 b .L628
4980 .L630:
4981 @ elsif (lsr(mem[t1], 8) = CELL) and (lsr(mem[t2], 8) = CELL) then
4982 set r6, _mem
4983 ldr r7, [fp, #40]
4984 lsl r0, r7, #2
4985 add r0, r6, r0
4986 ldr r0, [r0]
4987 lsr r0, r0, #8
4988 cmp r0, #4
4989 bne .L633
4990 ldr r8, [fp, #48]
4991 lsl r0, r8, #2
4992 add r0, r6, r0
4993 ldr r0, [r0]
4994 lsr r0, r0, #8
4995 cmp r0, #4
4996 bne .L633
4997 @ Share(t1, t2); return true
4998 mov r1, r8
4999 mov r0, r7
5000 bl _Share
5001 mov r0, #1
5002 b .L628
5003 .L633:
5004 @ elsif lsr(mem[t1], 8) = CELL then
5005 ldr r6, [fp, #40]
5006 set r0, _mem
5007 lsl r1, r6, #2
5008 add r0, r0, r1
5009 ldr r0, [r0]
5010 lsr r0, r0, #8
5011 cmp r0, #4
5012 bne .L636
5013 @ Save(t1); mem[t1+1] := GloCopy(t2, e2); return true
5014 mov r0, r6
5015 bl _Save
5016 ldr r1, [fp, #52]
5017 ldr r0, [fp, #48]
5018 bl _GloCopy
5019 set r1, _mem
5020 ldr r2, [fp, #40]
5021 lsl r2, r2, #2
5022 add r1, r1, r2
5023 str r0, [r1, #4]
5024 mov r0, #1
5025 b .L628
5026 .L636:
5027 @ elsif lsr(mem[t2], 8) = CELL then
5028 ldr r6, [fp, #48]
5029 set r0, _mem
5030 lsl r1, r6, #2
5031 add r0, r0, r1
5032 ldr r0, [r0]
5033 lsr r0, r0, #8
5034 cmp r0, #4
5035 bne .L639
5036 @ Save(t2); mem[t2+1] := GloCopy(t1, e1); return true
5037 mov r0, r6
5038 bl _Save
5039 ldr r1, [fp, #44]
5040 ldr r0, [fp, #40]
5041 bl _GloCopy
5042 set r1, _mem
5043 ldr r2, [fp, #48]
5044 lsl r2, r2, #2
5045 add r1, r1, r2
5046 str r0, [r1, #4]
5047 mov r0, #1
5048 b .L628
5049 .L639:
5050 @ elsif lsr(mem[t1], 8) <> lsr(mem[t2], 8) then
5051 set r6, _mem
5052 ldr r0, [fp, #40]
5053 lsl r0, r0, #2
5054 add r0, r6, r0
5055 ldr r0, [r0]
5056 lsr r0, r0, #8
5057 ldr r1, [fp, #48]
5058 lsl r1, r1, #2
5059 add r1, r6, r1
5060 ldr r1, [r1]
5061 lsr r1, r1, #8
5062 cmp r0, r1
5063 beq .L642
5064 @ return false
5065 mov r0, #0
5066 b .L628
5067 .L642:
5068 @ case lsr(mem[t1], 8) of
5069 set r0, _mem
5070 ldr r1, [fp, #40]
5071 lsl r1, r1, #2
5072 add r0, r0, r1
5073 ldr r0, [r0]
5074 lsr r0, r0, #8
5075 sub r0, r0, #1
5076 cmp r0, #3
5077 ldrlo pc, [pc, r0, LSL #2]
5078 b .L644
5079 .word .L646
5080 .word .L647
5081 .word .L648
5082 .L646:
5083 @ if (mem[t1+1] <> mem[t2+1]) then
5084 set r6, _mem
5085 ldr r0, [fp, #40]
5086 lsl r0, r0, #2
5087 add r0, r6, r0
5088 ldr r0, [r0, #4]
5089 ldr r1, [fp, #48]
5090 lsl r1, r1, #2
5091 add r1, r6, r1
5092 ldr r1, [r1, #4]
5093 cmp r0, r1
5094 beq .L650
5095 @ return false
5096 mov r0, #0
5097 b .L628
5098 .L650:
5099 @ i := 1; match := true;
5100 mov r4, #1
5101 mov r5, #1
5102 .L652:
5103 @ while match and (i <= symtab[mem[t1+1]].arity) do
5104 cmp r5, #0
5105 beq .L654
5106 set r6, _mem
5107 ldr r7, [fp, #40]
5108 set r0, _symtab
5109 lsl r1, r7, #2
5110 add r1, r6, r1
5111 ldr r1, [r1, #4]
5112 lsl r1, r1, #4
5113 add r0, r0, r1
5114 ldr r0, [r0, #4]
5115 cmp r4, r0
5116 bgt .L654
5117 @ match := Unify(mem[t1+i+1], e1, mem[t2+i+1], e2);
5118 ldr r3, [fp, #52]
5119 ldr r0, [fp, #48]
5120 add r0, r0, r4
5121 lsl r0, r0, #2
5122 add r0, r6, r0
5123 ldr r2, [r0, #4]
5124 ldr r1, [fp, #44]
5125 add r0, r7, r4
5126 lsl r0, r0, #2
5127 add r0, r6, r0
5128 ldr r0, [r0, #4]
5129 bl _Unify
5130 mov r5, r0
5131 @ i := i+1
5132 add r4, r4, #1
5133 b .L652
5134 .L654:
5135 @ return match
5136 mov r0, r5
5137 b .L628
5138 .L647:
5139 @ return (mem[t1+1] = mem[t2+1])
5140 set r6, _mem
5141 ldr r0, [fp, #40]
5142 lsl r0, r0, #2
5143 add r0, r6, r0
5144 ldr r0, [r0, #4]
5145 ldr r1, [fp, #48]
5146 lsl r1, r1, #2
5147 add r1, r6, r1
5148 ldr r1, [r1, #4]
5149 cmp r0, r1
5150 mov r0, #0
5151 moveq r0, #1
5152 b .L628
5153 .L648:
5154 @ return (mem[t1+1] = mem[t2+1])
5155 set r6, _mem
5156 ldr r0, [fp, #40]
5157 lsl r0, r0, #2
5158 add r0, r6, r0
5159 ldr r0, [r0, #4]
5160 ldr r1, [fp, #48]
5161 lsl r1, r1, #2
5162 add r1, r6, r1
5163 ldr r1, [r1, #4]
5164 cmp r0, r1
5165 mov r0, #0
5166 moveq r0, #1
5167 b .L628
5168 .L644:
5169 @ newline(); print_string("Panic: "); print_string("bad tag" (*t_kind(t1):1, " in ", "Unify"*)); newline(); exit(2)
5170 bl newline
5171 mov r1, #7
5172 set r0, g74
5173 bl print_string
5174 mov r1, #7
5175 set r0, g75
5176 bl print_string
5177 bl newline
5178 mov r0, #2
5179 bl exit
5180 .L628:
5181 ldmfd fp, {r4-r10, fp, sp, pc}
5182 .ltorg
5183
5184 @ proc Key(t: term; e: frame): integer;
5185 _Key:
5186 mov ip, sp
5187 stmfd sp!, {r0-r1}
5188 stmfd sp!, {r4-r10, fp, ip, lr}
5189 mov fp, sp
5190 @ if t = NULL then newline(); print_string("Panic: "); print_string("Key"); newline(); exit(2) end;
5191 ldr r0, [fp, #40]
5192 cmp r0, #0
5193 bne .L660
5194 bl newline
5195 mov r1, #7
5196 set r0, g76
5197 bl print_string
5198 mov r1, #3
5199 set r0, g77
5200 bl print_string
5201 bl newline
5202 mov r0, #2
5203 bl exit
5204 .L660:
5205 @ if lsr(mem[t], 8) <> FUNC then newline(); print_string("Panic: "); print_string("bad tag" (*t_kind(t):1, " in ", "Key1"*)); newline(); exit(2) end;
5206 set r0, _mem
5207 ldr r1, [fp, #40]
5208 lsl r1, r1, #2
5209 add r0, r0, r1
5210 ldr r0, [r0]
5211 lsr r0, r0, #8
5212 cmp r0, #1
5213 beq .L663
5214 bl newline
5215 mov r1, #7
5216 set r0, g78
5217 bl print_string
5218 mov r1, #7
5219 set r0, g79
5220 bl print_string
5221 bl newline
5222 mov r0, #2
5223 bl exit
5224 .L663:
5225 @ if symtab[mem[t+1]].arity = 0 then
5226 set r0, _symtab
5227 set r1, _mem
5228 ldr r2, [fp, #40]
5229 lsl r2, r2, #2
5230 add r1, r1, r2
5231 ldr r1, [r1, #4]
5232 lsl r1, r1, #4
5233 add r0, r0, r1
5234 ldr r0, [r0, #4]
5235 cmp r0, #0
5236 bne .L665
5237 @ return 0
5238 mov r0, #0
5239 b .L657
5240 .L665:
5241 @ t0 := Deref(mem[t+1+1], e);
5242 ldr r1, [fp, #44]
5243 set r0, _mem
5244 ldr r2, [fp, #40]
5245 lsl r2, r2, #2
5246 add r0, r0, r2
5247 ldr r0, [r0, #8]
5248 bl _Deref
5249 mov r4, r0
5250 @ case lsr(mem[t0], 8) of
5251 set r0, _mem
5252 lsl r1, r4, #2
5253 add r0, r0, r1
5254 ldr r0, [r0]
5255 lsr r0, r0, #8
5256 sub r0, r0, #1
5257 cmp r0, #3
5258 ldrlo pc, [pc, r0, LSL #2]
5259 b .L667
5260 .word .L669
5261 .word .L670
5262 .word .L671
5263 .L669:
5264 @ FUNC: return mem[t0+1]
5265 set r0, _mem
5266 lsl r1, r4, #2
5267 add r0, r0, r1
5268 ldr r0, [r0, #4]
5269 b .L657
5270 .L670:
5271 @ | INT: return mem[t0+1] + 1
5272 set r0, _mem
5273 lsl r1, r4, #2
5274 add r0, r0, r1
5275 ldr r0, [r0, #4]
5276 add r0, r0, #1
5277 b .L657
5278 .L671:
5279 @ | CHRCTR: return mem[t0+1] + 1
5280 set r0, _mem
5281 lsl r1, r4, #2
5282 add r0, r0, r1
5283 ldr r0, [r0, #4]
5284 add r0, r0, #1
5285 b .L657
5286 .L667:
5287 @ return 0
5288 mov r0, #0
5289 .L657:
5290 ldmfd fp, {r4-r10, fp, sp, pc}
5291 .ltorg
5292
5293 @ proc Search(t: term; e: frame; p: clause): clause;
5294 _Search:
5295 mov ip, sp
5296 stmfd sp!, {r0-r3}
5297 stmfd sp!, {r4-r10, fp, ip, lr}
5298 mov fp, sp
5299 @ k := Key(t, e);
5300 ldr r1, [fp, #44]
5301 ldr r0, [fp, #40]
5302 bl _Key
5303 mov r4, r0
5304 @ if k <> 0 then
5305 cmp r4, #0
5306 beq .L675
5307 .L676:
5308 @ while (p <> NULL) and (mem[p+1] <> 0) and (mem[p+1] <> k) do
5309 ldr r5, [fp, #48]
5310 cmp r5, #0
5311 beq .L675
5312 set r0, _mem
5313 lsl r1, r5, #2
5314 add r5, r0, r1
5315 ldr r6, [r5, #4]
5316 cmp r6, #0
5317 beq .L675
5318 cmp r6, r4
5319 beq .L675
5320 @ p := mem[p+2]
5321 ldr r0, [r5, #8]
5322 str r0, [fp, #48]
5323 b .L676
5324 .L675:
5325 @ return p
5326 ldr r0, [fp, #48]
5327 ldmfd fp, {r4-r10, fp, sp, pc}
5328 .ltorg
5329
5330 @ proc PushFrame(nvars: integer; retry: clause);
5331 _PushFrame:
5332 mov ip, sp
5333 stmfd sp!, {r0-r1}
5334 stmfd sp!, {r4-r10, fp, ip, lr}
5335 mov fp, sp
5336 @ f := LocAlloc((FRAME_SIZE + (nvars)*TERM_SIZE));
5337 ldr r0, [fp, #40]
5338 lsl r0, r0, #1
5339 add r0, r0, #7
5340 bl _LocAlloc
5341 mov r4, r0
5342 @ mem[f] := current; mem[f+1] := goalframe;
5343 set r0, _mem
5344 lsl r1, r4, #2
5345 add r7, r0, r1
5346 set r0, _current
5347 ldr r0, [r0]
5348 str r0, [r7]
5349 set r0, _goalframe
5350 ldr r0, [r0]
5351 str r0, [r7, #4]
5352 @ mem[f+2] := retry; mem[f+3] := choice;
5353 ldr r0, [fp, #44]
5354 str r0, [r7, #8]
5355 set r0, _choice
5356 ldr r0, [r0]
5357 str r0, [r7, #12]
5358 @ mem[f+4] := gsp; mem[f+5] := trhead;
5359 set r0, _gsp
5360 ldr r0, [r0]
5361 str r0, [r7, #16]
5362 set r0, _trhead
5363 ldr r0, [r0]
5364 str r0, [r7, #20]
5365 @ mem[f+6] := nvars;
5366 ldr r8, [fp, #40]
5367 str r8, [r7, #24]
5368 @ for i := 1 to nvars do
5369 mov r5, #1
5370 mov r6, r8
5371 .L682:
5372 cmp r5, r6
5373 bgt .L683
5374 @ mem[(f+7+(i-1)*TERM_SIZE)] := lsl(CELL, 8) + TERM_SIZE;
5375 set r0, _mem
5376 add r1, r4, #7
5377 lsl r2, r5, #1
5378 sub r2, r2, #2
5379 add r1, r1, r2
5380 lsl r1, r1, #2
5381 add r7, r0, r1
5382 set r0, #1026
5383 str r0, [r7]
5384 @ mem[(f+7+(i-1)*TERM_SIZE)+1] := NULL
5385 mov r0, #0
5386 str r0, [r7, #4]
5387 add r5, r5, #1
5388 b .L682
5389 .L683:
5390 @ goalframe := f;
5391 set r0, _goalframe
5392 str r4, [r0]
5393 @ if retry <> NULL then choice := goalframe end
5394 ldr r0, [fp, #44]
5395 cmp r0, #0
5396 beq .L681
5397 set r0, _goalframe
5398 ldr r7, [r0]
5399 set r0, _choice
5400 str r7, [r0]
5401 .L681:
5402 ldmfd fp, {r4-r10, fp, sp, pc}
5403 .ltorg
5404
5405 @ proc TroStep();
5406 _TroStep:
5407 mov ip, sp
5408 stmfd sp!, {r4-r10, fp, ip, lr}
5409 mov fp, sp
5410 sub sp, sp, #16
5411 @ if dflag then print_string("(TRO)"); newline() end;
5412 set r0, _dflag
5413 ldrb r0, [r0]
5414 cmp r0, #0
5415 beq .L690
5416 mov r1, #5
5417 set r0, g80
5418 bl print_string
5419 bl newline
5420 .L690:
5421 @ oldsize := (FRAME_SIZE + (mem[goalframe+6])*TERM_SIZE); (* size of old frame *)
5422 set r7, _mem
5423 set r0, _goalframe
5424 ldr r0, [r0]
5425 lsl r0, r0, #2
5426 add r0, r7, r0
5427 ldr r0, [r0, #24]
5428 lsl r0, r0, #1
5429 add r5, r0, #7
5430 @ newsize := (FRAME_SIZE + (mem[prok])*TERM_SIZE); (* size of new frame *)
5431 set r0, _prok
5432 ldr r0, [r0]
5433 lsl r0, r0, #2
5434 add r0, r7, r0
5435 ldr r0, [r0]
5436 lsl r0, r0, #1
5437 add r6, r0, #7
5438 @ temp := LocAlloc(newsize);
5439 mov r0, r6
5440 bl _LocAlloc
5441 mov r4, r0
5442 @ temp := goalframe + newsize; (* copy old frame here *)
5443 set r0, _goalframe
5444 ldr r0, [r0]
5445 add r4, r0, r6
5446 @ for i := 1 to oldsize do
5447 mov r0, #1
5448 str r0, [fp, #-4]
5449 str r5, [fp, #-8]
5450 .L691:
5451 ldr r7, [fp, #-4]
5452 ldr r0, [fp, #-8]
5453 cmp r7, r0
5454 bgt .L692
5455 @ mem[temp+oldsize-i] := mem[goalframe+oldsize-i]
5456 set r8, _mem
5457 set r0, _goalframe
5458 ldr r0, [r0]
5459 add r0, r0, r5
5460 sub r0, r0, r7
5461 lsl r0, r0, #2
5462 add r0, r8, r0
5463 ldr r0, [r0]
5464 add r1, r4, r5
5465 sub r1, r1, r7
5466 lsl r1, r1, #2
5467 add r1, r8, r1
5468 str r0, [r1]
5469 add r0, r7, #1
5470 str r0, [fp, #-4]
5471 b .L691
5472 .L692:
5473 @ for i := 1 to mem[goalframe+6] do
5474 mov r0, #1
5475 str r0, [fp, #-4]
5476 set r0, _mem
5477 set r1, _goalframe
5478 ldr r1, [r1]
5479 lsl r1, r1, #2
5480 add r0, r0, r1
5481 ldr r0, [r0, #24]
5482 str r0, [fp, #-12]
5483 .L693:
5484 ldr r7, [fp, #-4]
5485 ldr r0, [fp, #-12]
5486 cmp r7, r0
5487 bgt .L694
5488 @ if (lsr(mem[(temp+7+(i-1)*TERM_SIZE)], 8) = CELL)
5489 set r0, _mem
5490 add r1, r4, #7
5491 lsl r2, r7, #1
5492 sub r2, r2, #2
5493 add r1, r1, r2
5494 lsl r1, r1, #2
5495 add r7, r0, r1
5496 ldr r0, [r7]
5497 lsr r0, r0, #8
5498 cmp r0, #4
5499 bne .L697
5500 add r7, r7, #4
5501 ldr r8, [r7]
5502 cmp r8, #0
5503 beq .L697
5504 set r0, _goalframe
5505 ldr r9, [r0]
5506 cmp r9, r8
5507 bgt .L697
5508 add r0, r9, r5
5509 cmp r8, r0
5510 bge .L697
5511 @ mem[(temp+7+(i-1)*TERM_SIZE)+1] := mem[(temp+7+(i-1)*TERM_SIZE)+1] + newsize
5512 add r0, r8, r6
5513 str r0, [r7]
5514 .L697:
5515 ldr r0, [fp, #-4]
5516 add r0, r0, #1
5517 str r0, [fp, #-4]
5518 b .L693
5519 .L694:
5520 @ mem[goalframe+6] := mem[prok];
5521 set r7, _mem
5522 set r8, _goalframe
5523 set r0, _prok
5524 ldr r0, [r0]
5525 lsl r0, r0, #2
5526 add r0, r7, r0
5527 ldr r0, [r0]
5528 ldr r1, [r8]
5529 lsl r1, r1, #2
5530 add r1, r7, r1
5531 str r0, [r1, #24]
5532 @ for i := 1 to mem[goalframe+6] do
5533 mov r0, #1
5534 str r0, [fp, #-4]
5535 ldr r0, [r8]
5536 lsl r0, r0, #2
5537 add r0, r7, r0
5538 ldr r0, [r0, #24]
5539 str r0, [fp, #-16]
5540 .L701:
5541 ldr r7, [fp, #-4]
5542 ldr r0, [fp, #-16]
5543 cmp r7, r0
5544 bgt .L702
5545 @ mem[(goalframe+7+(i-1)*TERM_SIZE)] := lsl(CELL, 8) + TERM_SIZE;
5546 set r8, _mem
5547 set r9, _goalframe
5548 lsl r0, r7, #1
5549 sub r0, r0, #2
5550 set r1, #1026
5551 ldr r2, [r9]
5552 add r2, r2, #7
5553 add r2, r2, r0
5554 lsl r2, r2, #2
5555 add r2, r8, r2
5556 str r1, [r2]
5557 @ mem[(goalframe+7+(i-1)*TERM_SIZE)+1] := NULL
5558 mov r1, #0
5559 ldr r2, [r9]
5560 add r2, r2, #7
5561 add r0, r2, r0
5562 lsl r0, r0, #2
5563 add r0, r8, r0
5564 str r1, [r0, #4]
5565 add r0, r7, #1
5566 str r0, [fp, #-4]
5567 b .L701
5568 .L702:
5569 @ ok := Unify(call, temp, mem[prok+3], goalframe);
5570 set r0, _goalframe
5571 ldr r3, [r0]
5572 set r0, _mem
5573 set r1, _prok
5574 ldr r1, [r1]
5575 lsl r1, r1, #2
5576 add r0, r0, r1
5577 ldr r2, [r0, #12]
5578 mov r1, r4
5579 set r0, _call
5580 ldr r0, [r0]
5581 bl _Unify
5582 set r1, _ok
5583 strb r0, [r1]
5584 @ current := (prok+4);
5585 set r0, _prok
5586 ldr r0, [r0]
5587 add r0, r0, #4
5588 set r1, _current
5589 str r0, [r1]
5590 @ lsp := temp-1
5591 sub r0, r4, #1
5592 set r1, _lsp
5593 str r0, [r1]
5594 ldmfd fp, {r4-r10, fp, sp, pc}
5595 .ltorg
5596
5597 @ proc Step();
5598 _Step:
5599 mov ip, sp
5600 stmfd sp!, {r4-r10, fp, ip, lr}
5601 mov fp, sp
5602 @ if symtab[mem[call+1]].action <> 0 then
5603 set r0, _symtab
5604 set r1, _mem
5605 set r2, _call
5606 ldr r2, [r2]
5607 lsl r2, r2, #2
5608 add r1, r1, r2
5609 ldr r1, [r1, #4]
5610 lsl r1, r1, #4
5611 add r0, r0, r1
5612 ldr r5, [r0, #8]
5613 cmp r5, #0
5614 beq .L705
5615 @ ok := DoBuiltin(symtab[mem[call+1]].action)
5616 mov r0, r5
5617 bl _DoBuiltin
5618 set r1, _ok
5619 strb r0, [r1]
5620 b .L706
5621 .L705:
5622 @ elsif prok = NULL then
5623 set r0, _prok
5624 ldr r0, [r0]
5625 cmp r0, #0
5626 bne .L708
5627 @ ok := false
5628 mov r0, #0
5629 set r1, _ok
5630 strb r0, [r1]
5631 b .L706
5632 .L708:
5633 @ retry := Search(call, goalframe, mem[prok+2]);
5634 set r0, _mem
5635 set r1, _prok
5636 ldr r1, [r1]
5637 lsl r1, r1, #2
5638 add r0, r0, r1
5639 ldr r2, [r0, #8]
5640 set r0, _goalframe
5641 ldr r1, [r0]
5642 set r0, _call
5643 ldr r0, [r0]
5644 bl _Search
5645 mov r4, r0
5646 @ if (mem[(current)+1] = NULL) and (choice < goalframe)
5647 set r0, _mem
5648 set r1, _current
5649 ldr r1, [r1]
5650 lsl r1, r1, #2
5651 add r0, r0, r1
5652 ldr r0, [r0, #4]
5653 cmp r0, #0
5654 bne .L711
5655 set r0, _goalframe
5656 ldr r5, [r0]
5657 set r0, _choice
5658 ldr r0, [r0]
5659 cmp r0, r5
5660 bge .L711
5661 cmp r4, #0
5662 bne .L711
5663 set r0, _base
5664 ldr r0, [r0]
5665 cmp r5, r0
5666 beq .L711
5667 @ TroStep()
5668 bl _TroStep
5669 b .L706
5670 .L711:
5671 @ PushFrame(mem[prok], retry);
5672 mov r1, r4
5673 set r0, _mem
5674 set r2, _prok
5675 ldr r2, [r2]
5676 lsl r2, r2, #2
5677 add r0, r0, r2
5678 ldr r0, [r0]
5679 bl _PushFrame
5680 @ ok := Unify(call, mem[goalframe+1], mem[prok+3], goalframe);
5681 set r5, _mem
5682 set r0, _goalframe
5683 ldr r6, [r0]
5684 mov r3, r6
5685 set r0, _prok
5686 ldr r0, [r0]
5687 lsl r0, r0, #2
5688 add r0, r5, r0
5689 ldr r2, [r0, #12]
5690 lsl r0, r6, #2
5691 add r0, r5, r0
5692 ldr r1, [r0, #4]
5693 set r0, _call
5694 ldr r0, [r0]
5695 bl _Unify
5696 set r1, _ok
5697 strb r0, [r1]
5698 @ current := (prok+4);
5699 set r0, _prok
5700 ldr r0, [r0]
5701 add r0, r0, #4
5702 set r1, _current
5703 str r0, [r1]
5704 .L706:
5705 ldmfd fp, {r4-r10, fp, sp, pc}
5706 .ltorg
5707
5708 @ proc Unwind();
5709 _Unwind:
5710 mov ip, sp
5711 stmfd sp!, {r4-r10, fp, ip, lr}
5712 mov fp, sp
5713 .L717:
5714 @ while (mem[current] = NULL) and (goalframe <> base) do
5715 set r0, _mem
5716 set r1, _current
5717 ldr r1, [r1]
5718 lsl r1, r1, #2
5719 add r0, r0, r1
5720 ldr r0, [r0]
5721 cmp r0, #0
5722 bne .L716
5723 set r0, _goalframe
5724 ldr r0, [r0]
5725 set r1, _base
5726 ldr r1, [r1]
5727 cmp r0, r1
5728 beq .L716
5729 @ if dflag then
5730 set r0, _dflag
5731 ldrb r0, [r0]
5732 cmp r0, #0
5733 beq .L722
5734 @ print_string("Exit"); print_string(": ");
5735 mov r1, #4
5736 set r0, g81
5737 bl print_string
5738 mov r1, #2
5739 set r0, g82
5740 bl print_string
5741 @ PrintTerm(mem[mem[goalframe]], mem[goalframe+1], MAXPRIO); newline()
5742 set r4, _mem
5743 set r0, _goalframe
5744 ldr r0, [r0]
5745 lsl r0, r0, #2
5746 add r5, r4, r0
5747 mov r2, #2
5748 ldr r1, [r5, #4]
5749 ldr r0, [r5]
5750 lsl r0, r0, #2
5751 add r0, r4, r0
5752 ldr r0, [r0]
5753 bl _PrintTerm
5754 bl newline
5755 .L722:
5756 @ current := (mem[goalframe])+1;
5757 set r0, _goalframe
5758 ldr r4, [r0]
5759 set r0, _mem
5760 lsl r1, r4, #2
5761 add r0, r0, r1
5762 ldr r0, [r0]
5763 add r0, r0, #1
5764 set r1, _current
5765 str r0, [r1]
5766 @ if goalframe > choice then lsp := goalframe-1 end;
5767 set r0, _choice
5768 ldr r0, [r0]
5769 cmp r4, r0
5770 ble .L725
5771 sub r0, r4, #1
5772 set r1, _lsp
5773 str r0, [r1]
5774 .L725:
5775 @ goalframe := mem[goalframe+1]
5776 set r4, _goalframe
5777 set r0, _mem
5778 ldr r1, [r4]
5779 lsl r1, r1, #2
5780 add r0, r0, r1
5781 ldr r0, [r0, #4]
5782 str r0, [r4]
5783 b .L717
5784 .L716:
5785 ldmfd fp, {r4-r10, fp, sp, pc}
5786 .ltorg
5787
5788 @ proc Backtrack();
5789 _Backtrack:
5790 mov ip, sp
5791 stmfd sp!, {r4-r10, fp, ip, lr}
5792 mov fp, sp
5793 @ Restore();
5794 bl _Restore
5795 @ current := mem[choice]; goalframe := mem[choice+1];
5796 set r4, _mem
5797 set r0, _choice
5798 ldr r0, [r0]
5799 lsl r0, r0, #2
5800 add r5, r4, r0
5801 ldr r6, [r5]
5802 set r0, _current
5803 str r6, [r0]
5804 ldr r5, [r5, #4]
5805 set r0, _goalframe
5806 str r5, [r0]
5807 @ call := Deref(mem[current], goalframe);
5808 mov r1, r5
5809 lsl r0, r6, #2
5810 add r0, r4, r0
5811 ldr r0, [r0]
5812 bl _Deref
5813 set r1, _call
5814 str r0, [r1]
5815 @ prok := mem[choice+2]; gsp := mem[choice+4];
5816 set r4, _choice
5817 ldr r5, [r4]
5818 set r0, _mem
5819 lsl r1, r5, #2
5820 add r6, r0, r1
5821 ldr r0, [r6, #8]
5822 set r1, _prok
5823 str r0, [r1]
5824 ldr r0, [r6, #16]
5825 set r1, _gsp
5826 str r0, [r1]
5827 @ lsp := choice-1; choice := mem[choice+3];
5828 sub r0, r5, #1
5829 set r1, _lsp
5830 str r0, [r1]
5831 ldr r0, [r6, #12]
5832 str r0, [r4]
5833 @ if dflag then
5834 set r0, _dflag
5835 ldrb r0, [r0]
5836 cmp r0, #0
5837 beq .L730
5838 @ print_string("Redo"); print_string(": ");
5839 mov r1, #4
5840 set r0, g83
5841 bl print_string
5842 mov r1, #2
5843 set r0, g84
5844 bl print_string
5845 @ PrintTerm(call, goalframe, MAXPRIO); newline()
5846 mov r2, #2
5847 set r0, _goalframe
5848 ldr r1, [r0]
5849 set r0, _call
5850 ldr r0, [r0]
5851 bl _PrintTerm
5852 bl newline
5853 .L730:
5854 ldmfd fp, {r4-r10, fp, sp, pc}
5855 .ltorg
5856
5857 @ proc Resume();
5858 _Resume:
5859 mov ip, sp
5860 stmfd sp!, {r4-r10, fp, ip, lr}
5861 mov fp, sp
5862 .L732:
5863 @ while run do
5864 set r0, _run
5865 ldrb r0, [r0]
5866 cmp r0, #0
5867 beq .L731
5868 @ if ok then
5869 set r0, _ok
5870 ldrb r0, [r0]
5871 cmp r0, #0
5872 beq .L736
5873 @ if mem[current] = NULL then return end;
5874 set r0, _mem
5875 set r1, _current
5876 ldr r1, [r1]
5877 lsl r1, r1, #2
5878 add r0, r0, r1
5879 ldr r4, [r0]
5880 cmp r4, #0
5881 beq .L731
5882 @ call := Deref(mem[current], goalframe);
5883 set r0, _goalframe
5884 ldr r1, [r0]
5885 mov r0, r4
5886 bl _Deref
5887 set r1, _call
5888 str r0, [r1]
5889 @ if dflag then
5890 set r0, _dflag
5891 ldrb r0, [r0]
5892 cmp r0, #0
5893 beq .L746
5894 @ print_string("Call"); print_string(": ");
5895 mov r1, #4
5896 set r0, g85
5897 bl print_string
5898 mov r1, #2
5899 set r0, g86
5900 bl print_string
5901 @ PrintTerm(call, goalframe, MAXPRIO); newline()
5902 mov r2, #2
5903 set r0, _goalframe
5904 ldr r1, [r0]
5905 set r0, _call
5906 ldr r0, [r0]
5907 bl _PrintTerm
5908 bl newline
5909 .L746:
5910 @ if (symtab[mem[call+1]].prok = NULL)
5911 set r0, _symtab
5912 set r1, _mem
5913 set r2, _call
5914 ldr r2, [r2]
5915 lsl r2, r2, #2
5916 add r1, r1, r2
5917 ldr r1, [r1, #4]
5918 lsl r1, r1, #4
5919 add r4, r0, r1
5920 ldr r0, [r4, #12]
5921 cmp r0, #0
5922 bne .L749
5923 ldr r0, [r4, #8]
5924 cmp r0, #0
5925 bne .L749
5926 @ newline(); print_string("Error: "); print_string("call to undefined relation "); run := false;
5927 bl newline
5928 mov r1, #7
5929 set r0, g87
5930 bl print_string
5931 mov r1, #27
5932 set r0, g88
5933 bl print_string
5934 mov r0, #0
5935 set r1, _run
5936 strb r0, [r1]
5937 @ WriteString(symtab[mem[call+1]].name);
5938 set r0, _symtab
5939 set r1, _mem
5940 set r2, _call
5941 ldr r2, [r2]
5942 lsl r2, r2, #2
5943 add r1, r1, r2
5944 ldr r1, [r1, #4]
5945 lsl r1, r1, #4
5946 add r0, r0, r1
5947 ldr r0, [r0]
5948 bl _WriteString
5949 b .L731
5950 .L749:
5951 @ prok := Search(call, goalframe, symtab[mem[call+1]].prok)
5952 set r0, _call
5953 ldr r4, [r0]
5954 set r0, _symtab
5955 set r1, _mem
5956 lsl r2, r4, #2
5957 add r1, r1, r2
5958 ldr r1, [r1, #4]
5959 lsl r1, r1, #4
5960 add r0, r0, r1
5961 ldr r2, [r0, #12]
5962 set r0, _goalframe
5963 ldr r1, [r0]
5964 mov r0, r4
5965 bl _Search
5966 set r1, _prok
5967 str r0, [r1]
5968 b .L737
5969 .L736:
5970 @ if choice <= base then return end;
5971 set r0, _choice
5972 ldr r0, [r0]
5973 set r1, _base
5974 ldr r1, [r1]
5975 cmp r0, r1
5976 ble .L731
5977 @ Backtrack()
5978 bl _Backtrack
5979 .L737:
5980 @ Step();
5981 bl _Step
5982 @ if ok then Unwind() end;
5983 set r0, _ok
5984 ldrb r0, [r0]
5985 cmp r0, #0
5986 beq .L732
5987 bl _Unwind
5988 b .L732
5989 .L731:
5990 ldmfd fp, {r4-r10, fp, sp, pc}
5991 .ltorg
5992
5993 @ proc Execute(g: clause);
5994 _Execute:
5995 mov ip, sp
5996 stmfd sp!, {r0-r1}
5997 stmfd sp!, {r4-r10, fp, ip, lr}
5998 mov fp, sp
5999 @ lsp := hp; gsp := MEMSIZE+1;
6000 set r0, _hp
6001 ldr r0, [r0]
6002 set r1, _lsp
6003 str r0, [r1]
6004 set r0, #25001
6005 set r1, _gsp
6006 str r0, [r1]
6007 @ current := NULL; goalframe := NULL; choice := NULL; trhead := NULL;
6008 mov r0, #0
6009 set r1, _current
6010 str r0, [r1]
6011 mov r0, #0
6012 set r1, _goalframe
6013 str r0, [r1]
6014 mov r0, #0
6015 set r1, _choice
6016 str r0, [r1]
6017 mov r0, #0
6018 set r1, _trhead
6019 str r0, [r1]
6020 @ PushFrame(mem[g], NULL);
6021 mov r1, #0
6022 set r0, _mem
6023 ldr r2, [fp, #40]
6024 lsl r2, r2, #2
6025 add r0, r0, r2
6026 ldr r0, [r0]
6027 bl _PushFrame
6028 @ choice := goalframe; base := goalframe; current := (g+4);
6029 set r0, _goalframe
6030 ldr r5, [r0]
6031 set r0, _choice
6032 str r5, [r0]
6033 set r0, _base
6034 str r5, [r0]
6035 ldr r0, [fp, #40]
6036 add r0, r0, #4
6037 set r1, _current
6038 str r0, [r1]
6039 @ run := true; ok := true;
6040 mov r0, #1
6041 set r1, _run
6042 strb r0, [r1]
6043 mov r0, #1
6044 set r1, _ok
6045 strb r0, [r1]
6046 @ Resume();
6047 bl _Resume
6048 @ if not run then return end;
6049 set r0, _run
6050 ldrb r0, [r0]
6051 cmp r0, #0
6052 beq .L754
6053 .L758:
6054 @ while ok do
6055 set r0, _ok
6056 ldrb r0, [r0]
6057 cmp r0, #0
6058 beq .L760
6059 @ nsoln := nsoln+1;
6060 add r4, r4, #1
6061 @ ShowAnswer(base);
6062 set r0, _base
6063 ldr r0, [r0]
6064 bl _ShowAnswer
6065 @ newline();
6066 bl newline
6067 @ ok := false;
6068 mov r0, #0
6069 set r1, _ok
6070 strb r0, [r1]
6071 @ Resume();
6072 bl _Resume
6073 @ if not run then return end;
6074 set r0, _run
6075 ldrb r0, [r0]
6076 cmp r0, #0
6077 beq .L754
6078 b .L758
6079 .L760:
6080 @ if nsoln = 0 then
6081 cmp r4, #0
6082 bne .L754
6083 @ print_string("no"); newline(); newline();
6084 mov r1, #2
6085 set r0, g89
6086 bl print_string
6087 bl newline
6088 bl newline
6089 .L754:
6090 ldmfd fp, {r4-r10, fp, sp, pc}
6091 .ltorg
6092
6093 @ proc GetArgs();
6094 _GetArgs:
6095 mov ip, sp
6096 stmfd sp!, {r4-r10, fp, ip, lr}
6097 mov fp, sp
6098 @ for i := 1 to symtab[mem[call+1]].arity do
6099 mov r4, #1
6100 set r0, _symtab
6101 set r1, _mem
6102 set r2, _call
6103 ldr r2, [r2]
6104 lsl r2, r2, #2
6105 add r1, r1, r2
6106 ldr r1, [r1, #4]
6107 lsl r1, r1, #4
6108 add r0, r0, r1
6109 ldr r5, [r0, #4]
6110 .L768:
6111 cmp r4, r5
6112 bgt .L767
6113 @ av[i] := Deref(mem[call+i+1], goalframe)
6114 set r0, _goalframe
6115 ldr r1, [r0]
6116 set r0, _mem
6117 set r2, _call
6118 ldr r2, [r2]
6119 add r2, r2, r4
6120 lsl r2, r2, #2
6121 add r0, r0, r2
6122 ldr r0, [r0, #4]
6123 bl _Deref
6124 set r1, _av
6125 lsl r2, r4, #2
6126 add r1, r1, r2
6127 str r0, [r1]
6128 add r4, r4, #1
6129 b .L768
6130 .L767:
6131 ldmfd fp, {r4-r10, fp, sp, pc}
6132 .ltorg
6133
6134 @ proc NewInt(n: integer): term;
6135 _NewInt:
6136 mov ip, sp
6137 stmfd sp!, {r0-r1}
6138 stmfd sp!, {r4-r10, fp, ip, lr}
6139 mov fp, sp
6140 @ t := GloAlloc(INT, TERM_SIZE);
6141 mov r1, #2
6142 mov r0, #2
6143 bl _GloAlloc
6144 mov r4, r0
6145 @ mem[t+1] := n;
6146 ldr r0, [fp, #40]
6147 set r1, _mem
6148 lsl r2, r4, #2
6149 add r1, r1, r2
6150 str r0, [r1, #4]
6151 @ return t
6152 mov r0, r4
6153 ldmfd fp, {r4-r10, fp, sp, pc}
6154 .ltorg
6155
6156 @ proc DoCut(): boolean;
6157 _DoCut:
6158 mov ip, sp
6159 stmfd sp!, {r4-r10, fp, ip, lr}
6160 mov fp, sp
6161 @ choice := mem[goalframe+3];
6162 set r0, _goalframe
6163 ldr r4, [r0]
6164 set r0, _mem
6165 lsl r1, r4, #2
6166 add r5, r0, r1
6167 ldr r0, [r5, #12]
6168 set r1, _choice
6169 str r0, [r1]
6170 @ lsp := goalframe + (FRAME_SIZE + (mem[goalframe+6])*TERM_SIZE) - 1;
6171 ldr r0, [r5, #24]
6172 lsl r0, r0, #1
6173 add r0, r0, #7
6174 add r0, r4, r0
6175 sub r0, r0, #1
6176 set r1, _lsp
6177 str r0, [r1]
6178 @ Commit();
6179 bl _Commit
6180 @ current := (current)+1;
6181 set r4, _current
6182 ldr r0, [r4]
6183 add r0, r0, #1
6184 str r0, [r4]
6185 @ return true
6186 mov r0, #1
6187 ldmfd fp, {r4-r10, fp, sp, pc}
6188 .ltorg
6189
6190 @ proc DoCall(): boolean;
6191 _DoCall:
6192 mov ip, sp
6193 stmfd sp!, {r4-r10, fp, ip, lr}
6194 mov fp, sp
6195 @ GetArgs();
6196 bl _GetArgs
6197 @ if not (lsr(mem[av[1]], 8) = FUNC) then
6198 set r0, _mem
6199 set r1, _av
6200 ldr r1, [r1, #4]
6201 lsl r1, r1, #2
6202 add r0, r0, r1
6203 ldr r0, [r0]
6204 lsr r0, r0, #8
6205 cmp r0, #1
6206 beq .L774
6207 @ newline(); print_string("Error: "); print_string("bad argument to call/1"); run := false;
6208 bl newline
6209 mov r1, #7
6210 set r0, g90
6211 bl print_string
6212 mov r1, #22
6213 set r0, g91
6214 bl print_string
6215 mov r0, #0
6216 set r1, _run
6217 strb r0, [r1]
6218 @ return false
6219 mov r0, #0
6220 b .L772
6221 .L774:
6222 @ PushFrame(1, NULL);
6223 mov r1, #0
6224 mov r0, #1
6225 bl _PushFrame
6226 @ mem[(goalframe+7+(1-1)*TERM_SIZE)+1] :=
6227 set r0, _mem
6228 set r1, _goalframe
6229 ldr r1, [r1]
6230 lsl r1, r1, #2
6231 add r0, r0, r1
6232 ldr r1, [r0, #4]
6233 set r0, _av
6234 ldr r0, [r0, #4]
6235 bl _GloCopy
6236 set r1, _mem
6237 set r2, _goalframe
6238 ldr r2, [r2]
6239 lsl r2, r2, #2
6240 add r1, r1, r2
6241 str r0, [r1, #32]
6242 @ current := callbody;
6243 set r0, _callbody
6244 ldr r0, [r0]
6245 set r1, _current
6246 str r0, [r1]
6247 @ return true
6248 mov r0, #1
6249 .L772:
6250 ldmfd fp, {r4-r10, fp, sp, pc}
6251 .ltorg
6252
6253 @ proc DoNot(): boolean;
6254 _DoNot:
6255 mov ip, sp
6256 stmfd sp!, {r4-r10, fp, ip, lr}
6257 mov fp, sp
6258 @ GetArgs();
6259 bl _GetArgs
6260 @ if not (lsr(mem[av[1]], 8) = FUNC) then
6261 set r0, _mem
6262 set r1, _av
6263 ldr r1, [r1, #4]
6264 lsl r1, r1, #2
6265 add r0, r0, r1
6266 ldr r0, [r0]
6267 lsr r0, r0, #8
6268 cmp r0, #1
6269 beq .L778
6270 @ newline(); print_string("Error: "); print_string("bad argument to call/1"); run := false;
6271 bl newline
6272 mov r1, #7
6273 set r0, g92
6274 bl print_string
6275 mov r1, #22
6276 set r0, g93
6277 bl print_string
6278 mov r0, #0
6279 set r1, _run
6280 strb r0, [r1]
6281 @ return false
6282 mov r0, #0
6283 b .L776
6284 .L778:
6285 @ PushFrame(1, NULL);
6286 mov r1, #0
6287 mov r0, #1
6288 bl _PushFrame
6289 @ savebase := base; base := goalframe; choice := goalframe;
6290 set r5, _base
6291 ldr r4, [r5]
6292 set r0, _goalframe
6293 ldr r6, [r0]
6294 str r6, [r5]
6295 set r0, _choice
6296 str r6, [r0]
6297 @ mem[(goalframe+7+(1-1)*TERM_SIZE)+1] :=
6298 set r0, _mem
6299 lsl r1, r6, #2
6300 add r0, r0, r1
6301 ldr r1, [r0, #4]
6302 set r0, _av
6303 ldr r0, [r0, #4]
6304 bl _GloCopy
6305 set r1, _mem
6306 set r2, _goalframe
6307 ldr r2, [r2]
6308 lsl r2, r2, #2
6309 add r1, r1, r2
6310 str r0, [r1, #32]
6311 @ current := callbody; ok := true;
6312 set r0, _callbody
6313 ldr r0, [r0]
6314 set r1, _current
6315 str r0, [r1]
6316 mov r0, #1
6317 set r1, _ok
6318 strb r0, [r1]
6319 @ Resume();
6320 bl _Resume
6321 @ choice := mem[base+3]; goalframe := mem[base+1];
6322 set r0, _mem
6323 set r1, _base
6324 ldr r1, [r1]
6325 lsl r1, r1, #2
6326 add r5, r0, r1
6327 ldr r0, [r5, #12]
6328 set r1, _choice
6329 str r0, [r1]
6330 ldr r0, [r5, #4]
6331 set r1, _goalframe
6332 str r0, [r1]
6333 @ if not ok then
6334 set r0, _ok
6335 ldrb r0, [r0]
6336 cmp r0, #0
6337 bne .L781
6338 @ current := (mem[base])+1;
6339 ldr r0, [r5]
6340 add r0, r0, #1
6341 set r1, _current
6342 str r0, [r1]
6343 @ return true
6344 mov r0, #1
6345 b .L776
6346 .L781:
6347 @ Commit();
6348 bl _Commit
6349 @ return false
6350 mov r0, #0
6351 .L776:
6352 ldmfd fp, {r4-r10, fp, sp, pc}
6353 .ltorg
6354
6355 @ proc DoPlus(): boolean;
6356 _DoPlus:
6357 mov ip, sp
6358 stmfd sp!, {r4-r10, fp, ip, lr}
6359 mov fp, sp
6360 @ GetArgs();
6361 bl _GetArgs
6362 @ result := false;
6363 mov r4, #0
6364 @ if (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[2]], 8) = INT) then
6365 set r5, _mem
6366 set r6, _av
6367 ldr r0, [r6, #4]
6368 lsl r0, r0, #2
6369 add r7, r5, r0
6370 ldr r0, [r7]
6371 lsr r0, r0, #8
6372 cmp r0, #2
6373 bne .L785
6374 ldr r0, [r6, #8]
6375 lsl r0, r0, #2
6376 add r5, r5, r0
6377 ldr r0, [r5]
6378 lsr r0, r0, #8
6379 cmp r0, #2
6380 bne .L785
6381 @ result := Unify(av[3], goalframe, NewInt(mem[av[1]+1] + mem[av[2]+1]), NULL)
6382 ldr r0, [r7, #4]
6383 ldr r1, [r5, #4]
6384 add r0, r0, r1
6385 bl _NewInt
6386 mov r3, #0
6387 mov r2, r0
6388 set r0, _goalframe
6389 ldr r1, [r0]
6390 ldr r0, [r6, #12]
6391 bl _Unify
6392 mov r4, r0
6393 b .L786
6394 .L785:
6395 @ elsif (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
6396 set r5, _mem
6397 set r6, _av
6398 ldr r0, [r6, #4]
6399 lsl r0, r0, #2
6400 add r7, r5, r0
6401 ldr r0, [r7]
6402 lsr r0, r0, #8
6403 cmp r0, #2
6404 bne .L788
6405 ldr r0, [r6, #12]
6406 lsl r0, r0, #2
6407 add r5, r5, r0
6408 ldr r0, [r5]
6409 lsr r0, r0, #8
6410 cmp r0, #2
6411 bne .L788
6412 @ if mem[av[1]+1] <= mem[av[3]+1] then
6413 ldr r7, [r7, #4]
6414 ldr r5, [r5, #4]
6415 cmp r7, r5
6416 bgt .L786
6417 @ result := Unify(av[2], goalframe,
6418 sub r0, r5, r7
6419 bl _NewInt
6420 mov r3, #0
6421 mov r2, r0
6422 set r0, _goalframe
6423 ldr r1, [r0]
6424 ldr r0, [r6, #8]
6425 bl _Unify
6426 mov r4, r0
6427 b .L786
6428 .L788:
6429 @ elsif (lsr(mem[av[2]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
6430 set r5, _mem
6431 set r6, _av
6432 ldr r0, [r6, #8]
6433 lsl r0, r0, #2
6434 add r7, r5, r0
6435 ldr r0, [r7]
6436 lsr r0, r0, #8
6437 cmp r0, #2
6438 bne .L791
6439 ldr r0, [r6, #12]
6440 lsl r0, r0, #2
6441 add r5, r5, r0
6442 ldr r0, [r5]
6443 lsr r0, r0, #8
6444 cmp r0, #2
6445 bne .L791
6446 @ if mem[av[2]+1] <= mem[av[3]+1] then
6447 ldr r7, [r7, #4]
6448 ldr r5, [r5, #4]
6449 cmp r7, r5
6450 bgt .L786
6451 @ result := Unify(av[1], goalframe, NewInt(mem[av[3]+1] - mem[av[2]+1]), NULL)
6452 sub r0, r5, r7
6453 bl _NewInt