6 (FCODE-BUFFER-PAGE FCODE-FILE-POINTER MAX-BUFFERS)
8 (FCODE-BUFFER-CHANGED?)
11 <LIST [REST <OR FIX CODEVEC>]>
14 (FCODE-COUNT FCURRENT-WORD FBYTE-OFFSET FSHIFT)
19 <MSETG FCODEVEC-LENGTH <* ,CODEVEC-LENGTH 4>>
21 <DEFINE INIT-FINAL-CODE ()
22 <SETG FCURRENT-CODE <IUVECTOR ,CODEVEC-LENGTH 0>>
23 <SETG FCODE-LIST (,FCURRENT-CODE)>
24 <SETG FCODE-CHANNEL <>>
25 <SETG FCODE-BUFFER <IUVECTOR ,CODEVEC-LENGTH 0>>
26 <SETG FCODE-BUFFER-PAGE -1>
27 <SETG FCODE-FILE-POINTER 0>
29 <SETG FCURRENT-WORD 0>
33 <DEFINE RESET-FCODE ()
35 <COND (<TYPE? <1 ,FCODE-LIST> FIX>
36 <SETG FCODE-LIST <REST ,FCODE-LIST>>)
38 <SETG FCURRENT-CODE <1 ,FCODE-LIST>>
39 <SETG FCODE-BUFFER-PAGE -1>
40 <COND (,FCODE-CHANNEL <CLOSE ,FCODE-CHANNEL> <SETG FCODE-CHANNEL <>>)>
41 <SETG FCODE-FILE-POINTER 0>
43 <SETG FCURRENT-WORD 0>
47 <DEFINE OPEN-FCODE-FILE ("AUX" CH)
49 <CHANNEL-OPEN DISK "CACHE.FILE" "CREATE" "BINARY">>>
50 <ERROR <SYS-ERR "CACHE.FILE" .CH>>)>
51 <SETG FCODE-CHANNEL .CH>
54 <DEFINE WRITE-FCODE (BUF PAGE "AUX" (CH ,FCODE-CHANNEL))
55 #DECL ((BUF) UVECTOR (PAGE) FIX)
56 <COND (<NOT ,FCODE-CHANNEL> <OPEN-FCODE-FILE>)>
57 <SET CH ,FCODE-CHANNEL>
58 <ACCESS .CH <* .PAGE ,CODEVEC-LENGTH>>
59 <CHANNEL-OP .CH WRITE-BUFFER .BUF>
62 <DEFINE READ-FCODE (BUF PAGE "AUX" (CH ,FCODE-CHANNEL))
63 <ACCESS .CH <* .PAGE ,CODEVEC-LENGTH>>
64 <CHANNEL-OP .CH READ-BUFFER .BUF>>
66 <DEFINE ADD-BYTE-TO-FCODE (BYT
67 "AUX" RLST (CCODE ,FCURRENT-CODE)
68 (CWORD ,FCURRENT-WORD) (OFF ,FBYTE-OFFSET)
70 #DECL ((SHFT BYT) FIX)
71 <COND (<G? <SET SHFT <- .SHFT 8>> 0>
72 <SETG FCURRENT-WORD <CHTYPE <ORB .CWORD <LSH .BYT .SHFT>> FIX>>)
74 <SET COUNT ,FCODE-COUNT>
75 <COND (<EMPTY? .CCODE>
77 <REST ,FCODE-LIST <- </ .COUNT ,CODEVEC-LENGTH> 1>>>
78 <COND (<1? <LENGTH .RLST>>
79 <SET CCODE <NEW-FCODE-BUFFER>>)
80 (ELSE <SET CCODE <2 .RLST>>)>)>
81 <SET BYT <CHTYPE <ORB .CWORD .BYT> FIX>>
83 <SETG FCURRENT-CODE <REST .CCODE>>
84 <SETG FCODE-COUNT <+ .COUNT 1>>
85 <SETG FCURRENT-WORD 0>
88 <SETG FBYTE-OFFSET <+ .OFF 1>>
91 <DEFINE NEW-FCODE-BUFFER ("AUX" (RLST ,FCODE-LIST) CCODE
92 (BPAGE ,FCODE-FILE-POINTER))
93 <COND (<G? <LENGTH .RLST> ,MAX-BUFFERS>
95 <FCN (BUFR "AUX" (BUF <1 .BUFR>))
96 <COND (<TYPE? .BUF UVECTOR>
101 <WRITE-FCODE .CCODE .BPAGE>
102 <SETG FCODE-FILE-POINTER <+ .BPAGE 1>>
103 <PUTREST <REST .RLST <- <LENGTH .RLST> 1>> (.CCODE)>)
105 <SET CCODE <IUVECTOR ,CODEVEC-LENGTH 0>>
106 <PUTREST <REST .RLST <- <LENGTH .RLST> 1>> (.CCODE)>)>
109 <DEFINE PUT-FCODE (DEST VAL
110 "AUX" (CL ,FCODE-LIST) (OFF ,FBYTE-OFFSET)
111 (CWORD ,FCURRENT-WORD) (SHFT ,FSHIFT))
112 #DECL ((DEST VAL SHFT) FIX (CL) LIST)
113 <COND (<AND <==? </ <+ .OFF 2> 4> </ <+ .DEST 3> 4>> <N==? .SHFT 32>>
115 <CHTYPE <PUTBITS .CWORD
118 <+ <MOD <+ .DEST 3> 4> 1>>>
122 <REPEAT ((PTR .DEST) WD CCODE)
123 #DECL ((CCODE) UVECTOR)
124 <COND (<L=? .PTR ,FCODEVEC-LENGTH>
125 <SET OFF </ <+ .PTR 3> 4>>
127 <NTH '![24 16 8 0!] <+ <MOD <+ .PTR 3> 4> 1>>>
128 <COND (<TYPE? <1 .CL> UVECTOR> <SET CCODE <1 .CL>>)
129 (<SET CCODE <GET-FCODE-BUFFER <1 .CL> WRITE>>)>
131 <PUTBITS <NTH .CCODE .OFF> <BITS 8 .SHFT> .VAL>>
132 <PUT .CCODE .OFF .WD>
134 <COND (<EMPTY? <SET CL <REST .CL>>>
135 <ERROR OUT-OF-BOUNDS PUT-FCODE>)>
136 <SET PTR <- .PTR ,FCODEVEC-LENGTH>>>)>>
138 <DEFINE NTH-FCODE (DEST
139 "AUX" (CL ,FCODE-LIST) VAL (OFF ,FBYTE-OFFSET)
140 (CWORD ,FCURRENT-WORD) (SHFT ,FSHIFT))
141 #DECL ((DEST) FIX (CL) LIST)
142 <COND (<AND <==? </ <+ .OFF 2> 4> </ <+ .DEST 3> 4>> <N==? .SHFT 32>>
143 <CHTYPE <GETBITS .CWORD
146 <+ <MOD <+ .DEST 3> 4> 1>>>>
149 <REPEAT ((PTR .DEST) CCODE)
150 #DECL ((CCODE) UVECTOR)
151 <COND (<L=? .PTR ,FCODEVEC-LENGTH>
152 <SET OFF </ <+ .PTR 3> 4>>
154 <NTH '![24 16 8 0!] <+ <MOD <+ .PTR 3> 4> 1>>>
155 <COND (<TYPE? <1 .CL> UVECTOR> <SET CCODE <1 .CL>>)
156 (<SET CCODE <GET-FCODE-BUFFER <1 .CL> READ>>)>
158 <CHTYPE <GETBITS <NTH .CCODE .OFF>
162 <COND (<EMPTY? <SET CL <REST .CL>>>
163 <ERROR OUT-OF-BOUNDS .DEST NTH-FCODE>)>
164 <SET PTR <- .PTR ,FCODEVEC-LENGTH>>>)>>
166 <DEFINE GET-FCODE-BUFFER (PAGE MODE)
167 #DECL ((PAGE) FIX (MODE) ATOM)
168 <COND (<==? .PAGE ,FCODE-BUFFER-PAGE>
169 <AND <==? .MODE WRITE> <SETG FCODE-BUFFER-CHANGED? T>>)
171 <COND (<AND <G=? ,FCODE-BUFFER-PAGE 0> ,FCODE-BUFFER-CHANGED?>
172 <WRITE-FCODE ,FCODE-BUFFER ,FCODE-BUFFER-PAGE>)>
173 <READ-FCODE ,FCODE-BUFFER .PAGE>
174 <SETG FCODE-BUFFER-PAGE .PAGE>
175 <COND (<==? .MODE READ> <SETG FCODE-BUFFER-CHANGED? <>>)
176 (ELSE <SETG FCODE-BUFFER-CHANGED? T>)>)>
179 <DEFINE ADVANCE-FCODE (NUM)
182 <ADD-BYTE-TO-FCODE .NUM>
183 <COND (<0? <SET NUM <- .NUM 1>>> <RETURN>)>>>