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 | #include "lisp.h" |
---|
13 | #include "specs.h" |
---|
14 | #include "bus_type.h" |
---|
15 | |
---|
16 | long block_size(Cell *level) // return size needed to recreate this block |
---|
17 | { |
---|
18 | int ret; |
---|
19 | if (!level) ret=0; // NULL pointers don't need to be stored |
---|
20 | else |
---|
21 | { |
---|
22 | int type=item_type(level); |
---|
23 | if (type==L_CONS_CELL) |
---|
24 | { |
---|
25 | long t=0; |
---|
26 | void *b=level; |
---|
27 | for (;b && item_type(b)==L_CONS_CELL;b=CDR(b)) |
---|
28 | { |
---|
29 | t+=sizeof(LList); |
---|
30 | } |
---|
31 | if (b) t+=block_size(b); |
---|
32 | for (b=level;b && item_type(b)==L_CONS_CELL;b=CDR(b)) |
---|
33 | t+=block_size(CAR(b)); |
---|
34 | ret=t; |
---|
35 | } else if (type== L_NUMBER) |
---|
36 | { ret=sizeof(LNumber); } |
---|
37 | else if (type==L_CHARACTER) |
---|
38 | { ret=sizeof(LChar); } |
---|
39 | else if (type==L_STRING) |
---|
40 | { |
---|
41 | ret=sizeof(LString)+strlen(lstring_value(level))+1; |
---|
42 | if (ret<8) |
---|
43 | ret=8; |
---|
44 | } |
---|
45 | else if (type==L_POINTER) |
---|
46 | { ret=sizeof(LPointer); } |
---|
47 | else ret=0; |
---|
48 | } |
---|
49 | #ifdef WORD_ALIGN |
---|
50 | return (ret+3)&(~3); |
---|
51 | #else |
---|
52 | return ret; |
---|
53 | #endif |
---|
54 | } |
---|
55 | |
---|
56 | |
---|
57 | |
---|
58 | void write_level(bFILE *fp, Cell *level) |
---|
59 | { |
---|
60 | int type=item_type(level); |
---|
61 | fp->write_uint8(type); |
---|
62 | |
---|
63 | |
---|
64 | switch (type) |
---|
65 | { |
---|
66 | case L_NUMBER : |
---|
67 | { fp->write_uint32(lnumber_value(level)); } break; |
---|
68 | case L_CHARACTER : |
---|
69 | { fp->write_uint16(lcharacter_value(level)); } break; |
---|
70 | case L_STRING : |
---|
71 | { long l=strlen(lstring_value(level))+1; |
---|
72 | fp->write_uint32(l); |
---|
73 | fp->write(lstring_value(level),l); |
---|
74 | } break; |
---|
75 | case L_SYMBOL : |
---|
76 | { fp->write_uint32((long)level); } break; |
---|
77 | case L_CONS_CELL : |
---|
78 | { |
---|
79 | if (!level) fp->write_uint32(0); |
---|
80 | else |
---|
81 | { |
---|
82 | long t=0; |
---|
83 | void *b=level; |
---|
84 | for (;b && item_type(b)==L_CONS_CELL;b=CDR(b)) t++; |
---|
85 | if (b) |
---|
86 | { |
---|
87 | fp->write_uint32(-t); // negative number means dotted list |
---|
88 | write_level(fp,b); // save end of dotted list |
---|
89 | } |
---|
90 | else fp->write_uint32(t); |
---|
91 | |
---|
92 | for (b=level;b && item_type(b)==L_CONS_CELL;b=CDR(b)) |
---|
93 | write_level(fp,CAR(b)); |
---|
94 | } |
---|
95 | } break; |
---|
96 | } |
---|
97 | } |
---|
98 | |
---|
99 | Cell *load_block(bFILE *fp) |
---|
100 | { |
---|
101 | int type=fp->read_uint8(); |
---|
102 | switch (type) |
---|
103 | { |
---|
104 | case L_NUMBER : |
---|
105 | { return LNumber::Create(fp->read_uint32()); } break; |
---|
106 | case L_CHARACTER : |
---|
107 | { return new_lisp_character(fp->read_uint16()); } break; |
---|
108 | case L_STRING : |
---|
109 | { long l=fp->read_uint32(); |
---|
110 | LString *s = LString::Create(l); |
---|
111 | fp->read(lstring_value(s),l); |
---|
112 | return s; |
---|
113 | } break; |
---|
114 | case L_SYMBOL : |
---|
115 | { return (void *)fp->read_uint32(); } break; |
---|
116 | case L_CONS_CELL : |
---|
117 | { |
---|
118 | long t=fp->read_uint32(); |
---|
119 | if (!t) return NULL; |
---|
120 | else |
---|
121 | { |
---|
122 | long x=abs(t); |
---|
123 | LList *last=NULL,*first=NULL; |
---|
124 | while (x) |
---|
125 | { |
---|
126 | LList *c = LList::Create(); |
---|
127 | if (first) |
---|
128 | last->cdr=c; |
---|
129 | else first=c; |
---|
130 | last=c; |
---|
131 | x--; |
---|
132 | } |
---|
133 | last->cdr = (t < 0) ? (LObject *)load_block(fp) : NULL; |
---|
134 | |
---|
135 | for (last=first,x=0;x<abs(t);x++,last=(LList *)last->cdr) |
---|
136 | last->car = (LObject *)load_block(fp); |
---|
137 | return first; |
---|
138 | } |
---|
139 | } |
---|
140 | } |
---|
141 | return NULL; |
---|
142 | } |
---|