3 <ENTRY LSR-EXTRACT LSR-ENTRY LSR-INIT LSR-UNINIT NEXT-USER
4 $DNAME $HNAME $NNAME $WADDR $WPHON $HADDR $HPHON $NADDR
5 $BRDAY $SUPER $PROJN $ACCNT $RELAT $REMRK $ALTBY>
23 <MANIFEST $DNAME $HNAME $NNAME $WADDR $WPHON $HADDR $HPHON
24 $NADDR $BRDAY $SUPER $PROJN $ACCNT $RELAT $REMRK
29 #WORD *360605000001* ; "name length"
30 #WORD *300605000001* ; "real name length"
31 #WORD *220605000001* ; "nick name length"
32 #WORD *140605000001* ; "work address"
33 #WORD *060605000001* ; "work phone"
34 #WORD *000605000001* ; "home address"
35 #WORD *360605000002* ; "home phone"
36 #WORD *300605000002* ; "net address"
37 #WORD *220605000002* ; "birthday"
38 #WORD *140605000002* ; "supervisor"
39 #WORD *060605000002* ; "project"
40 #WORD *000605000002* ; "account"
41 #WORD *360605000003* ; "relationship"
42 #WORD *221405000003* ; "remark!"
43 #WORD *140605000003* ; "altered by">>
45 <SETG SPARE-UV <IUVECTOR 50>>
50 <DECLARE ("VALUE" <OR STRING FALSE>
51 <OR STRING <PRIMTYPE WORD>> FIX "OPTIONAL" <OR ATOM FALSE>)>
53 PLOOP <DPUSH TP* (AB)>
63 <INTERNAL-ENTRY IFIELD2 2>
64 <PUSH TP* <TYPE-WORD FALSE>>
66 <INTERNAL-ENTRY IFIELD3 3>
69 <CAIE O* <TYPE-CODE STRING>>
75 <CAIN O* <TYPE-CODE FALSE>>
76 <JRST RFALS1> ; "No such user"
77 <DMOVEM A* -5(TP)> ; "Save user number"
79 <JRST [<MOVE A* <MQUOTE <RGLOC FILJFN T>>>
83 <PUSHJ P* INIT> ; "Get the file"
84 <PUSHJ P* DOPEN> ; "Open it"
85 GOTFIL <PUSH P* A> ; "Save jfn"
86 <HRRZ C* -4(TP)> ; "Directory number"
87 <RIN> ; "Get the pointer"
88 <JUMPE B* RFALSE> ; "Nothing there"
93 <MOVE D* <MQUOTE <RGLOC SPARE-UV T>>>
98 <CAIGE E* (F)> ; "Enough space?"
99 <PUSHJ P* NEWUV> ; "No, make a new one"
101 <MOVE B* 1(D)> ; "Note that NEWUV returns loc in D"
106 <SIN-JSYS> ; "Read it in"
109 <MOVE A* <MQUOTE <RGLOC PTUV T>>>
111 <MOVE A* 1(A)> ; "uvector of byte pointers"
113 <MOVE D* -4(TP)> ; "field #"
114 <MOVE E* (TP)> ; "Pointer to data"
115 <SOJL D* FIELDE> ; "first one"
116 FIELDL <LDB F* (A)> ; "pick up a length"
120 FIELDE <LDB O* (A)> ; "field length"
121 <PUSH P* O> ; "Save it"
122 <PUSH P* C> ; "How far to rest"
128 <PUSHJ P* RCALL> ; "UV in A and B"
129 <POP TP* D> ; "Get back data UV"
132 <HRLI A* <TYPE-CODE STRING>>
135 <DPUSH TP* A> ; "Save as string"
136 <HRRI E* 4(D)> ; "First string word in data"
139 <IBP C* E> ; "Rest data pointer"
140 <POP P* O> ; "Count to transfer"
153 RFALS1 <MOVSI A* <TYPE-CODE FALSE>>
159 <HLRZ A* -1(P)> ; "Length of block"
163 <MOVE D* <MQUOTE <RGLOC SPARE-UV T>>>
170 <MOVE E* <MQUOTE <RGLOC FILJFN T>>>
173 <CAIE A* <TYPE-CODE FALSE>>
174 <JRST [<MOVE A* 1(E)>
176 <MOVE A* [<(*100001*) 0>]>
177 <MOVE B* <MQUOTE "PS:<UNSUPPORTED>PEOPLE.DATA
\0">>
182 <MOVSI B* <TYPE-CODE FIX>>
187 <MOVE B* [<(*440000*) *200000*>]>
198 <SUB-ENTRY LSR-INIT ("VALUE" FIX)>
202 <INTERNAL-ENTRY IINIT 0>
204 <PUSHJ P* INIT> ;"Leaves JFN in A"
206 <MOVE E* <MQUOTE <RGLOC FILJFN T>>>
211 <SUB-ENTRY LSR-UNINIT ("VALUE" FALSE)>
215 <INTERNAL-ENTRY IUNINIT 0>
217 <MOVE E* <MQUOTE <RGLOC FILJFN T>>>
220 <CAIN O* <TYPE-CODE FALSE>>
225 <MOVSI A* <TYPE-CODE FALSE>>
228 UNOUT <MOVSI A* <TYPE-CODE FALSE>>
232 <SUB-ENTRY LSR-ENTRY ("VALUE" <OR FALSE WORD> STRING)>
237 <INTERNAL-ENTRY IRCUSR 1>
245 <DPUSH TP* <MQUOTE "
\0">>
252 <MOVSI A* <TYPE-CODE WORD>>
256 <MOVSI C* <TYPE-CODE WORD>>
259 <MOVSI A* <TYPE-CODE FALSE>>
263 <SUB-ENTRY NEXT-USER ("VALUE" <OR FALSE WORD> STRING <OR FALSE WORD>)>
269 <INTERNAL-ENTRY INEXT 2>
285 <PUSH TP* <TYPE-WORD CHARACTER>>
291 OKSTR <MOVE B* -2(TP)>
295 <CAIN O* <TYPE-CODE FALSE>>
299 <JRST [<MOVSI A* <TYPE-CODE FALSE>>
302 <MOVSI A* <TYPE-CODE WORD>>