annotate 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
rev   line source
mike@0 1 (* A prolog interpreter running a program that computes tilings *)
mike@0 2
mike@0 3 (* This program is the output of a macro processor, so contains many
mike@0 4 untidy expressions *)
mike@0 5
mike@0 6
mike@0 7 (* tunable parameters *)
mike@0 8 const
mike@0 9 MAXSYMBOLS = 511; (* max no. of symbols *)
mike@0 10 HASHFACTOR = 90; (* percent loading factor for hash table *)
mike@0 11 MAXCHARS = 2048; (* max chars in symbols *)
mike@0 12 MAXSTRING = 128; (* max string length *)
mike@0 13 MAXARITY = 63; (* max arity of function, vars in clause *)
mike@0 14 MEMSIZE = 25000; (* size of |mem| array *)
mike@0 15
mike@0 16 (* special character values *)
mike@0 17 const ENDSTR = chr(0); (* end of string *)
mike@0 18 TAB = chr(9); (* tab character *)
mike@0 19 ENDLINE = chr(10); (* newline character *)
mike@0 20 ENDFILE = chr(127); (* end of file *)
mike@0 21
mike@0 22 var run: boolean; (* whether execution should continue *)
mike@0 23 dflag: boolean; (* switch for debugging code *)
mike@0 24
mike@0 25 type
mike@0 26 permstring = integer;
mike@0 27 tempstring = array MAXSTRING of char;
mike@0 28
mike@0 29 var
mike@0 30 charptr: integer;
mike@0 31 charbuf: array MAXCHARS of char;
mike@0 32
mike@0 33 (* |StringLength| -- length of a tempstring *)
mike@0 34 proc StringLength(var s: tempstring): integer;
mike@0 35 var i: integer;
mike@0 36 begin
mike@0 37 i := 0;
mike@0 38 while s[i] <> ENDSTR do i := i+1 end;
mike@0 39 return i
mike@0 40 end;
mike@0 41
mike@0 42 (* |SaveString| -- make a tempstring permanent *)
mike@0 43 proc SaveString(var s: tempstring): permstring;
mike@0 44 var p, i: integer;
mike@0 45 begin
mike@0 46 if charptr + StringLength(s) + 1 > MAXCHARS then
mike@0 47 newline(); print_string("Panic: "); print_string("out of string space"); newline(); exit(2)
mike@0 48 end;
mike@0 49 p := charptr; i := 0;
mike@0 50 repeat
mike@0 51 charbuf[charptr] := s[i]; charptr := charptr+1; i := i+1
mike@0 52 until charbuf[charptr-1] = ENDSTR;
mike@0 53 return p
mike@0 54 end;
mike@0 55
mike@0 56 (* |StringEqual| -- compare a tempstring to a permstring *)
mike@0 57 proc StringEqual(var s1: tempstring; s2: permstring): boolean;
mike@0 58 var i: integer;
mike@0 59 begin
mike@0 60 i := 0;
mike@0 61 while (s1[i] <> ENDSTR) and (s1[i] = charbuf[s2+i]) do i := i+1 end;
mike@0 62 return (s1[i] = charbuf[s2+i])
mike@0 63 end;
mike@0 64
mike@0 65 (* |WriteString| -- print a permstring *)
mike@0 66 proc WriteString(s: permstring);
mike@0 67 var i: integer;
mike@0 68 begin
mike@0 69 i := s;
mike@0 70 while charbuf[i] <> ENDSTR do
mike@0 71 print_char(charbuf[i]); i := i+1
mike@0 72 end
mike@0 73 end;
mike@0 74
mike@0 75 type
mike@0 76 ptr = integer; (* index into |mem| array *)
mike@0 77
mike@0 78 const NULL = 0; (* null pointer *)
mike@0 79
mike@0 80 type term = ptr;
mike@0 81
mike@0 82 const FUNC = 1; (* compound term *)
mike@0 83 INT = 2; (* integer *)
mike@0 84 CHRCTR = 3; (* character *)
mike@0 85 CELL = 4; (* variable cell *)
mike@0 86 REF = 5; (* variable reference *)
mike@0 87 UNDO = 6; (* trail item *)
mike@0 88
mike@0 89 const TERM_SIZE = 2; (* \dots\ plus no. of args *)
mike@0 90
mike@0 91 var
mike@0 92 lsp, gsp, hp, hmark: ptr;
mike@0 93 mem: array MEMSIZE+1 of integer;
mike@0 94
mike@0 95 (* |LocAlloc| -- allocate space on local stack *)
mike@0 96 proc LocAlloc(size: integer): ptr;
mike@0 97 var p: ptr;
mike@0 98 begin
mike@0 99 if lsp + size >= gsp then newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2) end;
mike@0 100 p := lsp + 1; lsp := lsp + size; return p
mike@0 101 end;
mike@0 102
mike@0 103 (* |GloAlloc| -- allocate space on global stack *)
mike@0 104 proc GloAlloc(kind, size: integer): ptr;
mike@0 105 var p: ptr;
mike@0 106 begin
mike@0 107 if gsp - size <= lsp then
mike@0 108 newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2)
mike@0 109 end;
mike@0 110 gsp := gsp - size; p := gsp;
mike@0 111 mem[p] := lsl(kind, 8) + size;
mike@0 112 return p
mike@0 113 end;
mike@0 114
mike@0 115 (* |HeapAlloc| -- allocate space on heap *)
mike@0 116 proc HeapAlloc(size: integer): ptr;
mike@0 117 var p: ptr;
mike@0 118 begin
mike@0 119 if hp + size > MEMSIZE then newline(); print_string("Panic: "); print_string("out of heap space"); newline(); exit(2) end;
mike@0 120 p := hp + 1; hp := hp + size; return p
mike@0 121 end;
mike@0 122
mike@0 123 var infile: array 3000 of char; pin, pout: integer;
mike@0 124
mike@0 125 proc prog(line: array 60 of char);
mike@0 126 var i: integer;
mike@0 127 begin
mike@0 128 for i := 0 to 59 do
mike@0 129 infile[pin] := line[i]; pin := pin+1
mike@0 130 end;
mike@0 131 infile[pin] := ENDLINE; pin := pin+1
mike@0 132 end;
mike@0 133
mike@0 134 proc rdchar(var ch: char);
mike@0 135 begin
mike@0 136 if pout >= pin then
mike@0 137 ch := ENDFILE
mike@0 138 else
mike@0 139 ch := infile[pout]; pout := pout+1
mike@0 140 end
mike@0 141 end;
mike@0 142
mike@0 143 var
mike@0 144 pbchar: char; (* pushed-back char, else |ENDFILE| *)
mike@0 145 lineno: integer; (* line number in current file *)
mike@0 146
mike@0 147 (* |GetChar| -- get a character *)
mike@0 148 proc GetChar(): char;
mike@0 149 var ch: char;
mike@0 150 begin
mike@0 151 if pbchar <> ENDFILE then
mike@0 152 ch := pbchar; pbchar := ENDFILE
mike@0 153 else
mike@0 154 rdchar(ch);
mike@0 155 if ch = ENDLINE then lineno := lineno+1 end
mike@0 156 end;
mike@0 157 return ch
mike@0 158 end;
mike@0 159
mike@0 160 (* |PushBack| -- push back a character on the input *)
mike@0 161 proc PushBack(ch: char);
mike@0 162 begin
mike@0 163 pbchar := ch
mike@0 164 end;
mike@0 165
mike@0 166 type clause = ptr;
mike@0 167
mike@0 168 const CLAUSE_SIZE = 4; (* ... plus size of body + 1 *)
mike@0 169
mike@0 170 type frame = ptr;
mike@0 171
mike@0 172 const FRAME_SIZE = 7; (* \dots plus space for local variables *)
mike@0 173
mike@0 174 var
mike@0 175 current: ptr; (* current goal *)
mike@0 176 call: term; (* |Deref|'ed first literal of goal *)
mike@0 177 goalframe: frame; (* current stack frame *)
mike@0 178 choice: frame; (* last choice point *)
mike@0 179 base: frame; (* frame for original goal *)
mike@0 180 prok: clause; (* clauses left to try on current goal *)
mike@0 181
mike@0 182 (* |Deref| -- follow |VAR| and |CELL| pointers *)
mike@0 183 proc Deref(t: term; e: frame): term;
mike@0 184 begin
mike@0 185 if t = NULL then newline(); print_string("Panic: "); print_string("Deref"); newline(); exit(2) end;
mike@0 186 if (lsr(mem[t], 8) = REF) and (e <> NULL) then
mike@0 187 t := (e+7+(mem[t+1]-1)*TERM_SIZE)
mike@0 188 end;
mike@0 189 while (lsr(mem[t], 8) = CELL) and (mem[t+1] <> NULL) do
mike@0 190 t := mem[t+1]
mike@0 191 end;
mike@0 192 return t
mike@0 193 end;
mike@0 194
mike@0 195 type symbol = integer; (* index in |symtab| *)
mike@0 196
mike@0 197 var
mike@0 198 nsymbols: integer; (* number of symbols *)
mike@0 199 symtab: array MAXSYMBOLS+1 of record
mike@0 200 name: integer; (* print name: index in |charbuf| *)
mike@0 201 arity: integer; (* number of arguments or -1 *)
mike@0 202 action: integer; (* code if built-in, 0 otherwise *)
mike@0 203 prok: clause (* clause chain *)
mike@0 204 end;
mike@0 205 cons, eqsym, cutsym, nilsym, notsym: symbol;
mike@0 206 node: symbol;
mike@0 207
mike@0 208 (* |Lookup| -- convert string to internal symbol *)
mike@0 209 proc Lookup(var name: tempstring): symbol;
mike@0 210 var h, i: integer; p: symbol;
mike@0 211 begin
mike@0 212 (* Compute the hash function in |h| *)
mike@0 213 h := 0; i := 0;
mike@0 214 while name[i] <> ENDSTR do
mike@0 215 h := (5 * h + ord(name[i])) mod MAXSYMBOLS; i := i+1
mike@0 216 end;
mike@0 217
mike@0 218 (* Search the hash table *)
mike@0 219 p := h+1;
mike@0 220 while symtab[p].name <> -1 do
mike@0 221 if StringEqual(name, symtab[p].name) then return p end;
mike@0 222 p := p-1;
mike@0 223 if p = 0 then p := MAXSYMBOLS end
mike@0 224 end;
mike@0 225
mike@0 226 (* Not found: enter a new symbol *)
mike@0 227 (* Be careful to avoid overflow on 16 bit machines: *)
mike@0 228 if nsymbols >= (MAXSYMBOLS div 10) * (HASHFACTOR div 10) then
mike@0 229 newline(); print_string("Panic: "); print_string("out of symbol space"); newline(); exit(2)
mike@0 230 end;
mike@0 231 symtab[p].name := SaveString(name);
mike@0 232 symtab[p].arity := -1;
mike@0 233 symtab[p].action := 0; symtab[p].prok := NULL;
mike@0 234 return p
mike@0 235 end;
mike@0 236
mike@0 237 type keyword = array 8 of char;
mike@0 238
mike@0 239 (* |Enter| -- define a built-in symbol *)
mike@0 240 proc Enter(name: keyword; arity: integer; action: integer): symbol;
mike@0 241 var s: symbol; i: integer; temp: tempstring;
mike@0 242 begin
mike@0 243 i := 0;
mike@0 244 while name[i] <> ' ' do
mike@0 245 temp[i] := name[i]; i := i+1
mike@0 246 end;
mike@0 247 temp[i] := ENDSTR; s := Lookup(temp);
mike@0 248 symtab[s].arity := arity; symtab[s].action := action;
mike@0 249 return s
mike@0 250 end;
mike@0 251
mike@0 252 (* Codes for built-in relations *)
mike@0 253 const
mike@0 254 CUT = 1; (* $!/0$ *)
mike@0 255 CALL = 2; (* |call/1| *)
mike@0 256 PLUS = 3; (* |plus/3| *)
mike@0 257 TIMES = 4; (* |times/3| *)
mike@0 258 ISINT = 5; (* |integer/1| *)
mike@0 259 ISCHAR = 6; (* |char/1| *)
mike@0 260 NAFF = 7; (* |not/1| *)
mike@0 261 EQUALITY = 8; (* |=/2| *)
mike@0 262 FAIL = 9; (* |false/0| *)
mike@0 263 PRINT = 10; (* |print/1| *)
mike@0 264 NL = 11; (* |nl/0| *)
mike@0 265
mike@0 266 (* |InitSymbols| -- initialize and define standard symbols *)
mike@0 267 proc InitSymbols();
mike@0 268 var i: integer; dummy: symbol;
mike@0 269 begin
mike@0 270 nsymbols := 0;
mike@0 271 for i := 1 to MAXSYMBOLS do symtab[i].name := -1 end;
mike@0 272 cons := Enter(": ", 2, 0);
mike@0 273 cutsym := Enter("! ", 0, CUT);
mike@0 274 eqsym := Enter("= ", 2, EQUALITY);
mike@0 275 nilsym := Enter("nil ", 0, 0);
mike@0 276 notsym := Enter("not ", 1, NAFF);
mike@0 277 node := Enter("node ", 2, 0);
mike@0 278 dummy := Enter("call ", 1, CALL);
mike@0 279 dummy := Enter("plus ", 3, PLUS);
mike@0 280 dummy := Enter("times ", 3, TIMES);
mike@0 281 dummy := Enter("integer ", 1, ISINT);
mike@0 282 dummy := Enter("char ", 1, ISCHAR);
mike@0 283 dummy := Enter("false ", 0, FAIL);
mike@0 284 dummy := Enter("print ", 1, PRINT);
mike@0 285 dummy := Enter("nl ", 0, NL)
mike@0 286 end;
mike@0 287
mike@0 288 (* |AddClause| -- insert a clause at the end of its chain *)
mike@0 289 proc AddClause(c: clause);
mike@0 290 var s: symbol; p: clause;
mike@0 291 begin
mike@0 292 s := mem[mem[c+3]+1];
mike@0 293 if symtab[s].action <> 0 then
mike@0 294 newline(); print_string("Error: "); print_string("cannot add clauses to built-in relation "); run := false;
mike@0 295 WriteString(symtab[s].name)
mike@0 296 elsif symtab[s].prok = NULL then
mike@0 297 symtab[s].prok := c
mike@0 298 else
mike@0 299 p := symtab[s].prok;
mike@0 300 while mem[p+2] <> NULL do p := mem[p+2] end;
mike@0 301 mem[p+2] := c
mike@0 302 end
mike@0 303 end;
mike@0 304
mike@0 305 type argbuf = array MAXARITY+1 of term;
mike@0 306
mike@0 307 (* |MakeCompound| -- construct a compound term on the heap *)
mike@0 308 proc MakeCompound(fun: symbol; var arg: argbuf): term;
mike@0 309 var p: term; i, n: integer;
mike@0 310 begin
mike@0 311 n := symtab[fun].arity;
mike@0 312 p := HeapAlloc(TERM_SIZE+n);
mike@0 313 mem[p] := lsl(FUNC, 8) + TERM_SIZE+n;
mike@0 314 mem[p+1] := fun;
mike@0 315 for i := 1 to n do mem[p+i+1] := arg[i] end;
mike@0 316 return p
mike@0 317 end;
mike@0 318
mike@0 319 (* |MakeNode| -- construct a compound term with up to 2 arguments *)
mike@0 320 proc MakeNode(fun: symbol; a1, a2: term): term;
mike@0 321 var arg: argbuf;
mike@0 322 begin
mike@0 323 arg[1] := a1; arg[2] := a2;
mike@0 324 return MakeCompound(fun, arg)
mike@0 325 end;
mike@0 326
mike@0 327 var refnode: array MAXARITY+1 of term;
mike@0 328
mike@0 329 (* |MakeRef| -- return a reference cell prepared earlier *)
mike@0 330 proc MakeRef(offset: integer): term;
mike@0 331 begin
mike@0 332 return refnode[offset]
mike@0 333 end;
mike@0 334
mike@0 335 (* |MakeInt| -- construct an integer node on the heap *)
mike@0 336 proc MakeInt(i: integer): term;
mike@0 337 var p: term;
mike@0 338 begin
mike@0 339 p := HeapAlloc(TERM_SIZE);
mike@0 340 mem[p] := lsl(INT, 8) + TERM_SIZE;
mike@0 341 mem[p+1] := i; return p
mike@0 342 end;
mike@0 343
mike@0 344 (* |MakeChar| -- construct a character node on the heap *)
mike@0 345 proc MakeChar(c: char): term;
mike@0 346 var p: term;
mike@0 347 begin
mike@0 348 p := HeapAlloc(TERM_SIZE);
mike@0 349 mem[p] := lsl(CHRCTR, 8) + TERM_SIZE;
mike@0 350 mem[p+1] := ord(c); return p
mike@0 351 end;
mike@0 352
mike@0 353 (* |MakeString| -- construct a string as a Prolog list of chars *)
mike@0 354 proc MakeString(var s: tempstring): term;
mike@0 355 var p: term; i: integer;
mike@0 356 begin
mike@0 357 i := StringLength(s);
mike@0 358 p := MakeNode(nilsym, NULL, NULL);
mike@0 359 while i > 0 do
mike@0 360 i := i-1; p := MakeNode(cons, MakeChar(s[i]), p)
mike@0 361 end;
mike@0 362 return p
mike@0 363 end;
mike@0 364
mike@0 365 (* |MakeClause| -- construct a clause on the heap *)
mike@0 366 proc MakeClause(nvars: integer; head: term;
mike@0 367 var body: argbuf; nbody: integer): clause;
mike@0 368 var p: clause; i: integer;
mike@0 369 begin
mike@0 370 p := HeapAlloc(CLAUSE_SIZE + nbody + 1);
mike@0 371 mem[p] := nvars; mem[p+2] := NULL; mem[p+3] := head;
mike@0 372 for i := 1 to nbody do mem[(p+4)+i-1] := body[i] end;
mike@0 373 mem[(p+4)+nbody+1-1] := NULL;
mike@0 374 if head = NULL then
mike@0 375 mem[p+1] := 0
mike@0 376 else
mike@0 377 mem[p+1] := Key(head, NULL)
mike@0 378 end;
mike@0 379 return p
mike@0 380 end;
mike@0 381
mike@0 382 (* operator priorities *)
mike@0 383 const
mike@0 384 MAXPRIO = 2; (* isolated term *)
mike@0 385 ARGPRIO = 2; (* function arguments *)
mike@0 386 EQPRIO = 2; (* equals sign *)
mike@0 387 CONSPRIO = 1; (* colon *)
mike@0 388
mike@0 389 (* |IsString| -- check if a list represents a string *)
mike@0 390 proc IsString(t: term; e: frame): boolean;
mike@0 391 const limit = 128;
mike@0 392 var i: integer;
mike@0 393 begin
mike@0 394 i := 0; t := Deref(t, e);
mike@0 395 while i < limit do
mike@0 396 if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
mike@0 397 return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
mike@0 398 elsif lsr(mem[Deref(mem[t+1+1], e)], 8) <> CHRCTR then
mike@0 399 return false
mike@0 400 else
mike@0 401 i := i+1; t := Deref(mem[t+2+1], e)
mike@0 402 end
mike@0 403 end;
mike@0 404 return false
mike@0 405 end;
mike@0 406
mike@0 407 (* |IsList| -- check if a term is a proper list *)
mike@0 408 proc IsList(t: term; e: frame): boolean;
mike@0 409 const limit = 128;
mike@0 410 var i: integer;
mike@0 411 begin
mike@0 412 i := 0; t := Deref(t, e);
mike@0 413 while i < limit do
mike@0 414 if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
mike@0 415 return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
mike@0 416 else
mike@0 417 i := i+1; t := Deref(mem[t+2+1], e)
mike@0 418 end
mike@0 419 end;
mike@0 420 return false
mike@0 421 end;
mike@0 422
mike@0 423 (* |ShowString| -- print a list as a string *)
mike@0 424 proc ShowString(t: term; e: frame);
mike@0 425 begin
mike@0 426 t := Deref(t, e);
mike@0 427 print_char('"');
mike@0 428 while mem[t+1] <> nilsym do
mike@0 429 print_char(chr(mem[Deref(mem[t+1+1], e)+1]));
mike@0 430 t := Deref(mem[t+2+1], e)
mike@0 431 end;
mike@0 432 print_char('"')
mike@0 433 end;
mike@0 434
mike@0 435 (* |PrintCompound| -- print a compound term *)
mike@0 436 proc PrintCompound(t: term; e: frame; prio: integer);
mike@0 437 var f: symbol; i: integer;
mike@0 438 begin
mike@0 439 f := mem[t+1];
mike@0 440 if f = cons then
mike@0 441 (* |t| is a list: try printing as a string, or use infix : *)
mike@0 442 if IsString(t, e) then
mike@0 443 ShowString(t, e)
mike@0 444 else
mike@0 445 if prio < CONSPRIO then print_char('(') end;
mike@0 446 PrintTerm(mem[t+1+1], e, CONSPRIO-1);
mike@0 447 print_char(':');
mike@0 448 PrintTerm(mem[t+2+1], e, CONSPRIO);
mike@0 449 if prio < CONSPRIO then print_char(')') end
mike@0 450 end
mike@0 451 elsif f = eqsym then
mike@0 452 (* |t| is an equation: use infix = *)
mike@0 453 if prio < EQPRIO then print_char('(') end;
mike@0 454 PrintTerm(mem[t+1+1], e, EQPRIO-1);
mike@0 455 print_string(" = ");
mike@0 456 PrintTerm(mem[t+2+1], e, EQPRIO-1);
mike@0 457 if prio < EQPRIO then print_char(')') end
mike@0 458 elsif f = notsym then
mike@0 459 (* |t| is a literal 'not P' *)
mike@0 460 print_string("not ");
mike@0 461 PrintTerm(mem[t+1+1], e, MAXPRIO)
mike@0 462 elsif (f = node) and IsList(mem[t+2+1], e) then
mike@0 463 PrintNode(t, e)
mike@0 464 else
mike@0 465 (* use ordinary notation *)
mike@0 466 WriteString(symtab[f].name);
mike@0 467 if symtab[f].arity > 0 then
mike@0 468 print_char('(');
mike@0 469 PrintTerm(mem[t+1+1], e, ARGPRIO);
mike@0 470 for i := 2 to symtab[f].arity do
mike@0 471 print_string(", ");
mike@0 472 PrintTerm(mem[t+i+1], e, ARGPRIO)
mike@0 473 end;
mike@0 474 print_char(')')
mike@0 475 end
mike@0 476 end
mike@0 477 end;
mike@0 478
mike@0 479 (* |PrintNode| -- print and optree node *)
mike@0 480 proc PrintNode(t: term; e: frame);
mike@0 481 var u: term;
mike@0 482 begin
mike@0 483 print_char('<');
mike@0 484 PrintTerm(mem[t+1+1], e, MAXPRIO);
mike@0 485 u := Deref(mem[t+2+1], e);
mike@0 486 while mem[u+1] <> nilsym do
mike@0 487 print_string(", ");
mike@0 488 PrintTerm(mem[u+1+1], e, MAXPRIO);
mike@0 489 u := Deref(mem[u+2+1], e)
mike@0 490 end;
mike@0 491 print_char('>');
mike@0 492 end;
mike@0 493
mike@0 494 (* |PrintTerm| -- print a term *)
mike@0 495 proc PrintTerm(t: term; e: frame; prio: integer);
mike@0 496 begin
mike@0 497 t := Deref(t, e);
mike@0 498 if t = NULL then
mike@0 499 print_string("*null-term*")
mike@0 500 else
mike@0 501 case lsr(mem[t], 8) of
mike@0 502 FUNC:
mike@0 503 PrintCompound(t, e, prio)
mike@0 504 | INT:
mike@0 505 print_num(mem[t+1])
mike@0 506 | CHRCTR:
mike@0 507 print_char(''''); print_char(chr(mem[t+1])); print_char('''')
mike@0 508 | CELL:
mike@0 509 if (t >= gsp) then
mike@0 510 print_char('G'); print_num((MEMSIZE - t) div TERM_SIZE)
mike@0 511 else
mike@0 512 print_char('L'); print_num((t - hp) div TERM_SIZE)
mike@0 513 end
mike@0 514 | REF:
mike@0 515 print_char('@'); print_num(mem[t+1])
mike@0 516 else
mike@0 517 print_string("*unknown-term(tag=");
mike@0 518 print_num(lsr(mem[t], 8)); print_string(")*")
mike@0 519 end
mike@0 520 end
mike@0 521 end;
mike@0 522
mike@0 523 (* |PrintClause| -- print a clause *)
mike@0 524 proc PrintClause(c: clause);
mike@0 525 var i: integer;
mike@0 526 begin
mike@0 527 if c = NULL then
mike@0 528 print_string("*null-clause*"); newline();
mike@0 529 else
mike@0 530 if mem[c+3] <> NULL then
mike@0 531 PrintTerm(mem[c+3], NULL, MAXPRIO);
mike@0 532 print_char(' ')
mike@0 533 end;
mike@0 534 print_string(":- ");
mike@0 535 if mem[(c+4)+1-1] <> NULL then
mike@0 536 PrintTerm(mem[(c+4)+1-1], NULL, MAXPRIO);
mike@0 537 i := 2;
mike@0 538 while mem[(c+4)+i-1] <> NULL do
mike@0 539 print_string(", ");
mike@0 540 PrintTerm(mem[(c+4)+i-1], NULL, MAXPRIO);
mike@0 541 i := i+1
mike@0 542 end
mike@0 543 end;
mike@0 544 print_char('.'); newline()
mike@0 545 end
mike@0 546 end;
mike@0 547
mike@0 548 var
mike@0 549 token: integer; (* last token from input *)
mike@0 550 tokval: symbol; (* if |token = IDENT|, the identifier*)
mike@0 551 tokival: integer; (* if |token = NUMBER|, the number *)
mike@0 552 toksval: tempstring; (* if |token = STRCON|, the string *)
mike@0 553 errflag: boolean; (* whether recovering from an error *)
mike@0 554 errcount: integer; (* number of errors found so far *)
mike@0 555
mike@0 556 (* Possible values for |token|: *)
mike@0 557 const
mike@0 558 IDENT = 1; (* identifier: see |tokval| *)
mike@0 559 VARIABLE = 2; (* variable: see |tokval| *)
mike@0 560 NUMBER = 3; (* number: see |tokival| *)
mike@0 561 CHCON = 4; (* char constant: see |tokival| *)
mike@0 562 STRCON = 5; (* string constant: see |toksval| *)
mike@0 563 ARROW = 6; (* |':-'| *)
mike@0 564 LPAR = 7; (* |'('| *)
mike@0 565 RPAR = 8; (* |')'| *)
mike@0 566 COMMA = 9; (* |','| *)
mike@0 567 DOT = 10; (* |'.'| *)
mike@0 568 COLON = 11; (* |':'| *)
mike@0 569 EQUAL = 12; (* |'='| *)
mike@0 570 NEGATE = 13; (* |'not'| *)
mike@0 571 EOFTOK = 14; (* end of file *)
mike@0 572 LANGLE = 15; (* |'<'| *)
mike@0 573 RANGLE = 16; (* |'>'| *)
mike@0 574 HASH = 17; (* |'#'| *)
mike@0 575
mike@0 576 (* |ShowError| -- report error location *)
mike@0 577 proc ShowError();
mike@0 578 begin
mike@0 579 errflag := true; errcount := errcount+1;
mike@0 580 print_string("Line "); print_num(lineno); print_char(' ');
mike@0 581 print_string("Syntax error - ")
mike@0 582 end;
mike@0 583
mike@0 584 (* |Recover| -- discard rest of input clause *)
mike@0 585 proc Recover();
mike@0 586 var ch: char;
mike@0 587 begin
mike@0 588 if errcount >= 20 then
mike@0 589 print_string("Too many errors: I am giving up"); newline(); exit(2)
mike@0 590 end;
mike@0 591 if token <> DOT then
mike@0 592 repeat
mike@0 593 ch := GetChar()
mike@0 594 until (ch = '.') or (ch = ENDFILE);
mike@0 595 token := DOT
mike@0 596 end
mike@0 597 end;
mike@0 598
mike@0 599 (* |Scan| -- read one symbol from |infile| into |token|. *)
mike@0 600 proc Scan();
mike@0 601 var ch, ch2: char; i: integer;
mike@0 602 begin
mike@0 603 ch := GetChar(); token := 0;
mike@0 604 while token = 0 do
mike@0 605 (* Loop after white-space or comment *)
mike@0 606 if ch = ENDFILE then
mike@0 607 token := EOFTOK
mike@0 608 elsif (ch = ' ') or (ch = TAB) or (ch = ENDLINE) then
mike@0 609 ch := GetChar()
mike@0 610 elsif ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) then
mike@0 611 if (((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) then
mike@0 612 token := VARIABLE
mike@0 613 else
mike@0 614 token := IDENT
mike@0 615 end;
mike@0 616 i := 0;
mike@0 617 while ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) or ((ch >= '0') and (ch <= '9')) do
mike@0 618 if i > MAXSTRING then
mike@0 619 newline(); print_string("Panic: "); print_string("identifier too long"); newline(); exit(2)
mike@0 620 end;
mike@0 621 toksval[i] := ch; ch := GetChar(); i := i+1
mike@0 622 end;
mike@0 623 PushBack(ch);
mike@0 624 toksval[i] := ENDSTR; tokval := Lookup(toksval);
mike@0 625 if tokval = notsym then token := NEGATE end
mike@0 626 elsif ((ch >= '0') and (ch <= '9')) then
mike@0 627 token := NUMBER; tokival := 0;
mike@0 628 while ((ch >= '0') and (ch <= '9')) do
mike@0 629 tokival := 10 * tokival + (ord(ch) - ord('0'));
mike@0 630 ch := GetChar()
mike@0 631 end;
mike@0 632 PushBack(ch)
mike@0 633 else
mike@0 634 case ch of
mike@0 635 '(': token := LPAR
mike@0 636 | ')': token := RPAR
mike@0 637 | ',': token := COMMA
mike@0 638 | '.': token := DOT
mike@0 639 | '=': token := EQUAL
mike@0 640 | '<': token := LANGLE
mike@0 641 | '>': token := RANGLE
mike@0 642 | '#': token := HASH
mike@0 643 | '!': token := IDENT; tokval := cutsym
mike@0 644 | '/':
mike@0 645 ch := GetChar();
mike@0 646 if ch <> '*' then
mike@0 647 if not errflag then ShowError(); print_string("bad token /"); newline(); Recover() end
mike@0 648 else
mike@0 649 ch2 := ' '; ch := GetChar();
mike@0 650 while (ch <> ENDFILE) and not ((ch2 = '*') and (ch = '/')) do
mike@0 651 ch2 := ch; ch := GetChar()
mike@0 652 end;
mike@0 653 if ch = ENDFILE then
mike@0 654 if not errflag then ShowError(); print_string("end of file in comment"); newline(); Recover() end
mike@0 655 else
mike@0 656 ch := GetChar()
mike@0 657 end
mike@0 658 end
mike@0 659 | ':':
mike@0 660 ch := GetChar();
mike@0 661 if ch = '-' then
mike@0 662 token := ARROW
mike@0 663 else
mike@0 664 PushBack(ch); token := COLON
mike@0 665 end
mike@0 666 | '''':
mike@0 667 token := CHCON; tokival := ord(GetChar()); ch := GetChar();
mike@0 668 if ch <> '''' then if not errflag then ShowError(); print_string("missing quote"); newline(); Recover() end end
mike@0 669 | '"':
mike@0 670 token := STRCON; i := 0; ch := GetChar();
mike@0 671 while (ch <> '"') and (ch <> ENDLINE) do
mike@0 672 toksval[i] := ch; ch := GetChar(); i := i+1
mike@0 673 end;
mike@0 674 toksval[i] := ENDSTR;
mike@0 675 if ch = ENDLINE then
mike@0 676 if not errflag then ShowError(); print_string("unterminated string"); newline(); Recover() end;
mike@0 677 PushBack(ch)
mike@0 678 end
mike@0 679 else
mike@0 680 if not errflag then ShowError(); print_string("illegal character"); newline(); Recover() end; print_char(ch); newline()
mike@0 681 end
mike@0 682 end
mike@0 683 end
mike@0 684 end;
mike@0 685
mike@0 686 (* |PrintToken| -- print a token as a string *)
mike@0 687 proc PrintToken(t: integer);
mike@0 688 begin
mike@0 689 case t of
mike@0 690 IDENT:
mike@0 691 print_string("identifier "); WriteString(symtab[tokval].name)
mike@0 692 | VARIABLE:
mike@0 693 print_string("variable "); WriteString(symtab[tokval].name)
mike@0 694 | NUMBER: print_string("number");
mike@0 695 | CHCON: print_string("char constant");
mike@0 696 | ARROW: print_string(":-");
mike@0 697 | LPAR: print_string("(");
mike@0 698 | RPAR: print_string(")");
mike@0 699 | COMMA: print_string(",");
mike@0 700 | DOT: print_string(".");
mike@0 701 | COLON: print_string(":");
mike@0 702 | EQUAL: print_string("=");
mike@0 703 | STRCON: print_string("string constant")
mike@0 704 | LANGLE: print_string("<")
mike@0 705 | RANGLE: print_string(">")
mike@0 706 | HASH: print_string("#")
mike@0 707 else
mike@0 708 print_string("unknown token")
mike@0 709 end
mike@0 710 end;
mike@0 711
mike@0 712 var
mike@0 713 nvars: integer; (* no. of variables so far *)
mike@0 714 vartable: array MAXARITY+1 of symbol; (* names of the variables *)
mike@0 715
mike@0 716 (* |VarRep| -- look up a variable name *)
mike@0 717 proc VarRep(name: symbol): term;
mike@0 718 var i: integer;
mike@0 719 begin
mike@0 720 if nvars = MAXARITY then newline(); print_string("Panic: "); print_string("too many variables"); newline(); exit(2) end;
mike@0 721 i := 1; vartable[nvars+1] := name; (* sentinel *)
mike@0 722 while name <> vartable[i] do i := i+1 end;
mike@0 723 if i = nvars+1 then nvars := nvars+1 end;
mike@0 724 return MakeRef(i)
mike@0 725 end;
mike@0 726
mike@0 727 (* |ShowAnswer| -- display answer and get response *)
mike@0 728 proc ShowAnswer(bindings: frame);
mike@0 729 var i: integer; ch, ch2: char;
mike@0 730 begin
mike@0 731 if nvars = 0 then
mike@0 732 print_string("yes"); newline()
mike@0 733 else
mike@0 734 for i := 1 to nvars do
mike@0 735 WriteString(symtab[vartable[i]].name); print_string(" = ");
mike@0 736 PrintTerm((bindings+7+(i-1)*TERM_SIZE), NULL, EQPRIO-1);
mike@0 737 newline()
mike@0 738 end
mike@0 739 end
mike@0 740 end;
mike@0 741
mike@0 742 (* |Eat| -- check for an expected token and discard it *)
mike@0 743 proc Eat(expected: integer);
mike@0 744 begin
mike@0 745 if token = expected then
mike@0 746 if token <> DOT then Scan() end
mike@0 747 elsif not errflag then
mike@0 748 ShowError();
mike@0 749 print_string("expected "); PrintToken(expected);
mike@0 750 print_string(", found "); PrintToken(token); newline();
mike@0 751 Recover()
mike@0 752 end
mike@0 753 end;
mike@0 754
mike@0 755 (* |ParseCompound| -- parse a compound term *)
mike@0 756 proc ParseCompound(): term;
mike@0 757 var fun: symbol; arg: argbuf; n: integer;
mike@0 758 begin
mike@0 759 fun := tokval; n := 0; Eat(IDENT);
mike@0 760 if token = LPAR then
mike@0 761 Eat(LPAR); n := 1; arg[1] := ParseTerm();
mike@0 762 while token = COMMA do
mike@0 763 Eat(COMMA); n := n+1; arg[n] := ParseTerm()
mike@0 764 end;
mike@0 765 Eat(RPAR)
mike@0 766 end;
mike@0 767 if symtab[fun].arity = -1 then
mike@0 768 symtab[fun].arity := n
mike@0 769 elsif symtab[fun].arity <> n then
mike@0 770 if not errflag then ShowError(); print_string("wrong number of args"); newline(); Recover() end
mike@0 771 end;
mike@0 772 return MakeCompound(fun, arg)
mike@0 773 end;
mike@0 774
mike@0 775 (* |ParsePrimary| -- parse a primary *)
mike@0 776 proc ParsePrimary(): term;
mike@0 777 var t: term;
mike@0 778 begin
mike@0 779 if token = IDENT then t := ParseCompound()
mike@0 780 elsif token = VARIABLE then
mike@0 781 t := VarRep(tokval); Eat(VARIABLE)
mike@0 782 elsif token = NUMBER then
mike@0 783 t := MakeInt(tokival); Eat(NUMBER)
mike@0 784 elsif token = CHCON then
mike@0 785 t := MakeChar(chr(tokival)); Eat(CHCON)
mike@0 786 elsif token = STRCON then
mike@0 787 t := MakeString(toksval); Eat(STRCON)
mike@0 788 elsif token = LPAR then
mike@0 789 Eat(LPAR); t := ParseTerm(); Eat(RPAR)
mike@0 790 elsif token = LANGLE then
mike@0 791 t := ParseNode()
mike@0 792 else
mike@0 793 if not errflag then ShowError(); print_string("expected a term"); newline(); Recover() end; t := NULL
mike@0 794 end;
mike@0 795 return t
mike@0 796 end;
mike@0 797
mike@0 798 (* |ParseNode| -- parse an optree node *)
mike@0 799 proc ParseNode(): term;
mike@0 800 var tag, kids: term;
mike@0 801 begin
mike@0 802 Eat(LANGLE);
mike@0 803 tag := ParseTerm();
mike@0 804 kids := ParseKids();
mike@0 805 Eat(RANGLE);
mike@0 806 return MakeNode(node, tag, kids)
mike@0 807 end;
mike@0 808
mike@0 809 (* |ParseKids| -- parse children of an optree node *)
mike@0 810 proc ParseKids(): term;
mike@0 811 var head, tail: term;
mike@0 812 begin
mike@0 813 if token <> COMMA then
mike@0 814 return MakeNode(nilsym, NULL, NULL)
mike@0 815 else
mike@0 816 Eat(COMMA);
mike@0 817 head := ParseTerm();
mike@0 818 tail := ParseKids();
mike@0 819 return MakeNode(cons, head, tail)
mike@0 820 end
mike@0 821 end;
mike@0 822
mike@0 823 (* |ParseFactor| -- parse a factor *)
mike@0 824 proc ParseFactor(): term;
mike@0 825 var t: term;
mike@0 826 begin
mike@0 827 t := ParsePrimary();
mike@0 828 if token <> COLON then
mike@0 829 return t
mike@0 830 else
mike@0 831 Eat(COLON);
mike@0 832 return MakeNode(cons, t, ParseFactor())
mike@0 833 end
mike@0 834 end;
mike@0 835
mike@0 836 (* |ParseTerm| -- parse a term *)
mike@0 837 proc ParseTerm(): term;
mike@0 838 var t: term;
mike@0 839 begin
mike@0 840 t := ParseFactor();
mike@0 841 if token <> EQUAL then
mike@0 842 return t
mike@0 843 else
mike@0 844 Eat(EQUAL);
mike@0 845 return MakeNode(eqsym, t, ParseFactor())
mike@0 846 end
mike@0 847 end;
mike@0 848
mike@0 849 (* |CheckAtom| -- check that a literal is a compound term *)
mike@0 850 proc CheckAtom(a: term);
mike@0 851 begin
mike@0 852 if lsr(mem[a], 8) <> FUNC then
mike@0 853 if not errflag then ShowError(); print_string("literal must be a compound term"); newline(); Recover() end
mike@0 854 end
mike@0 855 end;
mike@0 856
mike@0 857 (* |ParseClause| -- parse a clause *)
mike@0 858 proc ParseClause(): clause;
mike@0 859 var head, t: term;
mike@0 860 body: argbuf;
mike@0 861 n: integer;
mike@0 862 minus, more: boolean;
mike@0 863 begin
mike@0 864 if token = HASH then
mike@0 865 Eat(HASH); head := NULL
mike@0 866 else
mike@0 867 head := ParseTerm();
mike@0 868 CheckAtom(head)
mike@0 869 end;
mike@0 870 Eat(ARROW);
mike@0 871 n := 0;
mike@0 872 if token <> DOT then
mike@0 873 more := true;
mike@0 874 while more do
mike@0 875 n := n+1; minus := false;
mike@0 876 if token = NEGATE then
mike@0 877 Eat(NEGATE); minus := true
mike@0 878 end;
mike@0 879 t := ParseTerm(); CheckAtom(t);
mike@0 880 if minus then
mike@0 881 body[n] := MakeNode(notsym, t, NULL)
mike@0 882 else
mike@0 883 body[n] := t
mike@0 884 end;
mike@0 885 if token = COMMA then Eat(COMMA) else more := false end
mike@0 886 end
mike@0 887 end;
mike@0 888 Eat(DOT);
mike@0 889
mike@0 890 if errflag then
mike@0 891 return NULL
mike@0 892 else
mike@0 893 return MakeClause(nvars, head, body, n)
mike@0 894 end
mike@0 895 end;
mike@0 896
mike@0 897 (* |ReadClause| -- read a clause from |infile| *)
mike@0 898 proc ReadClause(): clause;
mike@0 899 var c: clause;
mike@0 900 begin
mike@0 901 repeat
mike@0 902 hp := hmark; nvars := 0; errflag := false;
mike@0 903 Scan();
mike@0 904 if token = EOFTOK then
mike@0 905 c := NULL
mike@0 906 else
mike@0 907 c := ParseClause()
mike@0 908 end
mike@0 909 until (not errflag) or (token = EOFTOK);
mike@0 910 return c
mike@0 911 end;
mike@0 912
mike@0 913 type trail = ptr;
mike@0 914
mike@0 915 const TRAIL_SIZE = 3;
mike@0 916
mike@0 917 var trhead: trail; (* start of the trail *)
mike@0 918
mike@0 919 (* |Save| -- add a variable to the trail if it is critical *)
mike@0 920 proc Save(v: term);
mike@0 921 var p: trail;
mike@0 922 begin
mike@0 923 if ((v < choice) or (v >= mem[choice+4])) then
mike@0 924 p := GloAlloc(UNDO, TRAIL_SIZE);
mike@0 925 mem[p+1] := v; mem[p+2] := trhead; trhead := p
mike@0 926 end
mike@0 927 end;
mike@0 928
mike@0 929 (* |Restore| -- undo bindings back to previous state *)
mike@0 930 proc Restore();
mike@0 931 var v: term;
mike@0 932 begin
mike@0 933 while (trhead <> mem[choice+5]) do
mike@0 934 v := mem[trhead+1];
mike@0 935 if v <> NULL then mem[v+1] := NULL end;
mike@0 936 trhead := mem[trhead+2]
mike@0 937 end
mike@0 938 end;
mike@0 939
mike@0 940 (* |Commit| -- blank out trail entries not needed after cut *)
mike@0 941 proc Commit();
mike@0 942 var p: trail;
mike@0 943 begin
mike@0 944 p := trhead;
mike@0 945 while (p <> NULL) and (p < mem[choice+4]) do
mike@0 946 if (mem[p+1] <> NULL) and not ((mem[p+1] < choice) or (mem[p+1] >= mem[choice+4])) then
mike@0 947 mem[p+1] := NULL
mike@0 948 end;
mike@0 949 p := mem[p+2]
mike@0 950 end
mike@0 951 end;
mike@0 952
mike@0 953 (* |GloCopy| -- copy a term onto the global stack *)
mike@0 954 proc GloCopy(t: term; e: frame): term;
mike@0 955 var tt: term; i, n: integer;
mike@0 956 begin
mike@0 957 t := Deref(t, e);
mike@0 958 if (t >= gsp) then
mike@0 959 return t
mike@0 960 else
mike@0 961 case lsr(mem[t], 8) of
mike@0 962 FUNC:
mike@0 963 n := symtab[mem[t+1]].arity;
mike@0 964 if (t <= hp) and (n = 0) then
mike@0 965 return t
mike@0 966 else
mike@0 967 tt := GloAlloc(FUNC, TERM_SIZE+n);
mike@0 968 mem[tt+1] := mem[t+1];
mike@0 969 for i := 1 to n do
mike@0 970 mem[tt+i+1] := GloCopy(mem[t+i+1], e)
mike@0 971 end;
mike@0 972 return tt
mike@0 973 end
mike@0 974 | CELL:
mike@0 975 tt := GloAlloc(CELL, TERM_SIZE);
mike@0 976 mem[tt+1] := NULL;
mike@0 977 Save(t); mem[t+1] := tt;
mike@0 978 return tt
mike@0 979 else
mike@0 980 return t
mike@0 981 end
mike@0 982 end
mike@0 983 end;
mike@0 984
mike@0 985 (* |Share| -- bind two variables together *)
mike@0 986 proc Share(v1, v2: term);
mike@0 987 begin
mike@0 988 if (v1 * (2 * ord((v1 >= gsp)) - 1)) <= (v2 * (2 * ord((v2 >= gsp)) - 1)) then
mike@0 989 Save(v1); mem[v1+1] := v2
mike@0 990 else
mike@0 991 Save(v2); mem[v2+1] := v1
mike@0 992 end
mike@0 993 end;
mike@0 994
mike@0 995 (* |Unify| -- find and apply unifier for two terms *)
mike@0 996 proc Unify(t1: term; e1: frame; t2: term; e2: frame): boolean;
mike@0 997 var i: integer; match: boolean;
mike@0 998 begin
mike@0 999 t1 := Deref(t1, e1); t2 := Deref(t2, e2);
mike@0 1000 if t1 = t2 then (* Includes unifying a var with itself *)
mike@0 1001 return true
mike@0 1002 elsif (lsr(mem[t1], 8) = CELL) and (lsr(mem[t2], 8) = CELL) then
mike@0 1003 Share(t1, t2); return true
mike@0 1004 elsif lsr(mem[t1], 8) = CELL then
mike@0 1005 Save(t1); mem[t1+1] := GloCopy(t2, e2); return true
mike@0 1006 elsif lsr(mem[t2], 8) = CELL then
mike@0 1007 Save(t2); mem[t2+1] := GloCopy(t1, e1); return true
mike@0 1008 elsif lsr(mem[t1], 8) <> lsr(mem[t2], 8) then
mike@0 1009 return false
mike@0 1010 else
mike@0 1011 case lsr(mem[t1], 8) of
mike@0 1012 FUNC:
mike@0 1013 if (mem[t1+1] <> mem[t2+1]) then
mike@0 1014 return false
mike@0 1015 else
mike@0 1016 i := 1; match := true;
mike@0 1017 while match and (i <= symtab[mem[t1+1]].arity) do
mike@0 1018 match := Unify(mem[t1+i+1], e1, mem[t2+i+1], e2);
mike@0 1019 i := i+1
mike@0 1020 end;
mike@0 1021 return match
mike@0 1022 end
mike@0 1023 | INT:
mike@0 1024 return (mem[t1+1] = mem[t2+1])
mike@0 1025 | CHRCTR:
mike@0 1026 return (mem[t1+1] = mem[t2+1])
mike@0 1027 else
mike@0 1028 newline(); print_string("Panic: "); print_string("bad tag" (*t_kind(t1):1, " in ", "Unify"*)); newline(); exit(2)
mike@0 1029 end
mike@0 1030 end
mike@0 1031 end;
mike@0 1032
mike@0 1033 (* |Key| -- unification key of a term *)
mike@0 1034 proc Key(t: term; e: frame): integer;
mike@0 1035 var t0: term;
mike@0 1036 begin
mike@0 1037 (* The argument |t| must be a direct pointer to a compound term.
mike@0 1038 The value returned is |key(t)|: if |t1| and |t2| are unifiable,
mike@0 1039 then |key(t1) = 0| or |key(t2) = 0| or |key(t1) = key(t2)|. *)
mike@0 1040
mike@0 1041 if t = NULL then newline(); print_string("Panic: "); print_string("Key"); newline(); exit(2) end;
mike@0 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;
mike@0 1043
mike@0 1044 if symtab[mem[t+1]].arity = 0 then
mike@0 1045 return 0
mike@0 1046 else
mike@0 1047 t0 := Deref(mem[t+1+1], e);
mike@0 1048 case lsr(mem[t0], 8) of
mike@0 1049 FUNC: return mem[t0+1]
mike@0 1050 | INT: return mem[t0+1] + 1
mike@0 1051 | CHRCTR: return mem[t0+1] + 1
mike@0 1052 else
mike@0 1053 return 0
mike@0 1054 end
mike@0 1055 end
mike@0 1056 end;
mike@0 1057
mike@0 1058 (* |Search| -- find the first clause that might match *)
mike@0 1059 proc Search(t: term; e: frame; p: clause): clause;
mike@0 1060 var k: integer;
mike@0 1061 begin
mike@0 1062 k := Key(t, e);
mike@0 1063 if k <> 0 then
mike@0 1064 while (p <> NULL) and (mem[p+1] <> 0) and (mem[p+1] <> k) do
mike@0 1065 p := mem[p+2]
mike@0 1066 end
mike@0 1067 end;
mike@0 1068 return p
mike@0 1069 end;
mike@0 1070
mike@0 1071 var ok: boolean; (* whether execution succeeded *)
mike@0 1072
mike@0 1073 (* |PushFrame| -- create a new local stack frame *)
mike@0 1074 proc PushFrame(nvars: integer; retry: clause);
mike@0 1075 var f: frame; i: integer;
mike@0 1076 begin
mike@0 1077 f := LocAlloc((FRAME_SIZE + (nvars)*TERM_SIZE));
mike@0 1078 mem[f] := current; mem[f+1] := goalframe;
mike@0 1079 mem[f+2] := retry; mem[f+3] := choice;
mike@0 1080 mem[f+4] := gsp; mem[f+5] := trhead;
mike@0 1081 mem[f+6] := nvars;
mike@0 1082 for i := 1 to nvars do
mike@0 1083 mem[(f+7+(i-1)*TERM_SIZE)] := lsl(CELL, 8) + TERM_SIZE;
mike@0 1084 mem[(f+7+(i-1)*TERM_SIZE)+1] := NULL
mike@0 1085 end;
mike@0 1086 goalframe := f;
mike@0 1087 if retry <> NULL then choice := goalframe end
mike@0 1088 end;
mike@0 1089
mike@0 1090 (* |TroStep| -- perform a resolution step with tail-recursion *)
mike@0 1091 proc TroStep();
mike@0 1092 var temp: frame; oldsize, newsize, i: integer;
mike@0 1093 begin
mike@0 1094 if dflag then print_string("(TRO)"); newline() end;
mike@0 1095
mike@0 1096 oldsize := (FRAME_SIZE + (mem[goalframe+6])*TERM_SIZE); (* size of old frame *)
mike@0 1097 newsize := (FRAME_SIZE + (mem[prok])*TERM_SIZE); (* size of new frame *)
mike@0 1098 temp := LocAlloc(newsize);
mike@0 1099 temp := goalframe + newsize; (* copy old frame here *)
mike@0 1100
mike@0 1101 (* Copy the old frame: in reverse order in case of overlap *)
mike@0 1102 for i := 1 to oldsize do
mike@0 1103 mem[temp+oldsize-i] := mem[goalframe+oldsize-i]
mike@0 1104 end;
mike@0 1105
mike@0 1106 (* Adjust internal pointers in the copy *)
mike@0 1107 for i := 1 to mem[goalframe+6] do
mike@0 1108 if (lsr(mem[(temp+7+(i-1)*TERM_SIZE)], 8) = CELL)
mike@0 1109 and (mem[(temp+7+(i-1)*TERM_SIZE)+1] <> NULL)
mike@0 1110 and (goalframe <= mem[(temp+7+(i-1)*TERM_SIZE)+1])
mike@0 1111 and (mem[(temp+7+(i-1)*TERM_SIZE)+1] < goalframe + oldsize) then
mike@0 1112 mem[(temp+7+(i-1)*TERM_SIZE)+1] := mem[(temp+7+(i-1)*TERM_SIZE)+1] + newsize
mike@0 1113 end
mike@0 1114 end;
mike@0 1115
mike@0 1116 (* Overwrite the old frame with the new one *)
mike@0 1117 mem[goalframe+6] := mem[prok];
mike@0 1118 for i := 1 to mem[goalframe+6] do
mike@0 1119 mem[(goalframe+7+(i-1)*TERM_SIZE)] := lsl(CELL, 8) + TERM_SIZE;
mike@0 1120 mem[(goalframe+7+(i-1)*TERM_SIZE)+1] := NULL
mike@0 1121 end;
mike@0 1122
mike@0 1123 (* Perform the resolution step *)
mike@0 1124 ok := Unify(call, temp, mem[prok+3], goalframe);
mike@0 1125 current := (prok+4);
mike@0 1126 lsp := temp-1
mike@0 1127 end;
mike@0 1128
mike@0 1129 (* |Step| -- perform a resolution step *)
mike@0 1130 proc Step();
mike@0 1131 var retry: clause;
mike@0 1132 begin
mike@0 1133 if symtab[mem[call+1]].action <> 0 then
mike@0 1134 ok := DoBuiltin(symtab[mem[call+1]].action)
mike@0 1135 elsif prok = NULL then
mike@0 1136 ok := false
mike@0 1137 else
mike@0 1138 retry := Search(call, goalframe, mem[prok+2]);
mike@0 1139 if (mem[(current)+1] = NULL) and (choice < goalframe)
mike@0 1140 and (retry = NULL) and (goalframe <> base) then
mike@0 1141 TroStep()
mike@0 1142 else
mike@0 1143 PushFrame(mem[prok], retry);
mike@0 1144 ok := Unify(call, mem[goalframe+1], mem[prok+3], goalframe);
mike@0 1145 current := (prok+4);
mike@0 1146 end
mike@0 1147 end
mike@0 1148 end;
mike@0 1149
mike@0 1150 (* |Unwind| -- return from completed clauses *)
mike@0 1151 proc Unwind();
mike@0 1152 begin
mike@0 1153 while (mem[current] = NULL) and (goalframe <> base) do
mike@0 1154 if dflag then
mike@0 1155 print_string("Exit"); print_string(": ");
mike@0 1156 PrintTerm(mem[mem[goalframe]], mem[goalframe+1], MAXPRIO); newline()
mike@0 1157 end;
mike@0 1158 current := (mem[goalframe])+1;
mike@0 1159 if goalframe > choice then lsp := goalframe-1 end;
mike@0 1160 goalframe := mem[goalframe+1]
mike@0 1161 end
mike@0 1162 end;
mike@0 1163
mike@0 1164 (* |Backtrack| -- roll back to the last choice-point *)
mike@0 1165 proc Backtrack();
mike@0 1166 begin
mike@0 1167 Restore();
mike@0 1168 current := mem[choice]; goalframe := mem[choice+1];
mike@0 1169 call := Deref(mem[current], goalframe);
mike@0 1170 prok := mem[choice+2]; gsp := mem[choice+4];
mike@0 1171 lsp := choice-1; choice := mem[choice+3];
mike@0 1172 if dflag then
mike@0 1173 print_string("Redo"); print_string(": ");
mike@0 1174 PrintTerm(call, goalframe, MAXPRIO); newline()
mike@0 1175 end;
mike@0 1176 end;
mike@0 1177
mike@0 1178 (* |Resume| -- continue execution *)
mike@0 1179 proc Resume();
mike@0 1180 begin
mike@0 1181 while run do
mike@0 1182 if ok then
mike@0 1183 if mem[current] = NULL then return end;
mike@0 1184 call := Deref(mem[current], goalframe);
mike@0 1185 if dflag then
mike@0 1186 print_string("Call"); print_string(": ");
mike@0 1187 PrintTerm(call, goalframe, MAXPRIO); newline()
mike@0 1188 end;
mike@0 1189 if (symtab[mem[call+1]].prok = NULL)
mike@0 1190 and (symtab[mem[call+1]].action = 0) then
mike@0 1191 newline(); print_string("Error: "); print_string("call to undefined relation "); run := false;
mike@0 1192 WriteString(symtab[mem[call+1]].name);
mike@0 1193 return
mike@0 1194 end;
mike@0 1195 prok := Search(call, goalframe, symtab[mem[call+1]].prok)
mike@0 1196 else
mike@0 1197 if choice <= base then return end;
mike@0 1198 Backtrack()
mike@0 1199 end;
mike@0 1200 Step();
mike@0 1201 if ok then Unwind() end;
mike@0 1202 end;
mike@0 1203 end;
mike@0 1204
mike@0 1205 (* |Execute| -- solve a goal by SLD-resolution *)
mike@0 1206 proc Execute(g: clause);
mike@0 1207 var nsoln: integer;
mike@0 1208 begin
mike@0 1209 lsp := hp; gsp := MEMSIZE+1;
mike@0 1210 current := NULL; goalframe := NULL; choice := NULL; trhead := NULL;
mike@0 1211 PushFrame(mem[g], NULL);
mike@0 1212 choice := goalframe; base := goalframe; current := (g+4);
mike@0 1213 run := true; ok := true;
mike@0 1214 Resume();
mike@0 1215 if not run then return end;
mike@0 1216 while ok do
mike@0 1217 nsoln := nsoln+1;
mike@0 1218 ShowAnswer(base);
mike@0 1219 newline();
mike@0 1220 ok := false;
mike@0 1221 Resume();
mike@0 1222 if not run then return end;
mike@0 1223 end;
mike@0 1224
mike@0 1225 if nsoln = 0 then
mike@0 1226 print_string("no"); newline(); newline();
mike@0 1227 end
mike@0 1228 end;
mike@0 1229
mike@0 1230 var
mike@0 1231 av: argbuf; (* |GetArgs| puts arguments here *)
mike@0 1232 callbody: ptr; (* dummy clause body used by |call/1| *)
mike@0 1233
mike@0 1234 (* |GetArgs| -- set up |av| array *)
mike@0 1235 proc GetArgs();
mike@0 1236 var i: integer;
mike@0 1237 begin
mike@0 1238 for i := 1 to symtab[mem[call+1]].arity do
mike@0 1239 av[i] := Deref(mem[call+i+1], goalframe)
mike@0 1240 end
mike@0 1241 end;
mike@0 1242
mike@0 1243 proc NewInt(n: integer): term;
mike@0 1244 var t: term;
mike@0 1245 begin
mike@0 1246 t := GloAlloc(INT, TERM_SIZE);
mike@0 1247 mem[t+1] := n;
mike@0 1248 return t
mike@0 1249 end;
mike@0 1250
mike@0 1251 (* |DoCut| -- built-in relation !/0 *)
mike@0 1252 proc DoCut(): boolean;
mike@0 1253 begin
mike@0 1254 choice := mem[goalframe+3];
mike@0 1255 lsp := goalframe + (FRAME_SIZE + (mem[goalframe+6])*TERM_SIZE) - 1;
mike@0 1256 Commit();
mike@0 1257 current := (current)+1;
mike@0 1258 return true
mike@0 1259 end;
mike@0 1260
mike@0 1261 (* |DoCall| -- built-in relation |call/1| *)
mike@0 1262 proc DoCall(): boolean;
mike@0 1263 begin
mike@0 1264 GetArgs();
mike@0 1265 if not (lsr(mem[av[1]], 8) = FUNC) then
mike@0 1266 newline(); print_string("Error: "); print_string("bad argument to call/1"); run := false;
mike@0 1267 return false
mike@0 1268 else
mike@0 1269 PushFrame(1, NULL);
mike@0 1270 mem[(goalframe+7+(1-1)*TERM_SIZE)+1] :=
mike@0 1271 GloCopy(av[1], mem[goalframe+1]);
mike@0 1272 current := callbody;
mike@0 1273 return true
mike@0 1274 end
mike@0 1275 end;
mike@0 1276
mike@0 1277 (* |DoNot| -- built-in relation |not/1| *)
mike@0 1278 proc DoNot(): boolean;
mike@0 1279 var savebase: frame;
mike@0 1280 begin
mike@0 1281 GetArgs();
mike@0 1282 if not (lsr(mem[av[1]], 8) = FUNC) then
mike@0 1283 newline(); print_string("Error: "); print_string("bad argument to call/1"); run := false;
mike@0 1284 return false
mike@0 1285 else
mike@0 1286 PushFrame(1, NULL);
mike@0 1287 savebase := base; base := goalframe; choice := goalframe;
mike@0 1288 mem[(goalframe+7+(1-1)*TERM_SIZE)+1] :=
mike@0 1289 GloCopy(av[1], mem[goalframe+1]);
mike@0 1290 current := callbody; ok := true;
mike@0 1291 Resume();
mike@0 1292 choice := mem[base+3]; goalframe := mem[base+1];
mike@0 1293 if not ok then
mike@0 1294 current := (mem[base])+1;
mike@0 1295 return true
mike@0 1296 else
mike@0 1297 Commit();
mike@0 1298 return false
mike@0 1299 end;
mike@0 1300 lsp := base-1; base := savebase
mike@0 1301 end
mike@0 1302 end;
mike@0 1303
mike@0 1304 (* |DoPlus| -- built-in relation |plus/3| *)
mike@0 1305 proc DoPlus(): boolean;
mike@0 1306 var result: boolean;
mike@0 1307 begin
mike@0 1308 GetArgs();
mike@0 1309 result := false;
mike@0 1310 if (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[2]], 8) = INT) then
mike@0 1311 result := Unify(av[3], goalframe, NewInt(mem[av[1]+1] + mem[av[2]+1]), NULL)
mike@0 1312 elsif (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
mike@0 1313 if mem[av[1]+1] <= mem[av[3]+1] then
mike@0 1314 result := Unify(av[2], goalframe,
mike@0 1315 NewInt(mem[av[3]+1] - mem[av[1]+1]), NULL)
mike@0 1316 end
mike@0 1317 elsif (lsr(mem[av[2]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
mike@0 1318 if mem[av[2]+1] <= mem[av[3]+1] then
mike@0 1319 result := Unify(av[1], goalframe, NewInt(mem[av[3]+1] - mem[av[2]+1]), NULL)
mike@0 1320 end
mike@0 1321 else
mike@0 1322 newline(); print_string("Error: "); print_string("plus/3 needs at least two integers"); run := false
mike@0 1323 end;
mike@0 1324 current := (current)+1;
mike@0 1325 return result
mike@0 1326 end;
mike@0 1327
mike@0 1328 (* |DoTimes| -- built-in relation |times/3| *)
mike@0 1329 proc DoTimes(): boolean;
mike@0 1330 var result: boolean;
mike@0 1331 begin
mike@0 1332 GetArgs();
mike@0 1333 result := false;
mike@0 1334 if (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[2]], 8) = INT) then
mike@0 1335 result := Unify(av[3], goalframe,
mike@0 1336 NewInt(mem[av[1]+1] * mem[av[2]+1]), NULL)
mike@0 1337 elsif (lsr(mem[av[1]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
mike@0 1338 if mem[av[1]+1] <> 0 then
mike@0 1339 if mem[av[3]+1] mod mem[av[1]+1] = 0 then
mike@0 1340 result := Unify(av[2], goalframe,
mike@0 1341 NewInt(mem[av[3]+1] div mem[av[1]+1]), NULL)
mike@0 1342 end
mike@0 1343 end
mike@0 1344 elsif (lsr(mem[av[2]], 8) = INT) and (lsr(mem[av[3]], 8) = INT) then
mike@0 1345 if mem[av[2]+1] <> 0 then
mike@0 1346 if mem[av[3]+1] mod mem[av[2]+1] = 0 then
mike@0 1347 result := Unify(av[1], goalframe,
mike@0 1348 NewInt(mem[av[3]+1] div mem[av[2]+1]), NULL)
mike@0 1349 end
mike@0 1350 end
mike@0 1351 else
mike@0 1352 newline(); print_string("Error: "); print_string("times/3 needs at least two integers"); run := false
mike@0 1353 end;
mike@0 1354 current := (current)+1;
mike@0 1355 return result
mike@0 1356 end;
mike@0 1357
mike@0 1358 (* |DoEqual| -- built-in relation |=/2| *)
mike@0 1359 proc DoEqual(): boolean;
mike@0 1360 begin
mike@0 1361 GetArgs();
mike@0 1362 current := (current)+1;
mike@0 1363 return Unify(av[1], goalframe, av[2], goalframe)
mike@0 1364 end;
mike@0 1365
mike@0 1366 (* |DoInteger| -- built-in relation |integer/1| *)
mike@0 1367 proc DoInteger(): boolean;
mike@0 1368 begin
mike@0 1369 GetArgs();
mike@0 1370 current := (current)+1;
mike@0 1371 return (lsr(mem[av[1]], 8) = INT)
mike@0 1372 end;
mike@0 1373
mike@0 1374 (* |DoChar| -- built-in relation |char/1| *)
mike@0 1375 proc DoChar(): boolean;
mike@0 1376 begin
mike@0 1377 GetArgs();
mike@0 1378 current := (current)+1;
mike@0 1379 return (lsr(mem[av[1]], 8) = CHRCTR)
mike@0 1380 end;
mike@0 1381
mike@0 1382 (* |DoPrint| -- built-in relation |print/1| *)
mike@0 1383 proc DoPrint(): boolean;
mike@0 1384 begin
mike@0 1385 GetArgs();
mike@0 1386 PrintTerm(av[1], goalframe, MAXPRIO);
mike@0 1387 current := (current)+1;
mike@0 1388 return true
mike@0 1389 end;
mike@0 1390
mike@0 1391 (* |DoNl| -- built-in relation |nl/0| *)
mike@0 1392 proc DoNl(): boolean;
mike@0 1393 begin
mike@0 1394 newline();
mike@0 1395 current := (current)+1;
mike@0 1396 return true
mike@0 1397 end;
mike@0 1398
mike@0 1399 (* |DoBuiltin| -- switch for built-in relations *)
mike@0 1400 proc DoBuiltin(action: integer): boolean;
mike@0 1401 begin
mike@0 1402 case action of
mike@0 1403 CUT: return DoCut()
mike@0 1404 | CALL: return DoCall()
mike@0 1405 | PLUS: return DoPlus()
mike@0 1406 | TIMES: return DoTimes()
mike@0 1407 | ISINT: return DoInteger()
mike@0 1408 | ISCHAR: return DoChar()
mike@0 1409 | NAFF: return DoNot()
mike@0 1410 | EQUALITY: return DoEqual()
mike@0 1411 | FAIL: return false
mike@0 1412 | PRINT: return DoPrint()
mike@0 1413 | NL: return DoNl()
mike@0 1414 else
mike@0 1415 newline(); print_string("Panic: "); print_string("bad tag" (*action:1, " in ", "DoBuiltin"*)); newline(); exit(2)
mike@0 1416 end
mike@0 1417 end;
mike@0 1418
mike@0 1419 (* |Initialize| -- initialize everything *)
mike@0 1420 proc Initialize();
mike@0 1421 var i: integer; p: term;
mike@0 1422 begin
mike@0 1423 dflag := false; errcount := 0;
mike@0 1424 pbchar := ENDFILE; charptr := 0;
mike@0 1425 hp := 0; InitSymbols();
mike@0 1426
mike@0 1427 (* Set up the |refnode| array *)
mike@0 1428 for i := 1 to MAXARITY do
mike@0 1429 p := HeapAlloc(TERM_SIZE);
mike@0 1430 mem[p] := lsl(REF, 8) + TERM_SIZE;
mike@0 1431 mem[p+1] := i; refnode[i] := p
mike@0 1432 end;
mike@0 1433
mike@0 1434 (* The dummy clause $\it call(\sci p) \IF p$ is used by |call/1|. *)
mike@0 1435 callbody := HeapAlloc(2);
mike@0 1436 mem[callbody] := MakeRef(1);
mike@0 1437 mem[(callbody)+1] := NULL
mike@0 1438 end;
mike@0 1439
mike@0 1440 (* |ReadFile| -- read and process clauses from an open file *)
mike@0 1441 proc ReadFile();
mike@0 1442 var c: clause;
mike@0 1443 ch: char;
mike@0 1444 begin
mike@0 1445 lineno := 1;
mike@0 1446 repeat
mike@0 1447 hmark := hp;
mike@0 1448 c := ReadClause();
mike@0 1449 if c <> NULL then
mike@0 1450 if dflag then PrintClause(c) end;
mike@0 1451 if mem[c+3] <> NULL then
mike@0 1452 AddClause(c)
mike@0 1453 else
mike@0 1454 Execute(c);
mike@0 1455 hp := hmark
mike@0 1456 end
mike@0 1457 end
mike@0 1458 until c = NULL
mike@0 1459 end;
mike@0 1460
mike@0 1461 begin (* main program *)
mike@0 1462 prog("subject( ");
mike@0 1463 prog(" <store, ");
mike@0 1464 prog(" <load, ");
mike@0 1465 prog(" <plusa, ");
mike@0 1466 prog(" <global(a)>, ");
mike@0 1467 prog(" <lsl, <load, <local(16)>>, <const(2)>>>>, ");
mike@0 1468 prog(" <local(20)>> ");
mike@0 1469 prog(") :- . ");
mike@0 1470
mike@0 1471 prog("rule(""*str"", stmt, <store, reg, addr>) :- . ");
mike@0 1472 prog("rule(""*ldr"", reg, <load, addr>) :- . ");
mike@0 1473 prog("rule(""*addfp"", reg, <local(N)>) :- . ");
mike@0 1474 prog("rule(""local"", addr, <local(N)>) :- . ");
mike@0 1475 prog("rule(""*add"", reg, <plusa, reg, rand>) :- . ");
mike@0 1476 prog("rule(""index"", addr, <plusa, reg, reg>) :- . ");
mike@0 1477 prog("rule(""scale"", addr, ");
mike@0 1478 prog(" <plusa, reg, <lsl, reg, <const(N)>>>) :- . ");
mike@0 1479 prog("rule(""*global"", reg, <global(X)>) :- . ");
mike@0 1480 prog("rule(""*lsl"", reg, <lsl, reg, rand>) :- . ");
mike@0 1481 prog("rule(""lshiftc"", rand, <lsl, reg, <const(N)>>) :- . ");
mike@0 1482 prog("rule(""lshiftr"", rand, <lsl, reg, reg>) :- . ");
mike@0 1483 prog("rule(""*mov"", reg, <const(N)>) :- . ");
mike@0 1484 prog("rule(""const"", rand, <const(N)>) :- . ");
mike@0 1485 prog("rule(""reg"", rand, reg) :- . ");
mike@0 1486 prog("rule(""indir"", addr, reg) :- . ");
mike@0 1487
mike@0 1488 prog("use_rule(NT, Tree, node(Name, Kids)) :- ");
mike@0 1489 prog(" rule(Name, NT, RHS), match(RHS, Tree, Kids, nil). ");
mike@0 1490
mike@0 1491 prog("match(NT, Tree, Parse:Kids0, Kids0) :- ");
mike@0 1492 prog(" use_rule(NT, Tree, Parse). ");
mike@0 1493
mike@0 1494 prog("match(node(W, PS), node(W, TS), Kids, Kids0) :- ");
mike@0 1495 prog(" matchall(PS, TS, Kids, Kids0). ");
mike@0 1496
mike@0 1497 prog("matchall(nil, nil, Kids0, Kids0) :- . ");
mike@0 1498 prog("matchall(P:PS, T:TS, Kids, Kids0) :- ");
mike@0 1499 prog(" match(P, T, Kids, Kids1), matchall(PS, TS, Kids1, Kids0). ");
mike@0 1500
mike@0 1501 prog("cost(node(X, TS), C) :- ");
mike@0 1502 prog(" opcost(X, A), allcosts(TS, B), plus(A, B, C). ");
mike@0 1503
mike@0 1504 prog("allcosts(nil, 0) :- . ");
mike@0 1505 prog("allcosts(T:TS, C) :- ");
mike@0 1506 prog(" cost(T, A), allcosts(TS, B), plus(A, B, C). ");
mike@0 1507
mike@0 1508 prog("opcost('*':_, 1) :- !. ");
mike@0 1509 prog("opcost(_, 0) :- . ");
mike@0 1510
mike@0 1511 prog("answer(P, C) :- ");
mike@0 1512 prog(" subject(T), use_rule(stmt, T, P), cost(P, C). ");
mike@0 1513
mike@0 1514 prog("min(N, P) :- min1(N, 0, P). ");
mike@0 1515 prog("min1(N, N, P) :- call(P), !. ");
mike@0 1516 prog("min1(N, N0, P) :- plus(N0, 1, N1), min1(N, N1, P). ");
mike@0 1517
mike@0 1518 prog("# :- answer(P, C). ");
mike@0 1519
mike@0 1520 Initialize();
mike@0 1521 ReadFile()
mike@0 1522 end.
mike@0 1523
mike@0 1524 (*<<
mike@0 1525 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"const">>>>, <"local">>
mike@0 1526 C = 5
mike@0 1527
mike@0 1528 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"const">>>>, <"indir", <"*addfp">>>
mike@0 1529 C = 6
mike@0 1530
mike@0 1531 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>, <"local">>
mike@0 1532 C = 6
mike@0 1533
mike@0 1534 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>, <"indir", <"*addfp">>>
mike@0 1535 C = 7
mike@0 1536
mike@0 1537 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>, <"local">>
mike@0 1538 C = 6
mike@0 1539
mike@0 1540 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>, <"indir", <"*addfp">>>
mike@0 1541 C = 7
mike@0 1542
mike@0 1543 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>, <"local">>
mike@0 1544 C = 7
mike@0 1545
mike@0 1546 P = <"*str", <"*ldr", <"index", <"*global">, <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>, <"indir", <"*addfp">>>
mike@0 1547 C = 8
mike@0 1548
mike@0 1549 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"local">>>>, <"local">>
mike@0 1550 C = 4
mike@0 1551
mike@0 1552 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"local">>>>, <"indir", <"*addfp">>>
mike@0 1553 C = 5
mike@0 1554
mike@0 1555 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"indir", <"*addfp">>>>>, <"local">>
mike@0 1556 C = 5
mike@0 1557
mike@0 1558 P = <"*str", <"*ldr", <"scale", <"*global">, <"*ldr", <"indir", <"*addfp">>>>>, <"indir", <"*addfp">>>
mike@0 1559 C = 6
mike@0 1560
mike@0 1561 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"local">>>>>>, <"local">>
mike@0 1562 C = 5
mike@0 1563
mike@0 1564 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"local">>>>>>, <"indir", <"*addfp">>>
mike@0 1565 C = 6
mike@0 1566
mike@0 1567 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"indir", <"*addfp">>>>>>>, <"local">>
mike@0 1568 C = 6
mike@0 1569
mike@0 1570 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftc", <"*ldr", <"indir", <"*addfp">>>>>>>, <"indir", <"*addfp">>>
mike@0 1571 C = 7
mike@0 1572
mike@0 1573 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"local">>, <"*mov">>>>>, <"local">>
mike@0 1574 C = 6
mike@0 1575
mike@0 1576 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"local">>, <"*mov">>>>>, <"indir", <"*addfp">>>
mike@0 1577 C = 7
mike@0 1578
mike@0 1579 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"indir", <"*addfp">>>, <"*mov">>>>>, <"local">>
mike@0 1580 C = 7
mike@0 1581
mike@0 1582 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"lshiftr", <"*ldr", <"indir", <"*addfp">>>, <"*mov">>>>>, <"indir", <"*addfp">>>
mike@0 1583 C = 8
mike@0 1584
mike@0 1585 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"const">>>>>>, <"local">>
mike@0 1586 C = 6
mike@0 1587
mike@0 1588 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"const">>>>>>, <"indir", <"*addfp">>>
mike@0 1589 C = 7
mike@0 1590
mike@0 1591 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>>>, <"local">>
mike@0 1592 C = 7
mike@0 1593
mike@0 1594 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"local">>, <"reg", <"*mov">>>>>>>, <"indir", <"*addfp">>>
mike@0 1595 C = 8
mike@0 1596
mike@0 1597 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>>>, <"local">>
mike@0 1598 C = 7
mike@0 1599
mike@0 1600 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"const">>>>>>, <"indir", <"*addfp">>>
mike@0 1601 C = 8
mike@0 1602
mike@0 1603 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>>>, <"local">>
mike@0 1604 C = 8
mike@0 1605
mike@0 1606 P = <"*str", <"*ldr", <"indir", <"*add", <"*global">, <"reg", <"*lsl", <"*ldr", <"indir", <"*addfp">>>, <"reg", <"*mov">>>>>>>, <"indir", <"*addfp">>>
mike@0 1607 C = 9
mike@0 1608
mike@0 1609 >>*)
mike@0 1610
mike@0 1611 (*[[
mike@0 1612 @ picoPascal compiler output
mike@0 1613 .include "fixup.s"
mike@0 1614 .global pmain
mike@0 1615
mike@0 1616 @ proc StringLength(var s: tempstring): integer;
mike@0 1617 .text
mike@0 1618 _StringLength:
mike@0 1619 mov ip, sp
mike@0 1620 stmfd sp!, {r0-r1}
mike@0 1621 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1622 mov fp, sp
mike@0 1623 @ i := 0;
mike@0 1624 mov r4, #0
mike@0 1625 .L147:
mike@0 1626 @ while s[i] <> ENDSTR do i := i+1 end;
mike@0 1627 ldr r0, [fp, #40]
mike@0 1628 add r0, r0, r4
mike@0 1629 ldrb r0, [r0]
mike@0 1630 cmp r0, #0
mike@0 1631 beq .L149
mike@0 1632 add r4, r4, #1
mike@0 1633 b .L147
mike@0 1634 .L149:
mike@0 1635 @ return i
mike@0 1636 mov r0, r4
mike@0 1637 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1638 .ltorg
mike@0 1639
mike@0 1640 @ proc SaveString(var s: tempstring): permstring;
mike@0 1641 _SaveString:
mike@0 1642 mov ip, sp
mike@0 1643 stmfd sp!, {r0-r1}
mike@0 1644 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1645 mov fp, sp
mike@0 1646 @ if charptr + StringLength(s) + 1 > MAXCHARS then
mike@0 1647 ldr r0, [fp, #40]
mike@0 1648 bl _StringLength
mike@0 1649 set r1, _charptr
mike@0 1650 ldr r1, [r1]
mike@0 1651 add r0, r1, r0
mike@0 1652 add r0, r0, #1
mike@0 1653 cmp r0, #2048
mike@0 1654 ble .L153
mike@0 1655 @ newline(); print_string("Panic: "); print_string("out of string space"); newline(); exit(2)
mike@0 1656 bl newline
mike@0 1657 mov r1, #7
mike@0 1658 set r0, g1
mike@0 1659 bl print_string
mike@0 1660 mov r1, #19
mike@0 1661 set r0, g2
mike@0 1662 bl print_string
mike@0 1663 bl newline
mike@0 1664 mov r0, #2
mike@0 1665 bl exit
mike@0 1666 .L153:
mike@0 1667 @ p := charptr; i := 0;
mike@0 1668 set r0, _charptr
mike@0 1669 ldr r4, [r0]
mike@0 1670 mov r5, #0
mike@0 1671 .L154:
mike@0 1672 @ charbuf[charptr] := s[i]; charptr := charptr+1; i := i+1
mike@0 1673 set r6, _charbuf
mike@0 1674 set r7, _charptr
mike@0 1675 ldr r0, [fp, #40]
mike@0 1676 add r0, r0, r5
mike@0 1677 ldrb r0, [r0]
mike@0 1678 ldr r1, [r7]
mike@0 1679 add r1, r6, r1
mike@0 1680 strb r0, [r1]
mike@0 1681 ldr r0, [r7]
mike@0 1682 add r8, r0, #1
mike@0 1683 str r8, [r7]
mike@0 1684 add r5, r5, #1
mike@0 1685 add r0, r6, r8
mike@0 1686 ldrb r0, [r0, #-1]
mike@0 1687 cmp r0, #0
mike@0 1688 bne .L154
mike@0 1689 @ return p
mike@0 1690 mov r0, r4
mike@0 1691 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1692 .ltorg
mike@0 1693
mike@0 1694 @ proc StringEqual(var s1: tempstring; s2: permstring): boolean;
mike@0 1695 _StringEqual:
mike@0 1696 mov ip, sp
mike@0 1697 stmfd sp!, {r0-r1}
mike@0 1698 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1699 mov fp, sp
mike@0 1700 @ i := 0;
mike@0 1701 mov r4, #0
mike@0 1702 .L157:
mike@0 1703 @ while (s1[i] <> ENDSTR) and (s1[i] = charbuf[s2+i]) do i := i+1 end;
mike@0 1704 ldr r0, [fp, #40]
mike@0 1705 add r0, r0, r4
mike@0 1706 ldrb r5, [r0]
mike@0 1707 cmp r5, #0
mike@0 1708 beq .L159
mike@0 1709 set r0, _charbuf
mike@0 1710 ldr r1, [fp, #44]
mike@0 1711 add r0, r0, r1
mike@0 1712 add r0, r0, r4
mike@0 1713 ldrb r0, [r0]
mike@0 1714 cmp r5, r0
mike@0 1715 bne .L159
mike@0 1716 add r4, r4, #1
mike@0 1717 b .L157
mike@0 1718 .L159:
mike@0 1719 @ return (s1[i] = charbuf[s2+i])
mike@0 1720 ldr r0, [fp, #40]
mike@0 1721 add r0, r0, r4
mike@0 1722 ldrb r0, [r0]
mike@0 1723 set r1, _charbuf
mike@0 1724 ldr r2, [fp, #44]
mike@0 1725 add r1, r1, r2
mike@0 1726 add r1, r1, r4
mike@0 1727 ldrb r1, [r1]
mike@0 1728 cmp r0, r1
mike@0 1729 mov r0, #0
mike@0 1730 moveq r0, #1
mike@0 1731 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1732 .ltorg
mike@0 1733
mike@0 1734 @ proc WriteString(s: permstring);
mike@0 1735 _WriteString:
mike@0 1736 mov ip, sp
mike@0 1737 stmfd sp!, {r0-r1}
mike@0 1738 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1739 mov fp, sp
mike@0 1740 @ i := s;
mike@0 1741 ldr r4, [fp, #40]
mike@0 1742 .L162:
mike@0 1743 @ while charbuf[i] <> ENDSTR do
mike@0 1744 set r0, _charbuf
mike@0 1745 add r0, r0, r4
mike@0 1746 ldrb r5, [r0]
mike@0 1747 cmp r5, #0
mike@0 1748 beq .L161
mike@0 1749 @ print_char(charbuf[i]); i := i+1
mike@0 1750 mov r0, r5
mike@0 1751 bl print_char
mike@0 1752 add r4, r4, #1
mike@0 1753 b .L162
mike@0 1754 .L161:
mike@0 1755 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1756 .ltorg
mike@0 1757
mike@0 1758 @ proc LocAlloc(size: integer): ptr;
mike@0 1759 _LocAlloc:
mike@0 1760 mov ip, sp
mike@0 1761 stmfd sp!, {r0-r1}
mike@0 1762 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1763 mov fp, sp
mike@0 1764 @ if lsp + size >= gsp then newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2) end;
mike@0 1765 set r0, _lsp
mike@0 1766 ldr r0, [r0]
mike@0 1767 ldr r1, [fp, #40]
mike@0 1768 add r0, r0, r1
mike@0 1769 set r1, _gsp
mike@0 1770 ldr r1, [r1]
mike@0 1771 cmp r0, r1
mike@0 1772 blt .L168
mike@0 1773 bl newline
mike@0 1774 mov r1, #7
mike@0 1775 set r0, g3
mike@0 1776 bl print_string
mike@0 1777 mov r1, #18
mike@0 1778 set r0, g4
mike@0 1779 bl print_string
mike@0 1780 bl newline
mike@0 1781 mov r0, #2
mike@0 1782 bl exit
mike@0 1783 .L168:
mike@0 1784 @ p := lsp + 1; lsp := lsp + size; return p
mike@0 1785 set r5, _lsp
mike@0 1786 ldr r6, [r5]
mike@0 1787 add r4, r6, #1
mike@0 1788 ldr r0, [fp, #40]
mike@0 1789 add r0, r6, r0
mike@0 1790 str r0, [r5]
mike@0 1791 mov r0, r4
mike@0 1792 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1793 .ltorg
mike@0 1794
mike@0 1795 @ proc GloAlloc(kind, size: integer): ptr;
mike@0 1796 _GloAlloc:
mike@0 1797 mov ip, sp
mike@0 1798 stmfd sp!, {r0-r1}
mike@0 1799 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1800 mov fp, sp
mike@0 1801 @ if gsp - size <= lsp then
mike@0 1802 set r0, _gsp
mike@0 1803 ldr r0, [r0]
mike@0 1804 ldr r1, [fp, #44]
mike@0 1805 sub r0, r0, r1
mike@0 1806 set r1, _lsp
mike@0 1807 ldr r1, [r1]
mike@0 1808 cmp r0, r1
mike@0 1809 bgt .L172
mike@0 1810 @ newline(); print_string("Panic: "); print_string("out of stack space"); newline(); exit(2)
mike@0 1811 bl newline
mike@0 1812 mov r1, #7
mike@0 1813 set r0, g5
mike@0 1814 bl print_string
mike@0 1815 mov r1, #18
mike@0 1816 set r0, g6
mike@0 1817 bl print_string
mike@0 1818 bl newline
mike@0 1819 mov r0, #2
mike@0 1820 bl exit
mike@0 1821 .L172:
mike@0 1822 @ gsp := gsp - size; p := gsp;
mike@0 1823 set r5, _gsp
mike@0 1824 ldr r6, [fp, #44]
mike@0 1825 ldr r0, [r5]
mike@0 1826 sub r7, r0, r6
mike@0 1827 str r7, [r5]
mike@0 1828 mov r4, r7
mike@0 1829 @ mem[p] := lsl(kind, 8) + size;
mike@0 1830 ldr r0, [fp, #40]
mike@0 1831 lsl r0, r0, #8
mike@0 1832 add r0, r0, r6
mike@0 1833 set r1, _mem
mike@0 1834 lsl r2, r4, #2
mike@0 1835 add r1, r1, r2
mike@0 1836 str r0, [r1]
mike@0 1837 @ return p
mike@0 1838 mov r0, r4
mike@0 1839 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1840 .ltorg
mike@0 1841
mike@0 1842 @ proc HeapAlloc(size: integer): ptr;
mike@0 1843 _HeapAlloc:
mike@0 1844 mov ip, sp
mike@0 1845 stmfd sp!, {r0-r1}
mike@0 1846 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1847 mov fp, sp
mike@0 1848 @ if hp + size > MEMSIZE then newline(); print_string("Panic: "); print_string("out of heap space"); newline(); exit(2) end;
mike@0 1849 set r0, _hp
mike@0 1850 ldr r0, [r0]
mike@0 1851 ldr r1, [fp, #40]
mike@0 1852 add r0, r0, r1
mike@0 1853 set r1, #25000
mike@0 1854 cmp r0, r1
mike@0 1855 ble .L176
mike@0 1856 bl newline
mike@0 1857 mov r1, #7
mike@0 1858 set r0, g7
mike@0 1859 bl print_string
mike@0 1860 mov r1, #17
mike@0 1861 set r0, g8
mike@0 1862 bl print_string
mike@0 1863 bl newline
mike@0 1864 mov r0, #2
mike@0 1865 bl exit
mike@0 1866 .L176:
mike@0 1867 @ p := hp + 1; hp := hp + size; return p
mike@0 1868 set r5, _hp
mike@0 1869 ldr r6, [r5]
mike@0 1870 add r4, r6, #1
mike@0 1871 ldr r0, [fp, #40]
mike@0 1872 add r0, r6, r0
mike@0 1873 str r0, [r5]
mike@0 1874 mov r0, r4
mike@0 1875 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1876 .ltorg
mike@0 1877
mike@0 1878 @ proc prog(line: array 60 of char);
mike@0 1879 _prog:
mike@0 1880 mov ip, sp
mike@0 1881 stmfd sp!, {r0-r1}
mike@0 1882 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1883 mov fp, sp
mike@0 1884 @ for i := 0 to 59 do
mike@0 1885 mov r4, #0
mike@0 1886 mov r5, #59
mike@0 1887 .L178:
mike@0 1888 cmp r4, r5
mike@0 1889 bgt .L179
mike@0 1890 @ infile[pin] := line[i]; pin := pin+1
mike@0 1891 set r6, _pin
mike@0 1892 ldr r0, [fp, #40]
mike@0 1893 add r0, r0, r4
mike@0 1894 ldrb r0, [r0]
mike@0 1895 set r1, _infile
mike@0 1896 ldr r2, [r6]
mike@0 1897 add r1, r1, r2
mike@0 1898 strb r0, [r1]
mike@0 1899 ldr r0, [r6]
mike@0 1900 add r0, r0, #1
mike@0 1901 str r0, [r6]
mike@0 1902 add r4, r4, #1
mike@0 1903 b .L178
mike@0 1904 .L179:
mike@0 1905 @ infile[pin] := ENDLINE; pin := pin+1
mike@0 1906 set r6, _pin
mike@0 1907 mov r0, #10
mike@0 1908 set r1, _infile
mike@0 1909 ldr r2, [r6]
mike@0 1910 add r1, r1, r2
mike@0 1911 strb r0, [r1]
mike@0 1912 ldr r0, [r6]
mike@0 1913 add r0, r0, #1
mike@0 1914 str r0, [r6]
mike@0 1915 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1916 .ltorg
mike@0 1917
mike@0 1918 @ proc rdchar(var ch: char);
mike@0 1919 _rdchar:
mike@0 1920 mov ip, sp
mike@0 1921 stmfd sp!, {r0-r1}
mike@0 1922 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1923 mov fp, sp
mike@0 1924 @ if pout >= pin then
mike@0 1925 set r0, _pout
mike@0 1926 ldr r0, [r0]
mike@0 1927 set r1, _pin
mike@0 1928 ldr r1, [r1]
mike@0 1929 cmp r0, r1
mike@0 1930 blt .L182
mike@0 1931 @ ch := ENDFILE
mike@0 1932 mov r0, #127
mike@0 1933 ldr r1, [fp, #40]
mike@0 1934 strb r0, [r1]
mike@0 1935 b .L180
mike@0 1936 .L182:
mike@0 1937 @ ch := infile[pout]; pout := pout+1
mike@0 1938 set r4, _pout
mike@0 1939 set r0, _infile
mike@0 1940 ldr r1, [r4]
mike@0 1941 add r0, r0, r1
mike@0 1942 ldrb r0, [r0]
mike@0 1943 ldr r1, [fp, #40]
mike@0 1944 strb r0, [r1]
mike@0 1945 ldr r0, [r4]
mike@0 1946 add r0, r0, #1
mike@0 1947 str r0, [r4]
mike@0 1948 .L180:
mike@0 1949 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1950 .ltorg
mike@0 1951
mike@0 1952 @ proc GetChar(): char;
mike@0 1953 _GetChar:
mike@0 1954 mov ip, sp
mike@0 1955 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1956 mov fp, sp
mike@0 1957 sub sp, sp, #8
mike@0 1958 @ if pbchar <> ENDFILE then
mike@0 1959 set r4, _pbchar
mike@0 1960 ldrb r5, [r4]
mike@0 1961 cmp r5, #127
mike@0 1962 beq .L186
mike@0 1963 @ ch := pbchar; pbchar := ENDFILE
mike@0 1964 strb r5, [fp, #-1]
mike@0 1965 mov r0, #127
mike@0 1966 strb r0, [r4]
mike@0 1967 b .L187
mike@0 1968 .L186:
mike@0 1969 @ rdchar(ch);
mike@0 1970 add r0, fp, #-1
mike@0 1971 bl _rdchar
mike@0 1972 @ if ch = ENDLINE then lineno := lineno+1 end
mike@0 1973 ldrb r0, [fp, #-1]
mike@0 1974 cmp r0, #10
mike@0 1975 bne .L187
mike@0 1976 set r4, _lineno
mike@0 1977 ldr r0, [r4]
mike@0 1978 add r0, r0, #1
mike@0 1979 str r0, [r4]
mike@0 1980 .L187:
mike@0 1981 @ return ch
mike@0 1982 ldrb r0, [fp, #-1]
mike@0 1983 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1984 .ltorg
mike@0 1985
mike@0 1986 @ proc PushBack(ch: char);
mike@0 1987 _PushBack:
mike@0 1988 mov ip, sp
mike@0 1989 stmfd sp!, {r0-r1}
mike@0 1990 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 1991 mov fp, sp
mike@0 1992 @ pbchar := ch
mike@0 1993 ldrb r0, [fp, #40]
mike@0 1994 set r1, _pbchar
mike@0 1995 strb r0, [r1]
mike@0 1996 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 1997 .ltorg
mike@0 1998
mike@0 1999 @ proc Deref(t: term; e: frame): term;
mike@0 2000 _Deref:
mike@0 2001 mov ip, sp
mike@0 2002 stmfd sp!, {r0-r1}
mike@0 2003 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2004 mov fp, sp
mike@0 2005 @ if t = NULL then newline(); print_string("Panic: "); print_string("Deref"); newline(); exit(2) end;
mike@0 2006 ldr r0, [fp, #40]
mike@0 2007 cmp r0, #0
mike@0 2008 bne .L195
mike@0 2009 bl newline
mike@0 2010 mov r1, #7
mike@0 2011 set r0, g9
mike@0 2012 bl print_string
mike@0 2013 mov r1, #5
mike@0 2014 set r0, g10
mike@0 2015 bl print_string
mike@0 2016 bl newline
mike@0 2017 mov r0, #2
mike@0 2018 bl exit
mike@0 2019 .L195:
mike@0 2020 @ if (lsr(mem[t], 8) = REF) and (e <> NULL) then
mike@0 2021 set r0, _mem
mike@0 2022 ldr r1, [fp, #40]
mike@0 2023 lsl r1, r1, #2
mike@0 2024 add r4, r0, r1
mike@0 2025 ldr r0, [r4]
mike@0 2026 lsr r0, r0, #8
mike@0 2027 cmp r0, #5
mike@0 2028 bne .L200
mike@0 2029 ldr r5, [fp, #44]
mike@0 2030 cmp r5, #0
mike@0 2031 beq .L200
mike@0 2032 @ t := (e+7+(mem[t+1]-1)*TERM_SIZE)
mike@0 2033 add r0, r5, #7
mike@0 2034 ldr r1, [r4, #4]
mike@0 2035 lsl r1, r1, #1
mike@0 2036 sub r1, r1, #2
mike@0 2037 add r0, r0, r1
mike@0 2038 str r0, [fp, #40]
mike@0 2039 .L200:
mike@0 2040 @ while (lsr(mem[t], 8) = CELL) and (mem[t+1] <> NULL) do
mike@0 2041 set r0, _mem
mike@0 2042 ldr r1, [fp, #40]
mike@0 2043 lsl r1, r1, #2
mike@0 2044 add r4, r0, r1
mike@0 2045 ldr r0, [r4]
mike@0 2046 lsr r0, r0, #8
mike@0 2047 cmp r0, #4
mike@0 2048 bne .L202
mike@0 2049 ldr r4, [r4, #4]
mike@0 2050 cmp r4, #0
mike@0 2051 beq .L202
mike@0 2052 @ t := mem[t+1]
mike@0 2053 str r4, [fp, #40]
mike@0 2054 b .L200
mike@0 2055 .L202:
mike@0 2056 @ return t
mike@0 2057 ldr r0, [fp, #40]
mike@0 2058 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2059 .ltorg
mike@0 2060
mike@0 2061 @ proc Lookup(var name: tempstring): symbol;
mike@0 2062 _Lookup:
mike@0 2063 mov ip, sp
mike@0 2064 stmfd sp!, {r0-r1}
mike@0 2065 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2066 mov fp, sp
mike@0 2067 @ h := 0; i := 0;
mike@0 2068 mov r4, #0
mike@0 2069 mov r5, #0
mike@0 2070 .L205:
mike@0 2071 @ while name[i] <> ENDSTR do
mike@0 2072 ldr r0, [fp, #40]
mike@0 2073 add r0, r0, r5
mike@0 2074 ldrb r7, [r0]
mike@0 2075 cmp r7, #0
mike@0 2076 beq .L207
mike@0 2077 @ h := (5 * h + ord(name[i])) mod MAXSYMBOLS; i := i+1
mike@0 2078 set r1, #511
mike@0 2079 mov r0, #5
mike@0 2080 mul r0, r4, r0
mike@0 2081 add r0, r0, r7
mike@0 2082 bl int_mod
mike@0 2083 mov r4, r0
mike@0 2084 add r5, r5, #1
mike@0 2085 b .L205
mike@0 2086 .L207:
mike@0 2087 @ p := h+1;
mike@0 2088 add r6, r4, #1
mike@0 2089 .L208:
mike@0 2090 @ while symtab[p].name <> -1 do
mike@0 2091 set r0, _symtab
mike@0 2092 lsl r1, r6, #4
mike@0 2093 add r0, r0, r1
mike@0 2094 ldr r7, [r0]
mike@0 2095 mov r0, #-1
mike@0 2096 cmp r7, r0
mike@0 2097 beq .L210
mike@0 2098 @ if StringEqual(name, symtab[p].name) then return p end;
mike@0 2099 mov r1, r7
mike@0 2100 ldr r0, [fp, #40]
mike@0 2101 bl _StringEqual
mike@0 2102 cmp r0, #0
mike@0 2103 beq .L213
mike@0 2104 mov r0, r6
mike@0 2105 b .L204
mike@0 2106 .L213:
mike@0 2107 @ p := p-1;
mike@0 2108 sub r6, r6, #1
mike@0 2109 @ if p = 0 then p := MAXSYMBOLS end
mike@0 2110 cmp r6, #0
mike@0 2111 bne .L208
mike@0 2112 set r6, #511
mike@0 2113 b .L208
mike@0 2114 .L210:
mike@0 2115 @ if nsymbols >= (MAXSYMBOLS div 10) * (HASHFACTOR div 10) then
mike@0 2116 set r0, _nsymbols
mike@0 2117 ldr r0, [r0]
mike@0 2118 set r1, #459
mike@0 2119 cmp r0, r1
mike@0 2120 blt .L219
mike@0 2121 @ newline(); print_string("Panic: "); print_string("out of symbol space"); newline(); exit(2)
mike@0 2122 bl newline
mike@0 2123 mov r1, #7
mike@0 2124 set r0, g11
mike@0 2125 bl print_string
mike@0 2126 mov r1, #19
mike@0 2127 set r0, g12
mike@0 2128 bl print_string
mike@0 2129 bl newline
mike@0 2130 mov r0, #2
mike@0 2131 bl exit
mike@0 2132 .L219:
mike@0 2133 @ symtab[p].name := SaveString(name);
mike@0 2134 ldr r0, [fp, #40]
mike@0 2135 bl _SaveString
mike@0 2136 set r1, _symtab
mike@0 2137 lsl r2, r6, #4
mike@0 2138 add r7, r1, r2
mike@0 2139 str r0, [r7]
mike@0 2140 @ symtab[p].arity := -1;
mike@0 2141 mov r0, #-1
mike@0 2142 str r0, [r7, #4]
mike@0 2143 @ symtab[p].action := 0; symtab[p].prok := NULL;
mike@0 2144 mov r0, #0
mike@0 2145 str r0, [r7, #8]
mike@0 2146 mov r0, #0
mike@0 2147 str r0, [r7, #12]
mike@0 2148 @ return p
mike@0 2149 mov r0, r6
mike@0 2150 .L204:
mike@0 2151 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2152 .ltorg
mike@0 2153
mike@0 2154 @ proc Enter(name: keyword; arity: integer; action: integer): symbol;
mike@0 2155 _Enter:
mike@0 2156 mov ip, sp
mike@0 2157 stmfd sp!, {r0-r3}
mike@0 2158 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2159 mov fp, sp
mike@0 2160 sub sp, sp, #128
mike@0 2161 @ i := 0;
mike@0 2162 mov r5, #0
mike@0 2163 .L221:
mike@0 2164 @ while name[i] <> ' ' do
mike@0 2165 ldr r0, [fp, #40]
mike@0 2166 add r0, r0, r5
mike@0 2167 ldrb r6, [r0]
mike@0 2168 cmp r6, #32
mike@0 2169 beq .L223
mike@0 2170 @ temp[i] := name[i]; i := i+1
mike@0 2171 add r0, fp, #-128
mike@0 2172 add r0, r0, r5
mike@0 2173 strb r6, [r0]
mike@0 2174 add r5, r5, #1
mike@0 2175 b .L221
mike@0 2176 .L223:
mike@0 2177 @ temp[i] := ENDSTR; s := Lookup(temp);
mike@0 2178 mov r0, #0
mike@0 2179 add r1, fp, #-128
mike@0 2180 add r1, r1, r5
mike@0 2181 strb r0, [r1]
mike@0 2182 add r0, fp, #-128
mike@0 2183 bl _Lookup
mike@0 2184 mov r4, r0
mike@0 2185 @ symtab[s].arity := arity; symtab[s].action := action;
mike@0 2186 set r0, _symtab
mike@0 2187 lsl r1, r4, #4
mike@0 2188 add r6, r0, r1
mike@0 2189 ldr r0, [fp, #44]
mike@0 2190 str r0, [r6, #4]
mike@0 2191 ldr r0, [fp, #48]
mike@0 2192 str r0, [r6, #8]
mike@0 2193 @ return s
mike@0 2194 mov r0, r4
mike@0 2195 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2196 .ltorg
mike@0 2197
mike@0 2198 @ proc InitSymbols();
mike@0 2199 _InitSymbols:
mike@0 2200 mov ip, sp
mike@0 2201 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2202 mov fp, sp
mike@0 2203 @ nsymbols := 0;
mike@0 2204 mov r0, #0
mike@0 2205 set r1, _nsymbols
mike@0 2206 str r0, [r1]
mike@0 2207 @ for i := 1 to MAXSYMBOLS do symtab[i].name := -1 end;
mike@0 2208 mov r4, #1
mike@0 2209 set r6, #511
mike@0 2210 .L225:
mike@0 2211 cmp r4, r6
mike@0 2212 bgt .L226
mike@0 2213 mov r0, #-1
mike@0 2214 set r1, _symtab
mike@0 2215 lsl r2, r4, #4
mike@0 2216 add r1, r1, r2
mike@0 2217 str r0, [r1]
mike@0 2218 add r4, r4, #1
mike@0 2219 b .L225
mike@0 2220 .L226:
mike@0 2221 @ cons := Enter(": ", 2, 0);
mike@0 2222 mov r2, #0
mike@0 2223 mov r1, #2
mike@0 2224 set r0, g13
mike@0 2225 bl _Enter
mike@0 2226 set r1, _cons
mike@0 2227 str r0, [r1]
mike@0 2228 @ cutsym := Enter("! ", 0, CUT);
mike@0 2229 mov r2, #1
mike@0 2230 mov r1, #0
mike@0 2231 set r0, g14
mike@0 2232 bl _Enter
mike@0 2233 set r1, _cutsym
mike@0 2234 str r0, [r1]
mike@0 2235 @ eqsym := Enter("= ", 2, EQUALITY);
mike@0 2236 mov r2, #8
mike@0 2237 mov r1, #2
mike@0 2238 set r0, g15
mike@0 2239 bl _Enter
mike@0 2240 set r1, _eqsym
mike@0 2241 str r0, [r1]
mike@0 2242 @ nilsym := Enter("nil ", 0, 0);
mike@0 2243 mov r2, #0
mike@0 2244 mov r1, #0
mike@0 2245 set r0, g16
mike@0 2246 bl _Enter
mike@0 2247 set r1, _nilsym
mike@0 2248 str r0, [r1]
mike@0 2249 @ notsym := Enter("not ", 1, NAFF);
mike@0 2250 mov r2, #7
mike@0 2251 mov r1, #1
mike@0 2252 set r0, g17
mike@0 2253 bl _Enter
mike@0 2254 set r1, _notsym
mike@0 2255 str r0, [r1]
mike@0 2256 @ node := Enter("node ", 2, 0);
mike@0 2257 mov r2, #0
mike@0 2258 mov r1, #2
mike@0 2259 set r0, g18
mike@0 2260 bl _Enter
mike@0 2261 set r1, _node
mike@0 2262 str r0, [r1]
mike@0 2263 @ dummy := Enter("call ", 1, CALL);
mike@0 2264 mov r2, #2
mike@0 2265 mov r1, #1
mike@0 2266 set r0, g19
mike@0 2267 bl _Enter
mike@0 2268 mov r5, r0
mike@0 2269 @ dummy := Enter("plus ", 3, PLUS);
mike@0 2270 mov r2, #3
mike@0 2271 mov r1, #3
mike@0 2272 set r0, g20
mike@0 2273 bl _Enter
mike@0 2274 mov r5, r0
mike@0 2275 @ dummy := Enter("times ", 3, TIMES);
mike@0 2276 mov r2, #4
mike@0 2277 mov r1, #3
mike@0 2278 set r0, g21
mike@0 2279 bl _Enter
mike@0 2280 mov r5, r0
mike@0 2281 @ dummy := Enter("integer ", 1, ISINT);
mike@0 2282 mov r2, #5
mike@0 2283 mov r1, #1
mike@0 2284 set r0, g22
mike@0 2285 bl _Enter
mike@0 2286 mov r5, r0
mike@0 2287 @ dummy := Enter("char ", 1, ISCHAR);
mike@0 2288 mov r2, #6
mike@0 2289 mov r1, #1
mike@0 2290 set r0, g23
mike@0 2291 bl _Enter
mike@0 2292 mov r5, r0
mike@0 2293 @ dummy := Enter("false ", 0, FAIL);
mike@0 2294 mov r2, #9
mike@0 2295 mov r1, #0
mike@0 2296 set r0, g24
mike@0 2297 bl _Enter
mike@0 2298 mov r5, r0
mike@0 2299 @ dummy := Enter("print ", 1, PRINT);
mike@0 2300 mov r2, #10
mike@0 2301 mov r1, #1
mike@0 2302 set r0, g25
mike@0 2303 bl _Enter
mike@0 2304 mov r5, r0
mike@0 2305 @ dummy := Enter("nl ", 0, NL)
mike@0 2306 mov r2, #11
mike@0 2307 mov r1, #0
mike@0 2308 set r0, g26
mike@0 2309 bl _Enter
mike@0 2310 mov r5, r0
mike@0 2311 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2312 .ltorg
mike@0 2313
mike@0 2314 @ proc AddClause(c: clause);
mike@0 2315 _AddClause:
mike@0 2316 mov ip, sp
mike@0 2317 stmfd sp!, {r0-r1}
mike@0 2318 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2319 mov fp, sp
mike@0 2320 @ s := mem[mem[c+3]+1];
mike@0 2321 set r6, _mem
mike@0 2322 ldr r0, [fp, #40]
mike@0 2323 lsl r0, r0, #2
mike@0 2324 add r0, r6, r0
mike@0 2325 ldr r0, [r0, #12]
mike@0 2326 lsl r0, r0, #2
mike@0 2327 add r0, r6, r0
mike@0 2328 ldr r4, [r0, #4]
mike@0 2329 @ if symtab[s].action <> 0 then
mike@0 2330 set r0, _symtab
mike@0 2331 lsl r1, r4, #4
mike@0 2332 add r0, r0, r1
mike@0 2333 ldr r0, [r0, #8]
mike@0 2334 cmp r0, #0
mike@0 2335 beq .L229
mike@0 2336 @ newline(); print_string("Error: "); print_string("cannot add clauses to built-in relation "); run := false;
mike@0 2337 bl newline
mike@0 2338 mov r1, #7
mike@0 2339 set r0, g27
mike@0 2340 bl print_string
mike@0 2341 mov r1, #40
mike@0 2342 set r0, g28
mike@0 2343 bl print_string
mike@0 2344 mov r0, #0
mike@0 2345 set r1, _run
mike@0 2346 strb r0, [r1]
mike@0 2347 @ WriteString(symtab[s].name)
mike@0 2348 set r0, _symtab
mike@0 2349 lsl r1, r4, #4
mike@0 2350 add r0, r0, r1
mike@0 2351 ldr r0, [r0]
mike@0 2352 bl _WriteString
mike@0 2353 b .L227
mike@0 2354 .L229:
mike@0 2355 @ elsif symtab[s].prok = NULL then
mike@0 2356 set r0, _symtab
mike@0 2357 lsl r1, r4, #4
mike@0 2358 add r0, r0, r1
mike@0 2359 add r6, r0, #12
mike@0 2360 ldr r0, [r6]
mike@0 2361 cmp r0, #0
mike@0 2362 bne .L232
mike@0 2363 @ symtab[s].prok := c
mike@0 2364 ldr r0, [fp, #40]
mike@0 2365 str r0, [r6]
mike@0 2366 b .L227
mike@0 2367 .L232:
mike@0 2368 @ p := symtab[s].prok;
mike@0 2369 set r0, _symtab
mike@0 2370 lsl r1, r4, #4
mike@0 2371 add r0, r0, r1
mike@0 2372 ldr r5, [r0, #12]
mike@0 2373 .L234:
mike@0 2374 @ while mem[p+2] <> NULL do p := mem[p+2] end;
mike@0 2375 set r0, _mem
mike@0 2376 lsl r1, r5, #2
mike@0 2377 add r0, r0, r1
mike@0 2378 ldr r6, [r0, #8]
mike@0 2379 cmp r6, #0
mike@0 2380 beq .L236
mike@0 2381 mov r5, r6
mike@0 2382 b .L234
mike@0 2383 .L236:
mike@0 2384 @ mem[p+2] := c
mike@0 2385 ldr r0, [fp, #40]
mike@0 2386 set r1, _mem
mike@0 2387 lsl r2, r5, #2
mike@0 2388 add r1, r1, r2
mike@0 2389 str r0, [r1, #8]
mike@0 2390 .L227:
mike@0 2391 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2392 .ltorg
mike@0 2393
mike@0 2394 @ proc MakeCompound(fun: symbol; var arg: argbuf): term;
mike@0 2395 _MakeCompound:
mike@0 2396 mov ip, sp
mike@0 2397 stmfd sp!, {r0-r1}
mike@0 2398 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2399 mov fp, sp
mike@0 2400 sub sp, sp, #8
mike@0 2401 @ n := symtab[fun].arity;
mike@0 2402 set r0, _symtab
mike@0 2403 ldr r1, [fp, #40]
mike@0 2404 lsl r1, r1, #4
mike@0 2405 add r0, r0, r1
mike@0 2406 ldr r6, [r0, #4]
mike@0 2407 @ p := HeapAlloc(TERM_SIZE+n);
mike@0 2408 add r0, r6, #2
mike@0 2409 bl _HeapAlloc
mike@0 2410 mov r4, r0
mike@0 2411 @ mem[p] := lsl(FUNC, 8) + TERM_SIZE+n;
mike@0 2412 set r0, _mem
mike@0 2413 lsl r1, r4, #2
mike@0 2414 add r7, r0, r1
mike@0 2415 set r0, #258
mike@0 2416 add r0, r6, r0
mike@0 2417 str r0, [r7]
mike@0 2418 @ mem[p+1] := fun;
mike@0 2419 ldr r0, [fp, #40]
mike@0 2420 str r0, [r7, #4]
mike@0 2421 @ for i := 1 to n do mem[p+i+1] := arg[i] end;
mike@0 2422 mov r5, #1
mike@0 2423 str r6, [fp, #-4]
mike@0 2424 .L238:
mike@0 2425 ldr r0, [fp, #-4]
mike@0 2426 cmp r5, r0
mike@0 2427 bgt .L239
mike@0 2428 ldr r0, [fp, #44]
mike@0 2429 lsl r1, r5, #2
mike@0 2430 add r0, r0, r1
mike@0 2431 ldr r0, [r0]
mike@0 2432 set r1, _mem
mike@0 2433 add r2, r4, r5
mike@0 2434 lsl r2, r2, #2
mike@0 2435 add r1, r1, r2
mike@0 2436 str r0, [r1, #4]
mike@0 2437 add r5, r5, #1
mike@0 2438 b .L238
mike@0 2439 .L239:
mike@0 2440 @ return p
mike@0 2441 mov r0, r4
mike@0 2442 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2443 .ltorg
mike@0 2444
mike@0 2445 @ proc MakeNode(fun: symbol; a1, a2: term): term;
mike@0 2446 _MakeNode:
mike@0 2447 mov ip, sp
mike@0 2448 stmfd sp!, {r0-r3}
mike@0 2449 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2450 mov fp, sp
mike@0 2451 sub sp, sp, #256
mike@0 2452 @ arg[1] := a1; arg[2] := a2;
mike@0 2453 ldr r0, [fp, #44]
mike@0 2454 str r0, [fp, #-252]
mike@0 2455 ldr r0, [fp, #48]
mike@0 2456 str r0, [fp, #-248]
mike@0 2457 @ return MakeCompound(fun, arg)
mike@0 2458 add r1, fp, #-256
mike@0 2459 ldr r0, [fp, #40]
mike@0 2460 bl _MakeCompound
mike@0 2461 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2462 .ltorg
mike@0 2463
mike@0 2464 @ proc MakeRef(offset: integer): term;
mike@0 2465 _MakeRef:
mike@0 2466 mov ip, sp
mike@0 2467 stmfd sp!, {r0-r1}
mike@0 2468 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2469 mov fp, sp
mike@0 2470 @ return refnode[offset]
mike@0 2471 set r0, _refnode
mike@0 2472 ldr r1, [fp, #40]
mike@0 2473 lsl r1, r1, #2
mike@0 2474 add r0, r0, r1
mike@0 2475 ldr r0, [r0]
mike@0 2476 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2477 .ltorg
mike@0 2478
mike@0 2479 @ proc MakeInt(i: integer): term;
mike@0 2480 _MakeInt:
mike@0 2481 mov ip, sp
mike@0 2482 stmfd sp!, {r0-r1}
mike@0 2483 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2484 mov fp, sp
mike@0 2485 @ p := HeapAlloc(TERM_SIZE);
mike@0 2486 mov r0, #2
mike@0 2487 bl _HeapAlloc
mike@0 2488 mov r4, r0
mike@0 2489 @ mem[p] := lsl(INT, 8) + TERM_SIZE;
mike@0 2490 set r0, _mem
mike@0 2491 lsl r1, r4, #2
mike@0 2492 add r5, r0, r1
mike@0 2493 set r0, #514
mike@0 2494 str r0, [r5]
mike@0 2495 @ mem[p+1] := i; return p
mike@0 2496 ldr r0, [fp, #40]
mike@0 2497 str r0, [r5, #4]
mike@0 2498 mov r0, r4
mike@0 2499 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2500 .ltorg
mike@0 2501
mike@0 2502 @ proc MakeChar(c: char): term;
mike@0 2503 _MakeChar:
mike@0 2504 mov ip, sp
mike@0 2505 stmfd sp!, {r0-r1}
mike@0 2506 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2507 mov fp, sp
mike@0 2508 @ p := HeapAlloc(TERM_SIZE);
mike@0 2509 mov r0, #2
mike@0 2510 bl _HeapAlloc
mike@0 2511 mov r4, r0
mike@0 2512 @ mem[p] := lsl(CHRCTR, 8) + TERM_SIZE;
mike@0 2513 set r0, _mem
mike@0 2514 lsl r1, r4, #2
mike@0 2515 add r5, r0, r1
mike@0 2516 set r0, #770
mike@0 2517 str r0, [r5]
mike@0 2518 @ mem[p+1] := ord(c); return p
mike@0 2519 ldrb r0, [fp, #40]
mike@0 2520 str r0, [r5, #4]
mike@0 2521 mov r0, r4
mike@0 2522 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2523 .ltorg
mike@0 2524
mike@0 2525 @ proc MakeString(var s: tempstring): term;
mike@0 2526 _MakeString:
mike@0 2527 mov ip, sp
mike@0 2528 stmfd sp!, {r0-r1}
mike@0 2529 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2530 mov fp, sp
mike@0 2531 @ i := StringLength(s);
mike@0 2532 ldr r0, [fp, #40]
mike@0 2533 bl _StringLength
mike@0 2534 mov r5, r0
mike@0 2535 @ p := MakeNode(nilsym, NULL, NULL);
mike@0 2536 mov r2, #0
mike@0 2537 mov r1, #0
mike@0 2538 set r0, _nilsym
mike@0 2539 ldr r0, [r0]
mike@0 2540 bl _MakeNode
mike@0 2541 mov r4, r0
mike@0 2542 .L245:
mike@0 2543 @ while i > 0 do
mike@0 2544 cmp r5, #0
mike@0 2545 ble .L247
mike@0 2546 @ i := i-1; p := MakeNode(cons, MakeChar(s[i]), p)
mike@0 2547 sub r5, r5, #1
mike@0 2548 ldr r0, [fp, #40]
mike@0 2549 add r0, r0, r5
mike@0 2550 ldrb r0, [r0]
mike@0 2551 bl _MakeChar
mike@0 2552 mov r2, r4
mike@0 2553 mov r1, r0
mike@0 2554 set r0, _cons
mike@0 2555 ldr r0, [r0]
mike@0 2556 bl _MakeNode
mike@0 2557 mov r4, r0
mike@0 2558 b .L245
mike@0 2559 .L247:
mike@0 2560 @ return p
mike@0 2561 mov r0, r4
mike@0 2562 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2563 .ltorg
mike@0 2564
mike@0 2565 @ proc MakeClause(nvars: integer; head: term;
mike@0 2566 _MakeClause:
mike@0 2567 mov ip, sp
mike@0 2568 stmfd sp!, {r0-r3}
mike@0 2569 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2570 mov fp, sp
mike@0 2571 @ p := HeapAlloc(CLAUSE_SIZE + nbody + 1);
mike@0 2572 ldr r0, [fp, #52]
mike@0 2573 add r0, r0, #4
mike@0 2574 add r0, r0, #1
mike@0 2575 bl _HeapAlloc
mike@0 2576 mov r4, r0
mike@0 2577 @ mem[p] := nvars; mem[p+2] := NULL; mem[p+3] := head;
mike@0 2578 set r0, _mem
mike@0 2579 lsl r1, r4, #2
mike@0 2580 add r7, r0, r1
mike@0 2581 ldr r0, [fp, #40]
mike@0 2582 str r0, [r7]
mike@0 2583 mov r0, #0
mike@0 2584 str r0, [r7, #8]
mike@0 2585 ldr r0, [fp, #44]
mike@0 2586 str r0, [r7, #12]
mike@0 2587 @ for i := 1 to nbody do mem[(p+4)+i-1] := body[i] end;
mike@0 2588 mov r5, #1
mike@0 2589 ldr r6, [fp, #52]
mike@0 2590 .L249:
mike@0 2591 cmp r5, r6
mike@0 2592 bgt .L250
mike@0 2593 ldr r0, [fp, #48]
mike@0 2594 lsl r1, r5, #2
mike@0 2595 add r0, r0, r1
mike@0 2596 ldr r0, [r0]
mike@0 2597 set r1, _mem
mike@0 2598 add r2, r4, #4
mike@0 2599 add r2, r2, r5
mike@0 2600 lsl r2, r2, #2
mike@0 2601 add r1, r1, r2
mike@0 2602 str r0, [r1, #-4]
mike@0 2603 add r5, r5, #1
mike@0 2604 b .L249
mike@0 2605 .L250:
mike@0 2606 @ mem[(p+4)+nbody+1-1] := NULL;
mike@0 2607 set r7, _mem
mike@0 2608 mov r0, #0
mike@0 2609 add r1, r4, #4
mike@0 2610 ldr r2, [fp, #52]
mike@0 2611 add r1, r1, r2
mike@0 2612 lsl r1, r1, #2
mike@0 2613 add r1, r7, r1
mike@0 2614 str r0, [r1]
mike@0 2615 @ if head = NULL then
mike@0 2616 ldr r0, [fp, #44]
mike@0 2617 cmp r0, #0
mike@0 2618 bne .L252
mike@0 2619 @ mem[p+1] := 0
mike@0 2620 mov r0, #0
mike@0 2621 lsl r1, r4, #2
mike@0 2622 add r1, r7, r1
mike@0 2623 str r0, [r1, #4]
mike@0 2624 b .L253
mike@0 2625 .L252:
mike@0 2626 @ mem[p+1] := Key(head, NULL)
mike@0 2627 mov r1, #0
mike@0 2628 ldr r0, [fp, #44]
mike@0 2629 bl _Key
mike@0 2630 set r1, _mem
mike@0 2631 lsl r2, r4, #2
mike@0 2632 add r1, r1, r2
mike@0 2633 str r0, [r1, #4]
mike@0 2634 .L253:
mike@0 2635 @ return p
mike@0 2636 mov r0, r4
mike@0 2637 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2638 .ltorg
mike@0 2639
mike@0 2640 @ proc IsString(t: term; e: frame): boolean;
mike@0 2641 _IsString:
mike@0 2642 mov ip, sp
mike@0 2643 stmfd sp!, {r0-r1}
mike@0 2644 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2645 mov fp, sp
mike@0 2646 @ i := 0; t := Deref(t, e);
mike@0 2647 mov r4, #0
mike@0 2648 ldr r1, [fp, #44]
mike@0 2649 ldr r0, [fp, #40]
mike@0 2650 bl _Deref
mike@0 2651 str r0, [fp, #40]
mike@0 2652 .L255:
mike@0 2653 @ while i < limit do
mike@0 2654 cmp r4, #128
mike@0 2655 bge .L257
mike@0 2656 @ if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
mike@0 2657 set r0, _mem
mike@0 2658 ldr r1, [fp, #40]
mike@0 2659 lsl r1, r1, #2
mike@0 2660 add r5, r0, r1
mike@0 2661 ldr r0, [r5]
mike@0 2662 lsr r0, r0, #8
mike@0 2663 cmp r0, #1
mike@0 2664 bne .L258
mike@0 2665 ldr r0, [r5, #4]
mike@0 2666 set r1, _cons
mike@0 2667 ldr r1, [r1]
mike@0 2668 cmp r0, r1
mike@0 2669 beq .L259
mike@0 2670 .L258:
mike@0 2671 @ return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
mike@0 2672 set r0, _mem
mike@0 2673 ldr r1, [fp, #40]
mike@0 2674 lsl r1, r1, #2
mike@0 2675 add r5, r0, r1
mike@0 2676 ldr r0, [r5]
mike@0 2677 lsr r0, r0, #8
mike@0 2678 cmp r0, #1
mike@0 2679 mov r0, #0
mike@0 2680 moveq r0, #1
mike@0 2681 ldr r1, [r5, #4]
mike@0 2682 set r2, _nilsym
mike@0 2683 ldr r2, [r2]
mike@0 2684 cmp r1, r2
mike@0 2685 mov r1, #0
mike@0 2686 moveq r1, #1
mike@0 2687 and r0, r0, r1
mike@0 2688 b .L254
mike@0 2689 .L259:
mike@0 2690 @ elsif lsr(mem[Deref(mem[t+1+1], e)], 8) <> CHRCTR then
mike@0 2691 set r5, _mem
mike@0 2692 ldr r1, [fp, #44]
mike@0 2693 ldr r0, [fp, #40]
mike@0 2694 lsl r0, r0, #2
mike@0 2695 add r0, r5, r0
mike@0 2696 ldr r0, [r0, #8]
mike@0 2697 bl _Deref
mike@0 2698 lsl r0, r0, #2
mike@0 2699 add r0, r5, r0
mike@0 2700 ldr r0, [r0]
mike@0 2701 lsr r0, r0, #8
mike@0 2702 cmp r0, #3
mike@0 2703 beq .L262
mike@0 2704 @ return false
mike@0 2705 mov r0, #0
mike@0 2706 b .L254
mike@0 2707 .L262:
mike@0 2708 @ i := i+1; t := Deref(mem[t+2+1], e)
mike@0 2709 add r4, r4, #1
mike@0 2710 ldr r1, [fp, #44]
mike@0 2711 set r0, _mem
mike@0 2712 ldr r2, [fp, #40]
mike@0 2713 lsl r2, r2, #2
mike@0 2714 add r0, r0, r2
mike@0 2715 ldr r0, [r0, #12]
mike@0 2716 bl _Deref
mike@0 2717 str r0, [fp, #40]
mike@0 2718 b .L255
mike@0 2719 .L257:
mike@0 2720 @ return false
mike@0 2721 mov r0, #0
mike@0 2722 .L254:
mike@0 2723 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2724 .ltorg
mike@0 2725
mike@0 2726 @ proc IsList(t: term; e: frame): boolean;
mike@0 2727 _IsList:
mike@0 2728 mov ip, sp
mike@0 2729 stmfd sp!, {r0-r1}
mike@0 2730 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2731 mov fp, sp
mike@0 2732 @ i := 0; t := Deref(t, e);
mike@0 2733 mov r4, #0
mike@0 2734 ldr r1, [fp, #44]
mike@0 2735 ldr r0, [fp, #40]
mike@0 2736 bl _Deref
mike@0 2737 str r0, [fp, #40]
mike@0 2738 .L266:
mike@0 2739 @ while i < limit do
mike@0 2740 cmp r4, #128
mike@0 2741 bge .L268
mike@0 2742 @ if (lsr(mem[t], 8) <> FUNC) or (mem[t+1] <> cons) then
mike@0 2743 set r0, _mem
mike@0 2744 ldr r1, [fp, #40]
mike@0 2745 lsl r1, r1, #2
mike@0 2746 add r5, r0, r1
mike@0 2747 ldr r0, [r5]
mike@0 2748 lsr r0, r0, #8
mike@0 2749 cmp r0, #1
mike@0 2750 bne .L269
mike@0 2751 ldr r0, [r5, #4]
mike@0 2752 set r1, _cons
mike@0 2753 ldr r1, [r1]
mike@0 2754 cmp r0, r1
mike@0 2755 beq .L270
mike@0 2756 .L269:
mike@0 2757 @ return (lsr(mem[t], 8) = FUNC) and (mem[t+1] = nilsym)
mike@0 2758 set r0, _mem
mike@0 2759 ldr r1, [fp, #40]
mike@0 2760 lsl r1, r1, #2
mike@0 2761 add r5, r0, r1
mike@0 2762 ldr r0, [r5]
mike@0 2763 lsr r0, r0, #8
mike@0 2764 cmp r0, #1
mike@0 2765 mov r0, #0
mike@0 2766 moveq r0, #1
mike@0 2767 ldr r1, [r5, #4]
mike@0 2768 set r2, _nilsym
mike@0 2769 ldr r2, [r2]
mike@0 2770 cmp r1, r2
mike@0 2771 mov r1, #0
mike@0 2772 moveq r1, #1
mike@0 2773 and r0, r0, r1
mike@0 2774 b .L265
mike@0 2775 .L270:
mike@0 2776 @ i := i+1; t := Deref(mem[t+2+1], e)
mike@0 2777 add r4, r4, #1
mike@0 2778 ldr r1, [fp, #44]
mike@0 2779 set r0, _mem
mike@0 2780 ldr r2, [fp, #40]
mike@0 2781 lsl r2, r2, #2
mike@0 2782 add r0, r0, r2
mike@0 2783 ldr r0, [r0, #12]
mike@0 2784 bl _Deref
mike@0 2785 str r0, [fp, #40]
mike@0 2786 b .L266
mike@0 2787 .L268:
mike@0 2788 @ return false
mike@0 2789 mov r0, #0
mike@0 2790 .L265:
mike@0 2791 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2792 .ltorg
mike@0 2793
mike@0 2794 @ proc ShowString(t: term; e: frame);
mike@0 2795 _ShowString:
mike@0 2796 mov ip, sp
mike@0 2797 stmfd sp!, {r0-r1}
mike@0 2798 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2799 mov fp, sp
mike@0 2800 @ t := Deref(t, e);
mike@0 2801 ldr r1, [fp, #44]
mike@0 2802 ldr r0, [fp, #40]
mike@0 2803 bl _Deref
mike@0 2804 str r0, [fp, #40]
mike@0 2805 @ print_char('"');
mike@0 2806 mov r0, #34
mike@0 2807 bl print_char
mike@0 2808 .L274:
mike@0 2809 @ while mem[t+1] <> nilsym do
mike@0 2810 set r4, _mem
mike@0 2811 ldr r0, [fp, #40]
mike@0 2812 lsl r0, r0, #2
mike@0 2813 add r5, r4, r0
mike@0 2814 ldr r0, [r5, #4]
mike@0 2815 set r1, _nilsym
mike@0 2816 ldr r1, [r1]
mike@0 2817 cmp r0, r1
mike@0 2818 beq .L276
mike@0 2819 @ print_char(chr(mem[Deref(mem[t+1+1], e)+1]));
mike@0 2820 ldr r1, [fp, #44]
mike@0 2821 ldr r0, [r5, #8]
mike@0 2822 bl _Deref
mike@0 2823 mov r5, r0
mike@0 2824 lsl r0, r5, #2
mike@0 2825 add r0, r4, r0
mike@0 2826 ldr r0, [r0, #4]
mike@0 2827 bl print_char
mike@0 2828 @ t := Deref(mem[t+2+1], e)
mike@0 2829 ldr r1, [fp, #44]
mike@0 2830 set r0, _mem
mike@0 2831 ldr r2, [fp, #40]
mike@0 2832 lsl r2, r2, #2
mike@0 2833 add r0, r0, r2
mike@0 2834 ldr r0, [r0, #12]
mike@0 2835 bl _Deref
mike@0 2836 str r0, [fp, #40]
mike@0 2837 b .L274
mike@0 2838 .L276:
mike@0 2839 @ print_char('"')
mike@0 2840 mov r0, #34
mike@0 2841 bl print_char
mike@0 2842 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 2843 .ltorg
mike@0 2844
mike@0 2845 @ proc PrintCompound(t: term; e: frame; prio: integer);
mike@0 2846 _PrintCompound:
mike@0 2847 mov ip, sp
mike@0 2848 stmfd sp!, {r0-r3}
mike@0 2849 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 2850 mov fp, sp
mike@0 2851 @ f := mem[t+1];
mike@0 2852 ldr r7, [fp, #40]
mike@0 2853 set r0, _mem
mike@0 2854 lsl r1, r7, #2
mike@0 2855 add r0, r0, r1
mike@0 2856 ldr r4, [r0, #4]
mike@0 2857 @ if f = cons then
mike@0 2858 set r0, _cons
mike@0 2859 ldr r0, [r0]
mike@0 2860 cmp r4, r0
mike@0 2861 bne .L279
mike@0 2862 @ if IsString(t, e) then
mike@0 2863 ldr r1, [fp, #44]
mike@0 2864 mov r0, r7
mike@0 2865 bl _IsString
mike@0 2866 cmp r0, #0
mike@0 2867 beq .L303
mike@0 2868 @ ShowString(t, e)
mike@0 2869 ldr r1, [fp, #44]
mike@0 2870 ldr r0, [fp, #40]
mike@0 2871 bl _ShowString
mike@0 2872 b .L277
mike@0 2873 .L303:
mike@0 2874 @ if prio < CONSPRIO then print_char('(') end;
mike@0 2875 ldr r0, [fp, #48]
mike@0 2876 cmp r0, #1
mike@0 2877 bge .L307
mike@0 2878 mov r0, #40
mike@0 2879 bl print_char
mike@0 2880 .L307:
mike@0 2881 @ PrintTerm(mem[t+1+1], e, CONSPRIO-1);
mike@0 2882 mov r2, #0
mike@0 2883 ldr r1, [fp, #44]
mike@0 2884 set r0, _mem
mike@0 2885 ldr r3, [fp, #40]
mike@0 2886 lsl r3, r3, #2
mike@0 2887 add r0, r0, r3
mike@0 2888 ldr r0, [r0, #8]
mike@0 2889 bl _PrintTerm
mike@0 2890 @ print_char(':');
mike@0 2891 mov r0, #58
mike@0 2892 bl print_char
mike@0 2893 @ PrintTerm(mem[t+2+1], e, CONSPRIO);
mike@0 2894 mov r2, #1
mike@0 2895 ldr r1, [fp, #44]
mike@0 2896 set r0, _mem
mike@0 2897 ldr r3, [fp, #40]
mike@0 2898 lsl r3, r3, #2
mike@0 2899 add r0, r0, r3
mike@0 2900 ldr r0, [r0, #12]
mike@0 2901 bl _PrintTerm
mike@0 2902 @ if prio < CONSPRIO then print_char(')') end
mike@0 2903 ldr r0, [fp, #48]
mike@0 2904 cmp r0, #1
mike@0 2905 bge .L277
mike@0 2906 mov r0, #41
mike@0 2907 bl print_char
mike@0 2908 b .L277
mike@0 2909 .L279:
mike@0 2910 @ elsif f = eqsym then
mike@0 2911 set r0, _eqsym
mike@0 2912 ldr r0, [r0]
mike@0 2913 cmp r4, r0
mike@0 2914 bne .L282
mike@0 2915 @ if prio < EQPRIO then print_char('(') end;
mike@0 2916 ldr r0, [fp, #48]
mike@0 2917 cmp r0, #2
mike@0 2918 bge .L298
mike@0 2919 mov r0, #40
mike@0 2920 bl print_char
mike@0 2921 .L298:
mike@0 2922 @ PrintTerm(mem[t+1+1], e, EQPRIO-1);
mike@0 2923 mov r2, #1
mike@0 2924 ldr r1, [fp, #44]
mike@0 2925 set r0, _mem
mike@0 2926 ldr r3, [fp, #40]
mike@0 2927 lsl r3, r3, #2
mike@0 2928 add r0, r0, r3
mike@0 2929 ldr r0, [r0, #8]
mike@0 2930 bl _PrintTerm
mike@0 2931 @ print_string(" = ");
mike@0 2932 mov r1, #3
mike@0 2933 set r0, g29
mike@0 2934 bl print_string
mike@0 2935 @ PrintTerm(mem[t+2+1], e, EQPRIO-1);
mike@0 2936 mov r2, #1
mike@0 2937 ldr r1, [fp, #44]
mike@0 2938 set r0, _mem
mike@0 2939 ldr r3, [fp, #40]
mike@0 2940 lsl r3, r3, #2
mike@0 2941 add r0, r0, r3
mike@0 2942 ldr r0, [r0, #12]
mike@0 2943 bl _PrintTerm
mike@0 2944 @ if prio < EQPRIO then print_char(')') end
mike@0 2945 ldr r0, [fp, #48]
mike@0 2946 cmp r0, #2
mike@0 2947 bge .L277
mike@0 2948 mov r0, #41
mike@0 2949 bl print_char
mike@0 2950 b .L277
mike@0 2951 .L282:
mike@0 2952 @ elsif f = notsym then
mike@0 2953 set r0, _notsym
mike@0 2954 ldr r0, [r0]
mike@0 2955 cmp r4, r0
mike@0 2956 bne .L285
mike@0 2957 @ print_string("not ");
mike@0 2958 mov r1, #4
mike@0 2959 set r0, g30
mike@0 2960 bl print_string
mike@0 2961 @ PrintTerm(mem[t+1+1], e, MAXPRIO)
mike@0 2962 mov r2, #2
mike@0 2963 ldr r1, [fp, #44]
mike@0 2964 set r0, _mem
mike@0 2965 ldr r3, [fp, #40]
mike@0 2966 lsl r3, r3, #2
mike@0 2967 add r0, r0, r3
mike@0 2968 ldr r0, [r0, #8]
mike@0 2969 bl _PrintTerm
mike@0 2970 b .L277
mike@0 2971 .L285:
mike@0 2972 @ elsif (f = node) and IsList(mem[t+2+1], e) then
mike@0 2973 set r0, _node
mike@0 2974 ldr r0, [r0]
mike@0 2975 cmp r4, r0
mike@0 2976 bne .L288
mike@0 2977 ldr r1, [fp, #44]
mike@0 2978 set r0, _mem
mike@0 2979 ldr r2, [fp, #40]
mike@0 2980 lsl r2, r2, #2
mike@0 2981 add r0, r0, r2
mike@0 2982 ldr r0, [r0, #12]
mike@0 2983 bl _IsList
mike@0 2984 cmp r0, #0
mike@0 2985 beq .L288
mike@0 2986 @ PrintNode(t, e)
mike@0 2987 ldr r1, [fp, #44]
mike@0 2988 ldr r0, [fp, #40]
mike@0 2989 bl _PrintNode
mike@0 2990 b .L277
mike@0 2991 .L288:
mike@0 2992 @ WriteString(symtab[f].name);
mike@0 2993 set r0, _symtab
mike@0 2994 lsl r1, r4, #4
mike@0 2995 add r0, r0, r1
mike@0 2996 ldr r0, [r0]
mike@0 2997 bl _WriteString
mike@0 2998 @ if symtab[f].arity > 0 then
mike@0 2999 set r0, _symtab
mike@0 3000 lsl r1, r4, #4
mike@0 3001 add r0, r0, r1
mike@0 3002 ldr r0, [r0, #4]
mike@0 3003 cmp r0, #0
mike@0 3004 ble .L277
mike@0 3005 @ print_char('(');
mike@0 3006 mov r0, #40
mike@0 3007 bl print_char
mike@0 3008 @ PrintTerm(mem[t+1+1], e, ARGPRIO);
mike@0 3009 mov r2, #2
mike@0 3010 ldr r1, [fp, #44]
mike@0 3011 set r0, _mem
mike@0 3012 ldr r3, [fp, #40]
mike@0 3013 lsl r3, r3, #2
mike@0 3014 add r0, r0, r3
mike@0 3015 ldr r0, [r0, #8]
mike@0 3016 bl _PrintTerm
mike@0 3017 @ for i := 2 to symtab[f].arity do
mike@0 3018 mov r5, #2
mike@0 3019 set r0, _symtab
mike@0 3020 lsl r1, r4, #4
mike@0 3021 add r0, r0, r1
mike@0 3022 ldr r6, [r0, #4]
mike@0 3023 .L293:
mike@0 3024 cmp r5, r6
mike@0 3025 bgt .L294
mike@0 3026 @ print_string(", ");
mike@0 3027 mov r1, #2
mike@0 3028 set r0, g31
mike@0 3029 bl print_string
mike@0 3030 @ PrintTerm(mem[t+i+1], e, ARGPRIO)
mike@0 3031 mov r2, #2
mike@0 3032 ldr r1, [fp, #44]
mike@0 3033 set r0, _mem
mike@0 3034 ldr r3, [fp, #40]
mike@0 3035 add r3, r3, r5
mike@0 3036 lsl r3, r3, #2
mike@0 3037 add r0, r0, r3
mike@0 3038 ldr r0, [r0, #4]
mike@0 3039 bl _PrintTerm
mike@0 3040 add r5, r5, #1
mike@0 3041 b .L293
mike@0 3042 .L294:
mike@0 3043 @ print_char(')')
mike@0 3044 mov r0, #41
mike@0 3045 bl print_char
mike@0 3046 .L277:
mike@0 3047 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3048 .ltorg
mike@0 3049
mike@0 3050 @ proc PrintNode(t: term; e: frame);
mike@0 3051 _PrintNode:
mike@0 3052 mov ip, sp
mike@0 3053 stmfd sp!, {r0-r1}
mike@0 3054 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3055 mov fp, sp
mike@0 3056 @ print_char('<');
mike@0 3057 mov r0, #60
mike@0 3058 bl print_char
mike@0 3059 @ PrintTerm(mem[t+1+1], e, MAXPRIO);
mike@0 3060 mov r2, #2
mike@0 3061 ldr r1, [fp, #44]
mike@0 3062 set r0, _mem
mike@0 3063 ldr r3, [fp, #40]
mike@0 3064 lsl r3, r3, #2
mike@0 3065 add r0, r0, r3
mike@0 3066 ldr r0, [r0, #8]
mike@0 3067 bl _PrintTerm
mike@0 3068 @ u := Deref(mem[t+2+1], e);
mike@0 3069 ldr r1, [fp, #44]
mike@0 3070 set r0, _mem
mike@0 3071 ldr r2, [fp, #40]
mike@0 3072 lsl r2, r2, #2
mike@0 3073 add r0, r0, r2
mike@0 3074 ldr r0, [r0, #12]
mike@0 3075 bl _Deref
mike@0 3076 mov r4, r0
mike@0 3077 .L312:
mike@0 3078 @ while mem[u+1] <> nilsym do
mike@0 3079 set r0, _mem
mike@0 3080 lsl r1, r4, #2
mike@0 3081 add r0, r0, r1
mike@0 3082 ldr r0, [r0, #4]
mike@0 3083 set r1, _nilsym
mike@0 3084 ldr r1, [r1]
mike@0 3085 cmp r0, r1
mike@0 3086 beq .L314
mike@0 3087 @ print_string(", ");
mike@0 3088 mov r1, #2
mike@0 3089 set r0, g32
mike@0 3090 bl print_string
mike@0 3091 @ PrintTerm(mem[u+1+1], e, MAXPRIO);
mike@0 3092 mov r2, #2
mike@0 3093 ldr r1, [fp, #44]
mike@0 3094 set r0, _mem
mike@0 3095 lsl r3, r4, #2
mike@0 3096 add r0, r0, r3
mike@0 3097 ldr r0, [r0, #8]
mike@0 3098 bl _PrintTerm
mike@0 3099 @ u := Deref(mem[u+2+1], e)
mike@0 3100 ldr r1, [fp, #44]
mike@0 3101 set r0, _mem
mike@0 3102 lsl r2, r4, #2
mike@0 3103 add r0, r0, r2
mike@0 3104 ldr r0, [r0, #12]
mike@0 3105 bl _Deref
mike@0 3106 mov r4, r0
mike@0 3107 b .L312
mike@0 3108 .L314:
mike@0 3109 @ print_char('>');
mike@0 3110 mov r0, #62
mike@0 3111 bl print_char
mike@0 3112 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3113 .ltorg
mike@0 3114
mike@0 3115 @ proc PrintTerm(t: term; e: frame; prio: integer);
mike@0 3116 _PrintTerm:
mike@0 3117 mov ip, sp
mike@0 3118 stmfd sp!, {r0-r3}
mike@0 3119 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3120 mov fp, sp
mike@0 3121 @ t := Deref(t, e);
mike@0 3122 ldr r1, [fp, #44]
mike@0 3123 ldr r0, [fp, #40]
mike@0 3124 bl _Deref
mike@0 3125 str r0, [fp, #40]
mike@0 3126 @ if t = NULL then
mike@0 3127 cmp r0, #0
mike@0 3128 bne .L317
mike@0 3129 @ print_string("*null-term*")
mike@0 3130 mov r1, #11
mike@0 3131 set r0, g33
mike@0 3132 bl print_string
mike@0 3133 b .L315
mike@0 3134 .L317:
mike@0 3135 @ case lsr(mem[t], 8) of
mike@0 3136 set r0, _mem
mike@0 3137 ldr r1, [fp, #40]
mike@0 3138 lsl r1, r1, #2
mike@0 3139 add r0, r0, r1
mike@0 3140 ldr r0, [r0]
mike@0 3141 lsr r0, r0, #8
mike@0 3142 sub r0, r0, #1
mike@0 3143 cmp r0, #5
mike@0 3144 ldrlo pc, [pc, r0, LSL #2]
mike@0 3145 b .L319
mike@0 3146 .word .L321
mike@0 3147 .word .L322
mike@0 3148 .word .L323
mike@0 3149 .word .L324
mike@0 3150 .word .L325
mike@0 3151 .L321:
mike@0 3152 @ PrintCompound(t, e, prio)
mike@0 3153 ldr r2, [fp, #48]
mike@0 3154 ldr r1, [fp, #44]
mike@0 3155 ldr r0, [fp, #40]
mike@0 3156 bl _PrintCompound
mike@0 3157 b .L315
mike@0 3158 .L322:
mike@0 3159 @ print_num(mem[t+1])
mike@0 3160 set r0, _mem
mike@0 3161 ldr r1, [fp, #40]
mike@0 3162 lsl r1, r1, #2
mike@0 3163 add r0, r0, r1
mike@0 3164 ldr r0, [r0, #4]
mike@0 3165 bl print_num
mike@0 3166 b .L315
mike@0 3167 .L323:
mike@0 3168 @ print_char(''''); print_char(chr(mem[t+1])); print_char('''')
mike@0 3169 mov r0, #39
mike@0 3170 bl print_char
mike@0 3171 set r0, _mem
mike@0 3172 ldr r1, [fp, #40]
mike@0 3173 lsl r1, r1, #2
mike@0 3174 add r0, r0, r1
mike@0 3175 ldr r0, [r0, #4]
mike@0 3176 bl print_char
mike@0 3177 mov r0, #39
mike@0 3178 bl print_char
mike@0 3179 b .L315
mike@0 3180 .L324:
mike@0 3181 @ if (t >= gsp) then
mike@0 3182 ldr r0, [fp, #40]
mike@0 3183 set r1, _gsp
mike@0 3184 ldr r1, [r1]
mike@0 3185 cmp r0, r1
mike@0 3186 blt .L327
mike@0 3187 @ print_char('G'); print_num((MEMSIZE - t) div TERM_SIZE)
mike@0 3188 mov r0, #71
mike@0 3189 bl print_char
mike@0 3190 mov r1, #2
mike@0 3191 set r0, #25000
mike@0 3192 ldr r2, [fp, #40]
mike@0 3193 sub r0, r0, r2
mike@0 3194 bl int_div
mike@0 3195 bl print_num
mike@0 3196 b .L315
mike@0 3197 .L327:
mike@0 3198 @ print_char('L'); print_num((t - hp) div TERM_SIZE)
mike@0 3199 mov r0, #76
mike@0 3200 bl print_char
mike@0 3201 mov r1, #2
mike@0 3202 ldr r0, [fp, #40]
mike@0 3203 set r2, _hp
mike@0 3204 ldr r2, [r2]
mike@0 3205 sub r0, r0, r2
mike@0 3206 bl int_div
mike@0 3207 bl print_num
mike@0 3208 b .L315
mike@0 3209 .L325:
mike@0 3210 @ print_char('@'); print_num(mem[t+1])
mike@0 3211 mov r0, #64
mike@0 3212 bl print_char
mike@0 3213 set r0, _mem
mike@0 3214 ldr r1, [fp, #40]
mike@0 3215 lsl r1, r1, #2
mike@0 3216 add r0, r0, r1
mike@0 3217 ldr r0, [r0, #4]
mike@0 3218 bl print_num
mike@0 3219 b .L315
mike@0 3220 .L319:
mike@0 3221 @ print_string("*unknown-term(tag=");
mike@0 3222 mov r1, #18
mike@0 3223 set r0, g34
mike@0 3224 bl print_string
mike@0 3225 @ print_num(lsr(mem[t], 8)); print_string(")*")
mike@0 3226 set r0, _mem
mike@0 3227 ldr r1, [fp, #40]
mike@0 3228 lsl r1, r1, #2
mike@0 3229 add r0, r0, r1
mike@0 3230 ldr r0, [r0]
mike@0 3231 lsr r0, r0, #8
mike@0 3232 bl print_num
mike@0 3233 mov r1, #2
mike@0 3234 set r0, g35
mike@0 3235 bl print_string
mike@0 3236 .L315:
mike@0 3237 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3238 .ltorg
mike@0 3239
mike@0 3240 @ proc PrintClause(c: clause);
mike@0 3241 _PrintClause:
mike@0 3242 mov ip, sp
mike@0 3243 stmfd sp!, {r0-r1}
mike@0 3244 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3245 mov fp, sp
mike@0 3246 @ if c = NULL then
mike@0 3247 ldr r0, [fp, #40]
mike@0 3248 cmp r0, #0
mike@0 3249 bne .L331
mike@0 3250 @ print_string("*null-clause*"); newline();
mike@0 3251 mov r1, #13
mike@0 3252 set r0, g36
mike@0 3253 bl print_string
mike@0 3254 bl newline
mike@0 3255 b .L329
mike@0 3256 .L331:
mike@0 3257 @ if mem[c+3] <> NULL then
mike@0 3258 set r0, _mem
mike@0 3259 ldr r1, [fp, #40]
mike@0 3260 lsl r1, r1, #2
mike@0 3261 add r0, r0, r1
mike@0 3262 ldr r5, [r0, #12]
mike@0 3263 cmp r5, #0
mike@0 3264 beq .L335
mike@0 3265 @ PrintTerm(mem[c+3], NULL, MAXPRIO);
mike@0 3266 mov r2, #2
mike@0 3267 mov r1, #0
mike@0 3268 mov r0, r5
mike@0 3269 bl _PrintTerm
mike@0 3270 @ print_char(' ')
mike@0 3271 mov r0, #32
mike@0 3272 bl print_char
mike@0 3273 .L335:
mike@0 3274 @ print_string(":- ");
mike@0 3275 mov r1, #3
mike@0 3276 set r0, g37
mike@0 3277 bl print_string
mike@0 3278 @ if mem[(c+4)+1-1] <> NULL then
mike@0 3279 set r0, _mem
mike@0 3280 ldr r1, [fp, #40]
mike@0 3281 lsl r1, r1, #2
mike@0 3282 add r0, r0, r1
mike@0 3283 ldr r5, [r0, #16]
mike@0 3284 cmp r5, #0
mike@0 3285 beq .L338
mike@0 3286 @ PrintTerm(mem[(c+4)+1-1], NULL, MAXPRIO);
mike@0 3287 mov r2, #2
mike@0 3288 mov r1, #0
mike@0 3289 mov r0, r5
mike@0 3290 bl _PrintTerm
mike@0 3291 @ i := 2;
mike@0 3292 mov r4, #2
mike@0 3293 .L339:
mike@0 3294 @ while mem[(c+4)+i-1] <> NULL do
mike@0 3295 set r0, _mem
mike@0 3296 ldr r1, [fp, #40]
mike@0 3297 add r1, r1, #4
mike@0 3298 add r1, r1, r4
mike@0 3299 lsl r1, r1, #2
mike@0 3300 add r0, r0, r1
mike@0 3301 ldr r0, [r0, #-4]
mike@0 3302 cmp r0, #0
mike@0 3303 beq .L338
mike@0 3304 @ print_string(", ");
mike@0 3305 mov r1, #2
mike@0 3306 set r0, g38
mike@0 3307 bl print_string
mike@0 3308 @ PrintTerm(mem[(c+4)+i-1], NULL, MAXPRIO);
mike@0 3309 mov r2, #2
mike@0 3310 mov r1, #0
mike@0 3311 set r0, _mem
mike@0 3312 ldr r3, [fp, #40]
mike@0 3313 add r3, r3, #4
mike@0 3314 add r3, r3, r4
mike@0 3315 lsl r3, r3, #2
mike@0 3316 add r0, r0, r3
mike@0 3317 ldr r0, [r0, #-4]
mike@0 3318 bl _PrintTerm
mike@0 3319 @ i := i+1
mike@0 3320 add r4, r4, #1
mike@0 3321 b .L339
mike@0 3322 .L338:
mike@0 3323 @ print_char('.'); newline()
mike@0 3324 mov r0, #46
mike@0 3325 bl print_char
mike@0 3326 bl newline
mike@0 3327 .L329:
mike@0 3328 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3329 .ltorg
mike@0 3330
mike@0 3331 @ proc ShowError();
mike@0 3332 _ShowError:
mike@0 3333 mov ip, sp
mike@0 3334 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3335 mov fp, sp
mike@0 3336 @ errflag := true; errcount := errcount+1;
mike@0 3337 mov r0, #1
mike@0 3338 set r1, _errflag
mike@0 3339 strb r0, [r1]
mike@0 3340 set r4, _errcount
mike@0 3341 ldr r0, [r4]
mike@0 3342 add r0, r0, #1
mike@0 3343 str r0, [r4]
mike@0 3344 @ print_string("Line "); print_num(lineno); print_char(' ');
mike@0 3345 mov r1, #5
mike@0 3346 set r0, g39
mike@0 3347 bl print_string
mike@0 3348 set r0, _lineno
mike@0 3349 ldr r0, [r0]
mike@0 3350 bl print_num
mike@0 3351 mov r0, #32
mike@0 3352 bl print_char
mike@0 3353 @ print_string("Syntax error - ")
mike@0 3354 mov r1, #15
mike@0 3355 set r0, g40
mike@0 3356 bl print_string
mike@0 3357 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3358 .ltorg
mike@0 3359
mike@0 3360 @ proc Recover();
mike@0 3361 _Recover:
mike@0 3362 mov ip, sp
mike@0 3363 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3364 mov fp, sp
mike@0 3365 @ if errcount >= 20 then
mike@0 3366 set r0, _errcount
mike@0 3367 ldr r0, [r0]
mike@0 3368 cmp r0, #20
mike@0 3369 blt .L346
mike@0 3370 @ print_string("Too many errors: I am giving up"); newline(); exit(2)
mike@0 3371 mov r1, #31
mike@0 3372 set r0, g41
mike@0 3373 bl print_string
mike@0 3374 bl newline
mike@0 3375 mov r0, #2
mike@0 3376 bl exit
mike@0 3377 .L346:
mike@0 3378 @ if token <> DOT then
mike@0 3379 set r0, _token
mike@0 3380 ldr r0, [r0]
mike@0 3381 cmp r0, #10
mike@0 3382 beq .L343
mike@0 3383 .L350:
mike@0 3384 @ ch := GetChar()
mike@0 3385 bl _GetChar
mike@0 3386 mov r4, r0
mike@0 3387 cmp r4, #46
mike@0 3388 beq .L351
mike@0 3389 cmp r4, #127
mike@0 3390 bne .L350
mike@0 3391 .L351:
mike@0 3392 @ token := DOT
mike@0 3393 mov r0, #10
mike@0 3394 set r1, _token
mike@0 3395 str r0, [r1]
mike@0 3396 .L343:
mike@0 3397 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3398 .ltorg
mike@0 3399
mike@0 3400 @ proc Scan();
mike@0 3401 _Scan:
mike@0 3402 mov ip, sp
mike@0 3403 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3404 mov fp, sp
mike@0 3405 @ ch := GetChar(); token := 0;
mike@0 3406 bl _GetChar
mike@0 3407 mov r4, r0
mike@0 3408 mov r0, #0
mike@0 3409 set r1, _token
mike@0 3410 str r0, [r1]
mike@0 3411 .L354:
mike@0 3412 @ while token = 0 do
mike@0 3413 set r7, _token
mike@0 3414 ldr r0, [r7]
mike@0 3415 cmp r0, #0
mike@0 3416 bne .L353
mike@0 3417 @ if ch = ENDFILE then
mike@0 3418 cmp r4, #127
mike@0 3419 bne .L358
mike@0 3420 @ token := EOFTOK
mike@0 3421 mov r0, #14
mike@0 3422 str r0, [r7]
mike@0 3423 b .L354
mike@0 3424 .L358:
mike@0 3425 @ elsif (ch = ' ') or (ch = TAB) or (ch = ENDLINE) then
mike@0 3426 cmp r4, #32
mike@0 3427 beq .L360
mike@0 3428 cmp r4, #9
mike@0 3429 beq .L360
mike@0 3430 cmp r4, #10
mike@0 3431 bne .L361
mike@0 3432 .L360:
mike@0 3433 @ ch := GetChar()
mike@0 3434 bl _GetChar
mike@0 3435 mov r4, r0
mike@0 3436 b .L354
mike@0 3437 .L361:
mike@0 3438 @ elsif ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) then
mike@0 3439 cmp r4, #65
mike@0 3440 blt .L450
mike@0 3441 cmp r4, #90
mike@0 3442 ble .L363
mike@0 3443 .L450:
mike@0 3444 cmp r4, #95
mike@0 3445 beq .L363
mike@0 3446 cmp r4, #97
mike@0 3447 blt .L364
mike@0 3448 cmp r4, #122
mike@0 3449 bgt .L364
mike@0 3450 .L363:
mike@0 3451 @ if (((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) then
mike@0 3452 cmp r4, #65
mike@0 3453 blt .L431
mike@0 3454 cmp r4, #90
mike@0 3455 ble .L428
mike@0 3456 .L431:
mike@0 3457 cmp r4, #95
mike@0 3458 bne .L429
mike@0 3459 .L428:
mike@0 3460 @ token := VARIABLE
mike@0 3461 mov r0, #2
mike@0 3462 set r1, _token
mike@0 3463 str r0, [r1]
mike@0 3464 b .L430
mike@0 3465 .L429:
mike@0 3466 @ token := IDENT
mike@0 3467 mov r0, #1
mike@0 3468 set r1, _token
mike@0 3469 str r0, [r1]
mike@0 3470 .L430:
mike@0 3471 @ i := 0;
mike@0 3472 mov r6, #0
mike@0 3473 .L433:
mike@0 3474 @ while ((((ch >= 'A') and (ch <= 'Z')) or (ch = '_')) or ((ch >= 'a') and (ch <= 'z'))) or ((ch >= '0') and (ch <= '9')) do
mike@0 3475 cmp r4, #65
mike@0 3476 blt .L443
mike@0 3477 cmp r4, #90
mike@0 3478 ble .L434
mike@0 3479 .L443:
mike@0 3480 cmp r4, #95
mike@0 3481 beq .L434
mike@0 3482 cmp r4, #97
mike@0 3483 blt .L439
mike@0 3484 cmp r4, #122
mike@0 3485 ble .L434
mike@0 3486 .L439:
mike@0 3487 cmp r4, #48
mike@0 3488 blt .L435
mike@0 3489 cmp r4, #57
mike@0 3490 bgt .L435
mike@0 3491 .L434:
mike@0 3492 @ if i > MAXSTRING then
mike@0 3493 cmp r6, #128
mike@0 3494 ble .L438
mike@0 3495 @ newline(); print_string("Panic: "); print_string("identifier too long"); newline(); exit(2)
mike@0 3496 bl newline
mike@0 3497 mov r1, #7
mike@0 3498 set r0, g42
mike@0 3499 bl print_string
mike@0 3500 mov r1, #19
mike@0 3501 set r0, g43
mike@0 3502 bl print_string
mike@0 3503 bl newline
mike@0 3504 mov r0, #2
mike@0 3505 bl exit
mike@0 3506 .L438:
mike@0 3507 @ toksval[i] := ch; ch := GetChar(); i := i+1
mike@0 3508 set r0, _toksval
mike@0 3509 add r0, r0, r6
mike@0 3510 strb r4, [r0]
mike@0 3511 bl _GetChar
mike@0 3512 mov r4, r0
mike@0 3513 add r6, r6, #1
mike@0 3514 b .L433
mike@0 3515 .L435:
mike@0 3516 @ PushBack(ch);
mike@0 3517 mov r0, r4
mike@0 3518 bl _PushBack
mike@0 3519 @ toksval[i] := ENDSTR; tokval := Lookup(toksval);
mike@0 3520 set r7, _toksval
mike@0 3521 mov r0, #0
mike@0 3522 add r1, r7, r6
mike@0 3523 strb r0, [r1]
mike@0 3524 mov r0, r7
mike@0 3525 bl _Lookup
mike@0 3526 set r1, _tokval
mike@0 3527 str r0, [r1]
mike@0 3528 @ if tokval = notsym then token := NEGATE end
mike@0 3529 set r1, _notsym
mike@0 3530 ldr r1, [r1]
mike@0 3531 cmp r0, r1
mike@0 3532 bne .L354
mike@0 3533 mov r0, #13
mike@0 3534 set r1, _token
mike@0 3535 str r0, [r1]
mike@0 3536 b .L354
mike@0 3537 .L364:
mike@0 3538 @ elsif ((ch >= '0') and (ch <= '9')) then
mike@0 3539 cmp r4, #48
mike@0 3540 blt .L367
mike@0 3541 cmp r4, #57
mike@0 3542 bgt .L367
mike@0 3543 @ token := NUMBER; tokival := 0;
mike@0 3544 mov r0, #3
mike@0 3545 set r1, _token
mike@0 3546 str r0, [r1]
mike@0 3547 mov r0, #0
mike@0 3548 set r1, _tokival
mike@0 3549 str r0, [r1]
mike@0 3550 .L423:
mike@0 3551 @ while ((ch >= '0') and (ch <= '9')) do
mike@0 3552 cmp r4, #48
mike@0 3553 blt .L425
mike@0 3554 cmp r4, #57
mike@0 3555 bgt .L425
mike@0 3556 @ tokival := 10 * tokival + (ord(ch) - ord('0'));
mike@0 3557 set r7, _tokival
mike@0 3558 ldr r0, [r7]
mike@0 3559 mov r1, #10
mike@0 3560 mul r0, r0, r1
mike@0 3561 sub r1, r4, #48
mike@0 3562 add r0, r0, r1
mike@0 3563 str r0, [r7]
mike@0 3564 @ ch := GetChar()
mike@0 3565 bl _GetChar
mike@0 3566 mov r4, r0
mike@0 3567 b .L423
mike@0 3568 .L425:
mike@0 3569 @ PushBack(ch)
mike@0 3570 mov r0, r4
mike@0 3571 bl _PushBack
mike@0 3572 b .L354
mike@0 3573 .L367:
mike@0 3574 @ case ch of
mike@0 3575 sub r0, r4, #33
mike@0 3576 cmp r0, #30
mike@0 3577 ldrlo pc, [pc, r0, LSL #2]
mike@0 3578 b .L369
mike@0 3579 .word .L379
mike@0 3580 .word .L383
mike@0 3581 .word .L378
mike@0 3582 .word .L369
mike@0 3583 .word .L369
mike@0 3584 .word .L369
mike@0 3585 .word .L382
mike@0 3586 .word .L371
mike@0 3587 .word .L372
mike@0 3588 .word .L369
mike@0 3589 .word .L369
mike@0 3590 .word .L373
mike@0 3591 .word .L369
mike@0 3592 .word .L374
mike@0 3593 .word .L380
mike@0 3594 .word .L369
mike@0 3595 .word .L369
mike@0 3596 .word .L369
mike@0 3597 .word .L369
mike@0 3598 .word .L369
mike@0 3599 .word .L369
mike@0 3600 .word .L369
mike@0 3601 .word .L369
mike@0 3602 .word .L369
mike@0 3603 .word .L369
mike@0 3604 .word .L381
mike@0 3605 .word .L369
mike@0 3606 .word .L376
mike@0 3607 .word .L375
mike@0 3608 .word .L377
mike@0 3609 .L371:
mike@0 3610 @ '(': token := LPAR
mike@0 3611 mov r0, #7
mike@0 3612 set r1, _token
mike@0 3613 str r0, [r1]
mike@0 3614 b .L354
mike@0 3615 .L372:
mike@0 3616 @ | ')': token := RPAR
mike@0 3617 mov r0, #8
mike@0 3618 set r1, _token
mike@0 3619 str r0, [r1]
mike@0 3620 b .L354
mike@0 3621 .L373:
mike@0 3622 @ | ',': token := COMMA
mike@0 3623 mov r0, #9
mike@0 3624 set r1, _token
mike@0 3625 str r0, [r1]
mike@0 3626 b .L354
mike@0 3627 .L374:
mike@0 3628 @ | '.': token := DOT
mike@0 3629 mov r0, #10
mike@0 3630 set r1, _token
mike@0 3631 str r0, [r1]
mike@0 3632 b .L354
mike@0 3633 .L375:
mike@0 3634 @ | '=': token := EQUAL
mike@0 3635 mov r0, #12
mike@0 3636 set r1, _token
mike@0 3637 str r0, [r1]
mike@0 3638 b .L354
mike@0 3639 .L376:
mike@0 3640 @ | '<': token := LANGLE
mike@0 3641 mov r0, #15
mike@0 3642 set r1, _token
mike@0 3643 str r0, [r1]
mike@0 3644 b .L354
mike@0 3645 .L377:
mike@0 3646 @ | '>': token := RANGLE
mike@0 3647 mov r0, #16
mike@0 3648 set r1, _token
mike@0 3649 str r0, [r1]
mike@0 3650 b .L354
mike@0 3651 .L378:
mike@0 3652 @ | '#': token := HASH
mike@0 3653 mov r0, #17
mike@0 3654 set r1, _token
mike@0 3655 str r0, [r1]
mike@0 3656 b .L354
mike@0 3657 .L379:
mike@0 3658 @ | '!': token := IDENT; tokval := cutsym
mike@0 3659 mov r0, #1
mike@0 3660 set r1, _token
mike@0 3661 str r0, [r1]
mike@0 3662 set r0, _cutsym
mike@0 3663 ldr r0, [r0]
mike@0 3664 set r1, _tokval
mike@0 3665 str r0, [r1]
mike@0 3666 b .L354
mike@0 3667 .L380:
mike@0 3668 @ ch := GetChar();
mike@0 3669 bl _GetChar
mike@0 3670 mov r4, r0
mike@0 3671 @ if ch <> '*' then
mike@0 3672 cmp r4, #42
mike@0 3673 beq .L388
mike@0 3674 @ if not errflag then ShowError(); print_string("bad token /"); newline(); Recover() end
mike@0 3675 set r0, _errflag
mike@0 3676 ldrb r0, [r0]
mike@0 3677 cmp r0, #0
mike@0 3678 bne .L354
mike@0 3679 bl _ShowError
mike@0 3680 mov r1, #11
mike@0 3681 set r0, g44
mike@0 3682 bl print_string
mike@0 3683 bl newline
mike@0 3684 bl _Recover
mike@0 3685 b .L354
mike@0 3686 .L388:
mike@0 3687 @ ch2 := ' '; ch := GetChar();
mike@0 3688 mov r5, #32
mike@0 3689 bl _GetChar
mike@0 3690 mov r4, r0
mike@0 3691 .L390:
mike@0 3692 @ while (ch <> ENDFILE) and not ((ch2 = '*') and (ch = '/')) do
mike@0 3693 cmp r4, #127
mike@0 3694 beq .L392
mike@0 3695 cmp r5, #42
mike@0 3696 bne .L391
mike@0 3697 cmp r4, #47
mike@0 3698 beq .L392
mike@0 3699 .L391:
mike@0 3700 @ ch2 := ch; ch := GetChar()
mike@0 3701 mov r5, r4
mike@0 3702 bl _GetChar
mike@0 3703 mov r4, r0
mike@0 3704 b .L390
mike@0 3705 .L392:
mike@0 3706 @ if ch = ENDFILE then
mike@0 3707 cmp r4, #127
mike@0 3708 bne .L396
mike@0 3709 @ if not errflag then ShowError(); print_string("end of file in comment"); newline(); Recover() end
mike@0 3710 set r0, _errflag
mike@0 3711 ldrb r0, [r0]
mike@0 3712 cmp r0, #0
mike@0 3713 bne .L354
mike@0 3714 bl _ShowError
mike@0 3715 mov r1, #22
mike@0 3716 set r0, g45
mike@0 3717 bl print_string
mike@0 3718 bl newline
mike@0 3719 bl _Recover
mike@0 3720 b .L354
mike@0 3721 .L396:
mike@0 3722 @ ch := GetChar()
mike@0 3723 bl _GetChar
mike@0 3724 mov r4, r0
mike@0 3725 b .L354
mike@0 3726 .L381:
mike@0 3727 @ ch := GetChar();
mike@0 3728 bl _GetChar
mike@0 3729 mov r4, r0
mike@0 3730 @ if ch = '-' then
mike@0 3731 cmp r4, #45
mike@0 3732 bne .L405
mike@0 3733 @ token := ARROW
mike@0 3734 mov r0, #6
mike@0 3735 set r1, _token
mike@0 3736 str r0, [r1]
mike@0 3737 b .L354
mike@0 3738 .L405:
mike@0 3739 @ PushBack(ch); token := COLON
mike@0 3740 mov r0, r4
mike@0 3741 bl _PushBack
mike@0 3742 mov r0, #11
mike@0 3743 set r1, _token
mike@0 3744 str r0, [r1]
mike@0 3745 b .L354
mike@0 3746 .L382:
mike@0 3747 @ token := CHCON; tokival := ord(GetChar()); ch := GetChar();
mike@0 3748 mov r0, #4
mike@0 3749 set r1, _token
mike@0 3750 str r0, [r1]
mike@0 3751 bl _GetChar
mike@0 3752 set r1, _tokival
mike@0 3753 str r0, [r1]
mike@0 3754 bl _GetChar
mike@0 3755 mov r4, r0
mike@0 3756 @ if ch <> '''' then if not errflag then ShowError(); print_string("missing quote"); newline(); Recover() end end
mike@0 3757 cmp r4, #39
mike@0 3758 beq .L354
mike@0 3759 set r0, _errflag
mike@0 3760 ldrb r0, [r0]
mike@0 3761 cmp r0, #0
mike@0 3762 bne .L354
mike@0 3763 bl _ShowError
mike@0 3764 mov r1, #13
mike@0 3765 set r0, g46
mike@0 3766 bl print_string
mike@0 3767 bl newline
mike@0 3768 bl _Recover
mike@0 3769 b .L354
mike@0 3770 .L383:
mike@0 3771 @ token := STRCON; i := 0; ch := GetChar();
mike@0 3772 mov r0, #5
mike@0 3773 set r1, _token
mike@0 3774 str r0, [r1]
mike@0 3775 mov r6, #0
mike@0 3776 bl _GetChar
mike@0 3777 mov r4, r0
mike@0 3778 .L413:
mike@0 3779 @ while (ch <> '"') and (ch <> ENDLINE) do
mike@0 3780 cmp r4, #34
mike@0 3781 beq .L415
mike@0 3782 cmp r4, #10
mike@0 3783 beq .L415
mike@0 3784 @ toksval[i] := ch; ch := GetChar(); i := i+1
mike@0 3785 set r0, _toksval
mike@0 3786 add r0, r0, r6
mike@0 3787 strb r4, [r0]
mike@0 3788 bl _GetChar
mike@0 3789 mov r4, r0
mike@0 3790 add r6, r6, #1
mike@0 3791 b .L413
mike@0 3792 .L415:
mike@0 3793 @ toksval[i] := ENDSTR;
mike@0 3794 mov r0, #0
mike@0 3795 set r1, _toksval
mike@0 3796 add r1, r1, r6
mike@0 3797 strb r0, [r1]
mike@0 3798 @ if ch = ENDLINE then
mike@0 3799 cmp r4, #10
mike@0 3800 bne .L354
mike@0 3801 @ if not errflag then ShowError(); print_string("unterminated string"); newline(); Recover() end;
mike@0 3802 set r0, _errflag
mike@0 3803 ldrb r0, [r0]
mike@0 3804 cmp r0, #0
mike@0 3805 bne .L422
mike@0 3806 bl _ShowError
mike@0 3807 mov r1, #19
mike@0 3808 set r0, g47
mike@0 3809 bl print_string
mike@0 3810 bl newline
mike@0 3811 bl _Recover
mike@0 3812 .L422:
mike@0 3813 @ PushBack(ch)
mike@0 3814 mov r0, r4
mike@0 3815 bl _PushBack
mike@0 3816 b .L354
mike@0 3817 .L369:
mike@0 3818 @ if not errflag then ShowError(); print_string("illegal character"); newline(); Recover() end; print_char(ch); newline()
mike@0 3819 set r0, _errflag
mike@0 3820 ldrb r0, [r0]
mike@0 3821 cmp r0, #0
mike@0 3822 bne .L386
mike@0 3823 bl _ShowError
mike@0 3824 mov r1, #17
mike@0 3825 set r0, g48
mike@0 3826 bl print_string
mike@0 3827 bl newline
mike@0 3828 bl _Recover
mike@0 3829 .L386:
mike@0 3830 mov r0, r4
mike@0 3831 bl print_char
mike@0 3832 bl newline
mike@0 3833 b .L354
mike@0 3834 .L353:
mike@0 3835 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3836 .ltorg
mike@0 3837
mike@0 3838 @ proc PrintToken(t: integer);
mike@0 3839 _PrintToken:
mike@0 3840 mov ip, sp
mike@0 3841 stmfd sp!, {r0-r1}
mike@0 3842 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3843 mov fp, sp
mike@0 3844 @ case t of
mike@0 3845 ldr r0, [fp, #40]
mike@0 3846 sub r0, r0, #1
mike@0 3847 cmp r0, #17
mike@0 3848 ldrlo pc, [pc, r0, LSL #2]
mike@0 3849 b .L455
mike@0 3850 .word .L457
mike@0 3851 .word .L458
mike@0 3852 .word .L459
mike@0 3853 .word .L460
mike@0 3854 .word .L468
mike@0 3855 .word .L461
mike@0 3856 .word .L462
mike@0 3857 .word .L463
mike@0 3858 .word .L464
mike@0 3859 .word .L465
mike@0 3860 .word .L466
mike@0 3861 .word .L467
mike@0 3862 .word .L455
mike@0 3863 .word .L455
mike@0 3864 .word .L469
mike@0 3865 .word .L470
mike@0 3866 .word .L471
mike@0 3867 .L457:
mike@0 3868 @ print_string("identifier "); WriteString(symtab[tokval].name)
mike@0 3869 mov r1, #11
mike@0 3870 set r0, g49
mike@0 3871 bl print_string
mike@0 3872 set r0, _symtab
mike@0 3873 set r1, _tokval
mike@0 3874 ldr r1, [r1]
mike@0 3875 lsl r1, r1, #4
mike@0 3876 add r0, r0, r1
mike@0 3877 ldr r0, [r0]
mike@0 3878 bl _WriteString
mike@0 3879 b .L454
mike@0 3880 .L458:
mike@0 3881 @ print_string("variable "); WriteString(symtab[tokval].name)
mike@0 3882 mov r1, #9
mike@0 3883 set r0, g50
mike@0 3884 bl print_string
mike@0 3885 set r0, _symtab
mike@0 3886 set r1, _tokval
mike@0 3887 ldr r1, [r1]
mike@0 3888 lsl r1, r1, #4
mike@0 3889 add r0, r0, r1
mike@0 3890 ldr r0, [r0]
mike@0 3891 bl _WriteString
mike@0 3892 b .L454
mike@0 3893 .L459:
mike@0 3894 @ | NUMBER: print_string("number");
mike@0 3895 mov r1, #6
mike@0 3896 set r0, g51
mike@0 3897 bl print_string
mike@0 3898 b .L454
mike@0 3899 .L460:
mike@0 3900 @ | CHCON: print_string("char constant");
mike@0 3901 mov r1, #13
mike@0 3902 set r0, g52
mike@0 3903 bl print_string
mike@0 3904 b .L454
mike@0 3905 .L461:
mike@0 3906 @ | ARROW: print_string(":-");
mike@0 3907 mov r1, #2
mike@0 3908 set r0, g53
mike@0 3909 bl print_string
mike@0 3910 b .L454
mike@0 3911 .L462:
mike@0 3912 @ | LPAR: print_string("(");
mike@0 3913 mov r1, #1
mike@0 3914 set r0, g54
mike@0 3915 bl print_string
mike@0 3916 b .L454
mike@0 3917 .L463:
mike@0 3918 @ | RPAR: print_string(")");
mike@0 3919 mov r1, #1
mike@0 3920 set r0, g55
mike@0 3921 bl print_string
mike@0 3922 b .L454
mike@0 3923 .L464:
mike@0 3924 @ | COMMA: print_string(",");
mike@0 3925 mov r1, #1
mike@0 3926 set r0, g56
mike@0 3927 bl print_string
mike@0 3928 b .L454
mike@0 3929 .L465:
mike@0 3930 @ | DOT: print_string(".");
mike@0 3931 mov r1, #1
mike@0 3932 set r0, g57
mike@0 3933 bl print_string
mike@0 3934 b .L454
mike@0 3935 .L466:
mike@0 3936 @ | COLON: print_string(":");
mike@0 3937 mov r1, #1
mike@0 3938 set r0, g58
mike@0 3939 bl print_string
mike@0 3940 b .L454
mike@0 3941 .L467:
mike@0 3942 @ | EQUAL: print_string("=");
mike@0 3943 mov r1, #1
mike@0 3944 set r0, g59
mike@0 3945 bl print_string
mike@0 3946 b .L454
mike@0 3947 .L468:
mike@0 3948 @ | STRCON: print_string("string constant")
mike@0 3949 mov r1, #15
mike@0 3950 set r0, g60
mike@0 3951 bl print_string
mike@0 3952 b .L454
mike@0 3953 .L469:
mike@0 3954 @ | LANGLE: print_string("<")
mike@0 3955 mov r1, #1
mike@0 3956 set r0, g61
mike@0 3957 bl print_string
mike@0 3958 b .L454
mike@0 3959 .L470:
mike@0 3960 @ | RANGLE: print_string(">")
mike@0 3961 mov r1, #1
mike@0 3962 set r0, g62
mike@0 3963 bl print_string
mike@0 3964 b .L454
mike@0 3965 .L471:
mike@0 3966 @ | HASH: print_string("#")
mike@0 3967 mov r1, #1
mike@0 3968 set r0, g63
mike@0 3969 bl print_string
mike@0 3970 b .L454
mike@0 3971 .L455:
mike@0 3972 @ print_string("unknown token")
mike@0 3973 mov r1, #13
mike@0 3974 set r0, g64
mike@0 3975 bl print_string
mike@0 3976 .L454:
mike@0 3977 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 3978 .ltorg
mike@0 3979
mike@0 3980 @ proc VarRep(name: symbol): term;
mike@0 3981 _VarRep:
mike@0 3982 mov ip, sp
mike@0 3983 stmfd sp!, {r0-r1}
mike@0 3984 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 3985 mov fp, sp
mike@0 3986 @ if nvars = MAXARITY then newline(); print_string("Panic: "); print_string("too many variables"); newline(); exit(2) end;
mike@0 3987 set r0, _nvars
mike@0 3988 ldr r0, [r0]
mike@0 3989 cmp r0, #63
mike@0 3990 bne .L475
mike@0 3991 bl newline
mike@0 3992 mov r1, #7
mike@0 3993 set r0, g65
mike@0 3994 bl print_string
mike@0 3995 mov r1, #18
mike@0 3996 set r0, g66
mike@0 3997 bl print_string
mike@0 3998 bl newline
mike@0 3999 mov r0, #2
mike@0 4000 bl exit
mike@0 4001 .L475:
mike@0 4002 @ i := 1; vartable[nvars+1] := name; (* sentinel *)
mike@0 4003 mov r4, #1
mike@0 4004 ldr r0, [fp, #40]
mike@0 4005 set r1, _vartable
mike@0 4006 set r2, _nvars
mike@0 4007 ldr r2, [r2]
mike@0 4008 lsl r2, r2, #2
mike@0 4009 add r1, r1, r2
mike@0 4010 str r0, [r1, #4]
mike@0 4011 .L476:
mike@0 4012 @ while name <> vartable[i] do i := i+1 end;
mike@0 4013 ldr r0, [fp, #40]
mike@0 4014 set r1, _vartable
mike@0 4015 lsl r2, r4, #2
mike@0 4016 add r1, r1, r2
mike@0 4017 ldr r1, [r1]
mike@0 4018 cmp r0, r1
mike@0 4019 beq .L478
mike@0 4020 add r4, r4, #1
mike@0 4021 b .L476
mike@0 4022 .L478:
mike@0 4023 @ if i = nvars+1 then nvars := nvars+1 end;
mike@0 4024 set r5, _nvars
mike@0 4025 ldr r0, [r5]
mike@0 4026 add r6, r0, #1
mike@0 4027 cmp r4, r6
mike@0 4028 bne .L481
mike@0 4029 str r6, [r5]
mike@0 4030 .L481:
mike@0 4031 @ return MakeRef(i)
mike@0 4032 mov r0, r4
mike@0 4033 bl _MakeRef
mike@0 4034 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 4035 .ltorg
mike@0 4036
mike@0 4037 @ proc ShowAnswer(bindings: frame);
mike@0 4038 _ShowAnswer:
mike@0 4039 mov ip, sp
mike@0 4040 stmfd sp!, {r0-r1}
mike@0 4041 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 4042 mov fp, sp
mike@0 4043 sub sp, sp, #8
mike@0 4044 @ if nvars = 0 then
mike@0 4045 set r0, _nvars
mike@0 4046 ldr r0, [r0]
mike@0 4047 cmp r0, #0
mike@0 4048 bne .L484
mike@0 4049 @ print_string("yes"); newline()
mike@0 4050 mov r1, #3
mike@0 4051 set r0, g67
mike@0 4052 bl print_string
mike@0 4053 bl newline
mike@0 4054 b .L482
mike@0 4055 .L484:
mike@0 4056 @ for i := 1 to nvars do
mike@0 4057 mov r4, #1
mike@0 4058 set r0, _nvars
mike@0 4059 ldr r0, [r0]
mike@0 4060 str r0, [fp, #-4]
mike@0 4061 .L486:
mike@0 4062 ldr r0, [fp, #-4]
mike@0 4063 cmp r4, r0
mike@0 4064 bgt .L482
mike@0 4065 @ WriteString(symtab[vartable[i]].name); print_string(" = ");
mike@0 4066 set r0, _symtab
mike@0 4067 set r1, _vartable
mike@0 4068 lsl r2, r4, #2
mike@0 4069 add r1, r1, r2
mike@0 4070 ldr r1, [r1]
mike@0 4071 lsl r1, r1, #4
mike@0 4072 add r0, r0, r1
mike@0 4073 ldr r0, [r0]
mike@0 4074 bl _WriteString
mike@0 4075 mov r1, #3
mike@0 4076 set r0, g68
mike@0 4077 bl print_string
mike@0 4078 @ PrintTerm((bindings+7+(i-1)*TERM_SIZE), NULL, EQPRIO-1);
mike@0 4079 mov r2, #1
mike@0 4080 mov r1, #0
mike@0 4081 ldr r0, [fp, #40]
mike@0 4082 add r0, r0, #7
mike@0 4083 lsl r3, r4, #1
mike@0 4084 sub r3, r3, #2
mike@0 4085 add r0, r0, r3
mike@0 4086 bl _PrintTerm
mike@0 4087 @ newline()
mike@0 4088 bl newline
mike@0 4089 add r4, r4, #1
mike@0 4090 b .L486
mike@0 4091 .L482:
mike@0 4092 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 4093 .ltorg
mike@0 4094
mike@0 4095 @ proc Eat(expected: integer);
mike@0 4096 _Eat:
mike@0 4097 mov ip, sp
mike@0 4098 stmfd sp!, {r0-r1}
mike@0 4099 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 4100 mov fp, sp
mike@0 4101 @ if token = expected then
mike@0 4102 set r0, _token
mike@0 4103 ldr r4, [r0]
mike@0 4104 ldr r0, [fp, #40]
mike@0 4105 cmp r4, r0
mike@0 4106 bne .L490
mike@0 4107 @ if token <> DOT then Scan() end
mike@0 4108 cmp r4, #10
mike@0 4109 beq .L488
mike@0 4110 bl _Scan
mike@0 4111 b .L488
mike@0 4112 .L490:
mike@0 4113 @ elsif not errflag then
mike@0 4114 set r0, _errflag
mike@0 4115 ldrb r0, [r0]
mike@0 4116 cmp r0, #0
mike@0 4117 bne .L488
mike@0 4118 @ ShowError();
mike@0 4119 bl _ShowError
mike@0 4120 @ print_string("expected "); PrintToken(expected);
mike@0 4121 mov r1, #9
mike@0 4122 set r0, g69
mike@0 4123 bl print_string
mike@0 4124 ldr r0, [fp, #40]
mike@0 4125 bl _PrintToken
mike@0 4126 @ print_string(", found "); PrintToken(token); newline();
mike@0 4127 mov r1, #8
mike@0 4128 set r0, g70
mike@0 4129 bl print_string
mike@0 4130 set r0, _token
mike@0 4131 ldr r0, [r0]
mike@0 4132 bl _PrintToken
mike@0 4133 bl newline
mike@0 4134 @ Recover()
mike@0 4135 bl _Recover
mike@0 4136 .L488:
mike@0 4137 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 4138 .ltorg
mike@0 4139
mike@0 4140 @ proc ParseCompound(): term;
mike@0 4141 _ParseCompound:
mike@0 4142 mov ip, sp
mike@0 4143 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 4144 mov fp, sp
mike@0 4145 sub sp, sp, #256
mike@0 4146 @ fun := tokval; n := 0; Eat(IDENT);
mike@0 4147 set r0, _tokval
mike@0 4148 ldr r4, [r0]
mike@0 4149 mov r5, #0
mike@0 4150 mov r0, #1
mike@0 4151 bl _Eat
mike@0 4152 @ if token = LPAR then
mike@0 4153 set r0, _token
mike@0 4154 ldr r0, [r0]
mike@0 4155 cmp r0, #7
mike@0 4156 bne .L501
mike@0 4157 @ Eat(LPAR); n := 1; arg[1] := ParseTerm();
mike@0 4158 mov r0, #7
mike@0 4159 bl _Eat
mike@0 4160 mov r5, #1
mike@0 4161 bl _ParseTerm
mike@0 4162 str r0, [fp, #-252]
mike@0 4163 .L502:
mike@0 4164 @ while token = COMMA do
mike@0 4165 set r0, _token
mike@0 4166 ldr r0, [r0]
mike@0 4167 cmp r0, #9
mike@0 4168 bne .L504
mike@0 4169 @ Eat(COMMA); n := n+1; arg[n] := ParseTerm()
mike@0 4170 mov r0, #9
mike@0 4171 bl _Eat
mike@0 4172 add r5, r5, #1
mike@0 4173 bl _ParseTerm
mike@0 4174 add r1, fp, #-256
mike@0 4175 lsl r2, r5, #2
mike@0 4176 add r1, r1, r2
mike@0 4177 str r0, [r1]
mike@0 4178 b .L502
mike@0 4179 .L504:
mike@0 4180 @ Eat(RPAR)
mike@0 4181 mov r0, #8
mike@0 4182 bl _Eat
mike@0 4183 .L501:
mike@0 4184 @ if symtab[fun].arity = -1 then
mike@0 4185 set r0, _symtab
mike@0 4186 lsl r1, r4, #4
mike@0 4187 add r0, r0, r1
mike@0 4188 add r6, r0, #4
mike@0 4189 ldr r0, [r6]
mike@0 4190 mov r1, #-1
mike@0 4191 cmp r0, r1
mike@0 4192 bne .L506
mike@0 4193 @ symtab[fun].arity := n
mike@0 4194 str r5, [r6]
mike@0 4195 b .L507
mike@0 4196 .L506:
mike@0 4197 @ elsif symtab[fun].arity <> n then
mike@0 4198 set r0, _symtab
mike@0 4199 lsl r1, r4, #4
mike@0 4200 add r0, r0, r1
mike@0 4201 ldr r0, [r0, #4]
mike@0 4202 cmp r0, r5
mike@0 4203 beq .L507
mike@0 4204 @ if not errflag then ShowError(); print_string("wrong number of args"); newline(); Recover() end
mike@0 4205 set r0, _errflag
mike@0 4206 ldrb r0, [r0]
mike@0 4207 cmp r0, #0
mike@0 4208 bne .L507
mike@0 4209 bl _ShowError
mike@0 4210 mov r1, #20
mike@0 4211 set r0, g71
mike@0 4212 bl print_string
mike@0 4213 bl newline
mike@0 4214 bl _Recover
mike@0 4215 .L507:
mike@0 4216 @ return MakeCompound(fun, arg)
mike@0 4217 add r1, fp, #-256
mike@0 4218 mov r0, r4
mike@0 4219 bl _MakeCompound
mike@0 4220 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 4221 .ltorg
mike@0 4222
mike@0 4223 @ proc ParsePrimary(): term;
mike@0 4224 _ParsePrimary:
mike@0 4225 mov ip, sp
mike@0 4226 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 4227 mov fp, sp
mike@0 4228 @ if token = IDENT then t := ParseCompound()
mike@0 4229 set r0, _token
mike@0 4230 ldr r0, [r0]
mike@0 4231 cmp r0, #1
mike@0 4232 bne .L516
mike@0 4233 bl _ParseCompound
mike@0 4234 mov r4, r0
mike@0 4235 b .L517
mike@0 4236 .L516:
mike@0 4237 @ elsif token = VARIABLE then
mike@0 4238 set r0, _token
mike@0 4239 ldr r0, [r0]
mike@0 4240 cmp r0, #2
mike@0 4241 bne .L519
mike@0 4242 @ t := VarRep(tokval); Eat(VARIABLE)
mike@0 4243 set r0, _tokval
mike@0 4244 ldr r0, [r0]
mike@0 4245 bl _VarRep
mike@0 4246 mov r4, r0
mike@0 4247 mov r0, #2
mike@0 4248 bl _Eat
mike@0 4249 b .L517
mike@0 4250 .L519:
mike@0 4251 @ elsif token = NUMBER then
mike@0 4252 set r0, _token
mike@0 4253 ldr r0, [r0]
mike@0 4254 cmp r0, #3
mike@0 4255 bne .L522
mike@0 4256 @ t := MakeInt(tokival); Eat(NUMBER)
mike@0 4257 set r0, _tokival
mike@0 4258 ldr r0, [r0]
mike@0 4259 bl _MakeInt
mike@0 4260 mov r4, r0
mike@0 4261 mov r0, #3
mike@0 4262 bl _Eat
mike@0 4263 b .L517
mike@0 4264 .L522:
mike@0 4265 @ elsif token = CHCON then
mike@0 4266 set r0, _token
mike@0 4267 ldr r0, [r0]
mike@0 4268 cmp r0, #4
mike@0 4269 bne .L525
mike@0 4270 @ t := MakeChar(chr(tokival)); Eat(CHCON)
mike@0 4271 set r0, _tokival
mike@0 4272 ldr r0, [r0]
mike@0 4273 bl _MakeChar
mike@0 4274 mov r4, r0
mike@0 4275 mov r0, #4
mike@0 4276 bl _Eat
mike@0 4277 b .L517
mike@0 4278 .L525:
mike@0 4279 @ elsif token = STRCON then
mike@0 4280 set r0, _token
mike@0 4281 ldr r0, [r0]
mike@0 4282 cmp r0, #5
mike@0 4283 bne .L528
mike@0 4284 @ t := MakeString(toksval); Eat(STRCON)
mike@0 4285 set r0, _toksval
mike@0 4286 bl _MakeString
mike@0 4287 mov r4, r0
mike@0 4288 mov r0, #5
mike@0 4289 bl _Eat
mike@0 4290 b .L517
mike@0 4291 .L528:
mike@0 4292 @ elsif token = LPAR then
mike@0 4293 set r0, _token
mike@0 4294 ldr r0, [r0]
mike@0 4295 cmp r0, #7
mike@0 4296 bne .L531
mike@0 4297 @ Eat(LPAR); t := ParseTerm(); Eat(RPAR)
mike@0 4298 mov r0, #7
mike@0 4299 bl _Eat
mike@0 4300 bl _ParseTerm
mike@0 4301 mov r4, r0
mike@0 4302 mov r0, #8
mike@0 4303 bl _Eat
mike@0 4304 b .L517
mike@0 4305 .L531:
mike@0 4306 @ elsif token = LANGLE then
mike@0 4307 set r0, _token
mike@0 4308 ldr r0, [r0]
mike@0 4309 cmp r0, #15
mike@0 4310 bne .L534
mike@0 4311 @ t := ParseNode()
mike@0 4312 bl _ParseNode
mike@0 4313 mov r4, r0
mike@0 4314 b .L517
mike@0 4315 .L534:
mike@0 4316 @ if not errflag then ShowError(); print_string("expected a term"); newline(); Recover() end; t := NULL
mike@0 4317 set r0, _errflag
mike@0 4318 ldrb r0, [r0]
mike@0 4319 cmp r0, #0
mike@0 4320 bne .L538
mike@0 4321 bl _ShowError
mike@0 4322 mov r1, #15
mike@0 4323 set r0, g72
mike@0 4324 bl print_string
mike@0 4325 bl newline
mike@0 4326 bl _Recover
mike@0 4327 .L538:
mike@0 4328 mov r4, #0
mike@0 4329 .L517:
mike@0 4330 @ return t
mike@0 4331 mov r0, r4
mike@0 4332 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 4333 .ltorg
mike@0 4334
mike@0 4335 @ proc ParseNode(): term;
mike@0 4336 _ParseNode:
mike@0 4337 mov ip, sp
mike@0 4338 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 4339 mov fp, sp
mike@0 4340 @ Eat(LANGLE);
mike@0 4341 mov r0, #15
mike@0 4342 bl _Eat
mike@0 4343 @ tag := ParseTerm();
mike@0 4344 bl _ParseTerm
mike@0 4345 mov r4, r0
mike@0 4346 @ kids := ParseKids();
mike@0 4347 bl _ParseKids
mike@0 4348 mov r5, r0
mike@0 4349 @ Eat(RANGLE);
mike@0 4350 mov r0, #16
mike@0 4351 bl _Eat
mike@0 4352 @ return MakeNode(node, tag, kids)
mike@0 4353 mov r2, r5
mike@0 4354 mov r1, r4
mike@0 4355 set r0, _node
mike@0 4356 ldr r0, [r0]
mike@0 4357 bl _MakeNode
mike@0 4358 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 4359 .ltorg
mike@0 4360
mike@0 4361 @ proc ParseKids(): term;
mike@0 4362 _ParseKids:
mike@0 4363 mov ip, sp
mike@0 4364 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 4365 mov fp, sp
mike@0 4366 @ if token <> COMMA then
mike@0 4367 set r0, _token
mike@0 4368 ldr r0, [r0]
mike@0 4369 cmp r0, #9
mike@0 4370 beq .L542
mike@0 4371 @ return MakeNode(nilsym, NULL, NULL)
mike@0 4372 mov r2, #0
mike@0 4373 mov r1, #0
mike@0 4374 set r0, _nilsym
mike@0 4375 ldr r0, [r0]
mike@0 4376 bl _MakeNode
mike@0 4377 b .L540
mike@0 4378 .L542:
mike@0 4379 @ Eat(COMMA);
mike@0 4380 mov r0, #9
mike@0 4381 bl _Eat
mike@0 4382 @ head := ParseTerm();
mike@0 4383 bl _ParseTerm
mike@0 4384 mov r4, r0
mike@0 4385 @ tail := ParseKids();
mike@0 4386 bl _ParseKids
mike@0 4387 mov r5, r0
mike@0 4388 @ return MakeNode(cons, head, tail)
mike@0 4389 mov r2, r5
mike@0 4390 mov r1, r4
mike@0 4391 set r0, _cons
mike@0 4392 ldr r0, [r0]
mike@0 4393 bl _MakeNode
mike@0 4394 .L540:
mike@0 4395 ldmfd fp, {r4-r10, fp, sp, pc}
mike@0 4396 .ltorg
mike@0 4397
mike@0 4398 @ proc ParseFactor(): term;
mike@0 4399 _ParseFactor:
mike@0 4400 mov ip, sp
mike@0 4401 stmfd sp!, {r4-r10, fp, ip, lr}
mike@0 4402 mov fp, sp
mike@0 4403 @ t := ParsePrimary();
mike@0 4404 bl _ParsePrimary
mike@0 4405 mov r4, r0
mike@0 4406 @ if token <> COLON then
mike@0 4407 set r0, _token
mike@0 4408 ldr r0, [r0]
mike@0 4409 cmp r0, #11
mike@0 4410 beq .L546
mike@0 4411 @ return t
mike@0 4412 mov r0, r4
mike@0 4413 b .L544
mike@0 4414 .L546:
mike@0 4415 @ Eat(COLON);
mike@0 4416 mov r0, #11
mike@0 4417 bl _Eat
mike@0 4418 @ return MakeNode(cons, t, ParseFactor())