| 1 | /* |
|---|
| 2 | * Abuse - dark 2D side-scrolling platform game |
|---|
| 3 | * Copyright (c) 1995 Crack dot Com |
|---|
| 4 | * |
|---|
| 5 | * This software was released into the Public Domain. As with most public |
|---|
| 6 | * domain software, no warranty is made or implied by Crack dot Com or |
|---|
| 7 | * Jonathan Clark. |
|---|
| 8 | */ |
|---|
| 9 | |
|---|
| 10 | #include "config.h" |
|---|
| 11 | |
|---|
| 12 | #ifdef NO_LIBS |
|---|
| 13 | #include "fakelib.h" |
|---|
| 14 | #else |
|---|
| 15 | #include "macs.h" |
|---|
| 16 | #endif |
|---|
| 17 | |
|---|
| 18 | #include "lisp.h" |
|---|
| 19 | #include "lisp_gc.h" |
|---|
| 20 | |
|---|
| 21 | LispObject *l_undefined; |
|---|
| 22 | LispSymbol *true_symbol = NULL, *list_symbol, *string_symbol, *quote_symbol, |
|---|
| 23 | *backquote_symbol, *comma_symbol, *do_symbol, *in_symbol, *aref_symbol, |
|---|
| 24 | *if_symbol, *progn_symbol, *car_symbol, *cdr_symbol; |
|---|
| 25 | |
|---|
| 26 | void *colon_initial_contents, *colon_initial_element, |
|---|
| 27 | *eq_symbol, *zero_symbol, *eq0_symbol, *load_warning; |
|---|
| 28 | |
|---|
| 29 | void *if_1progn,*if_2progn,*if_12progn,*not_symbol; |
|---|
| 30 | |
|---|
| 31 | void *comp_optimize(void *list) |
|---|
| 32 | { |
|---|
| 33 | void *return_val=list; |
|---|
| 34 | p_ref r1(list); |
|---|
| 35 | if (list) |
|---|
| 36 | { |
|---|
| 37 | if (CAR(list)==if_symbol) |
|---|
| 38 | { |
|---|
| 39 | void *eval1=lcar(lcdr(lcdr(list))); |
|---|
| 40 | p_ref r2(eval1); |
|---|
| 41 | void *eval2=lcar(lcdr(lcdr(lcdr(list)))); |
|---|
| 42 | p_ref r3(eval2); |
|---|
| 43 | |
|---|
| 44 | void *ret=NULL; |
|---|
| 45 | p_ref r1(ret); |
|---|
| 46 | if (lcar(list)==eq_symbol && (lcar(lcdr(list))==zero_symbol)) // simplify (eq 0 x) -> (eq0 x) |
|---|
| 47 | { |
|---|
| 48 | push_onto_list(lcar(lcdr(lcdr(list))),ret); |
|---|
| 49 | push_onto_list(eq0_symbol,ret); |
|---|
| 50 | return_val=comp_optimize(ret); |
|---|
| 51 | } else if (lcar(list)==eq_symbol && |
|---|
| 52 | (lcar(lcdr(lcdr(list)))==zero_symbol)) //simplify (eq x 0)-> (eq0 x) |
|---|
| 53 | { |
|---|
| 54 | push_onto_list(lcar(lcdr(list)),ret); |
|---|
| 55 | push_onto_list(eq0_symbol,ret); |
|---|
| 56 | return_val=comp_optimize(ret); |
|---|
| 57 | } else if (lcar(lcar(lcdr(list)))==not_symbol) // simplify (if (not y) x z) -> (if y z x) |
|---|
| 58 | { |
|---|
| 59 | push_onto_list(lcar(lcdr(lcdr(list))),ret); |
|---|
| 60 | push_onto_list(lcar(lcdr(lcdr(lcdr(list)))),ret); |
|---|
| 61 | push_onto_list(lcar(lcdr(lcar(lcdr(list)))),ret); |
|---|
| 62 | push_onto_list(if_symbol,ret); |
|---|
| 63 | return_val=comp_optimize(ret); |
|---|
| 64 | } |
|---|
| 65 | else if (lcar(eval1)==progn_symbol && (eval2==NULL || |
|---|
| 66 | item_type(eval2)!=L_CONS_CELL)) |
|---|
| 67 | { |
|---|
| 68 | push_onto_list(eval2,ret); |
|---|
| 69 | push_onto_list(lcdr(eval1),ret); |
|---|
| 70 | push_onto_list(lcar(lcdr(list)),ret); |
|---|
| 71 | push_onto_list(if_1progn,ret); |
|---|
| 72 | return_val=comp_optimize(ret); |
|---|
| 73 | } else if (lcar(eval1)==progn_symbol && lcar(eval2)==progn_symbol) |
|---|
| 74 | { |
|---|
| 75 | push_onto_list(lcdr(eval2),ret); |
|---|
| 76 | push_onto_list(lcdr(eval1),ret); |
|---|
| 77 | push_onto_list(lcar(lcdr(list)),ret); |
|---|
| 78 | push_onto_list(if_12progn,ret); |
|---|
| 79 | return_val=comp_optimize(ret); |
|---|
| 80 | } else if (lcar(eval2)==progn_symbol) |
|---|
| 81 | { |
|---|
| 82 | push_onto_list(lcdr(eval2),ret); |
|---|
| 83 | push_onto_list(eval1,ret); |
|---|
| 84 | push_onto_list(lcar(lcdr(list)),ret); |
|---|
| 85 | push_onto_list(if_2progn,ret); |
|---|
| 86 | return_val=comp_optimize(ret); |
|---|
| 87 | } |
|---|
| 88 | |
|---|
| 89 | } |
|---|
| 90 | } |
|---|
| 91 | return return_val; |
|---|
| 92 | } |
|---|
| 93 | |
|---|
| 94 | void l_comp_init() |
|---|
| 95 | { |
|---|
| 96 | // This needs to be defined first |
|---|
| 97 | l_undefined = LispSymbol::FindOrCreate(":UNDEFINED"); |
|---|
| 98 | |
|---|
| 99 | // Collection problems result if we don't do this |
|---|
| 100 | ((LispSymbol *)l_undefined)->function = NULL; |
|---|
| 101 | ((LispSymbol *)l_undefined)->value = NULL; |
|---|
| 102 | |
|---|
| 103 | true_symbol = LispSymbol::FindOrCreate("T"); |
|---|
| 104 | |
|---|
| 105 | list_symbol = LispSymbol::FindOrCreate("list"); |
|---|
| 106 | string_symbol = LispSymbol::FindOrCreate("string"); |
|---|
| 107 | quote_symbol = LispSymbol::FindOrCreate("quote"); |
|---|
| 108 | backquote_symbol = LispSymbol::FindOrCreate("backquote"); |
|---|
| 109 | comma_symbol = LispSymbol::FindOrCreate("comma"); |
|---|
| 110 | in_symbol = LispSymbol::FindOrCreate("in"); |
|---|
| 111 | do_symbol = LispSymbol::FindOrCreate("do"); |
|---|
| 112 | aref_symbol = LispSymbol::FindOrCreate("aref"); |
|---|
| 113 | colon_initial_contents = LispSymbol::FindOrCreate(":initial-contents"); |
|---|
| 114 | colon_initial_element = LispSymbol::FindOrCreate(":initial-element"); |
|---|
| 115 | |
|---|
| 116 | if_1progn = LispSymbol::FindOrCreate("if-1progn"); |
|---|
| 117 | if_2progn = LispSymbol::FindOrCreate("if-2progn"); |
|---|
| 118 | if_12progn = LispSymbol::FindOrCreate("if-12progn"); |
|---|
| 119 | if_symbol = LispSymbol::FindOrCreate("if"); |
|---|
| 120 | progn_symbol = LispSymbol::FindOrCreate("progn"); |
|---|
| 121 | not_symbol = LispSymbol::FindOrCreate("not"); |
|---|
| 122 | eq_symbol = LispSymbol::FindOrCreate("eq"); |
|---|
| 123 | zero_symbol = LispSymbol::FindOrCreate("0"); |
|---|
| 124 | eq0_symbol = LispSymbol::FindOrCreate("eq0"); |
|---|
| 125 | car_symbol = LispSymbol::FindOrCreate("car"); |
|---|
| 126 | cdr_symbol = LispSymbol::FindOrCreate("cdr"); |
|---|
| 127 | load_warning = LispSymbol::FindOrCreate("load_warning"); |
|---|
| 128 | } |
|---|
| 129 | |
|---|
