{-------------------------------------------------------------} { routines operating on stored strings } { To keep all stored terms in string form (P/Z or our version)} { would use far too much storage. Here we pack strings into } { large blocks. The blocks are allocated as needed, to a max } { of 32K -- limit enforced by compiler range checking. } {-------------------------------------------------------------} procedure stput(var a:str; var b:stref); { stow string a in latest buffer, return indirect reference} var bp : ^strbuff; j : strindex; k : 1..sbufsize; begin bp := sbufptrs[sbufcnt]; { ^latest string buffer } if bp^.free<(a.len+1) then begin { not enough room! } new(bp); { make, count new buffer page } sbufcnt := sbufcnt+1; { range error here when full } sbufptrs[sbufcnt] := bp; bp^.free := sbufsize end; b.nb := sbufcnt; { save buffer-page number } j := 1; k := 1+sbufsize-bp^.free; b.bo := k; { save buffer-page offset } while j <= a.len do begin bp^.data[k] := a.val[j]; j := j+1; k := k+1 end; bp^.data[k] := nullch; { mark end of stored string } bp^.free := sbufsize-k { adjust bytes left in block } end; procedure stget(var b:stref; var a:str); { retrieve stored string from buffer into string-record } var bp : ^strbuff; j : strindex; k : 1..sbufsize; c : nchar; begin bp := sbufptrs[b.nb]; { point to the buffer page } k := b.bo; { ..and offset into it } j := 1; repeat { copy the stored string out } c := bp^.data[k]; a.val[j] := c; j := j+1; k := k+1; until (c=nullch); a.len := j-2 end; function sbcomp(var a:str; var b:stref) : relation; { EXACT comparison of a string to a stored string value -- if "a" is initially equal but shorter, it is "less." } var bp : ^strbuff; j : strindex; k : 1..sbufsize; x,y : nchar; r : relation; begin bp := sbufptrs[b.nb]; k := b.bo; j := 1; repeat x := a.val[j]; y := bp^.data[k]; j := j+1; k := k+1 until (x<>y) or (x=nullch); if x=y then r := equal else if xy) or (x=nullch); if (x=y) or (x=nullch) then r := equal else if x