<DECLARE ("VALUE" <OR STRING FALSE> <OR STRING <PRIMTYPE WORD>> FIX "OPTIONAL" <OR ATOM FALSE>)> <HLRE A* AB> PLOOP <DPUSH TP* (AB)> <ADD AB* [<(2) 2>]> <JUMPL AB* PLOOP> <ASH A* -1> <ADDI A* DTAB> <PUSHJ P* @ 2(A)> <JRST FINIS> <IFIELD3> DTAB <IFIELD2> <INTERNAL-ENTRY IFIELD2 2> <PUSH TP* <TYPE-WORD FALSE>> <PUSH TP* [0]> <INTERNAL-ENTRY IFIELD3 3> <SUBM M* (P)> <GETYP O* -5(TP)> <CAIE O* <TYPE-CODE STRING>> <JRST GTFIL> <PUSH TP* -5(TP)> <PUSH TP* -5(TP)> <PUSHJ P* IRCUSR> <GETYP O* A> <CAIN O* <TYPE-CODE FALSE>> <JRST RFALS1> ; "No such user" <DMOVEM A* -5(TP)> ; "Save user number" GTFIL <SKIPGE (TP)> <JRST [<MOVE A* <MQUOTE <RGLOC FILJFN T>>> <ADD A* GLOTOP 1> <MOVE A* 1(A)> <JRST GOTFIL>]> <PUSHJ P* INIT> ; "Get the file" <PUSHJ P* DOPEN> ; "Open it" GOTFIL <PUSH P* A> ; "Save jfn" <HRRZ C* -4(TP)> ; "Directory number" <RIN> ; "Get the pointer" <JUMPE B* RFALSE> ; "Nothing there" <PUSH P* B> <HRRZS B> <SFPTR> <JFCL> <MOVE D* <MQUOTE <RGLOC SPARE-UV T>>> <ADD D* GLOTOP 1> <HLRE E* 1(D)> <MOVNS E> <HLRZ F* (P)> <CAIGE E* (F)> ; "Enough space?" <PUSHJ P* NEWUV> ; "No, make a new one" <MOVE A* -1(P)> <MOVE B* 1(D)> ; "Note that NEWUV returns loc in D" <HRLI B* *444400*> <DPUSH TP* (D)> <HLRZ C* (P)> <MOVNS C> <SIN-JSYS> ; "Read it in" <SKIPL -2(TP)> <PUSHJ P* DCLOSE> <MOVE A* <MQUOTE <RGLOC PTUV T>>> <ADD A* GLOTOP 1> <MOVE A* 1(A)> ; "uvector of byte pointers" <MOVEI C* 0> <MOVE D* -4(TP)> ; "field #" <MOVE E* (TP)> ; "Pointer to data" <SOJL D* FIELDE> ; "first one" FIELDL <LDB F* (A)> ; "pick up a length" <ADD C* F> <ADDI A* 1> <SOJGE D* FIELDL> FIELDE <LDB O* (A)> ; "field length" <PUSH P* O> ; "Save it" <PUSH P* C> ; "How far to rest" <MOVE A* O> <IDIVI A* 5> <SKIPE B> <ADDI A* 1> <MOVEI O* IBLOCK> <PUSHJ P* RCALL> ; "UV in A and B" <POP TP* D> ; "Get back data UV" <ADJSP TP* -1> <HRR A* -1(P)> <HRLI A* <TYPE-CODE STRING>> <SUBI B* 1> <HRLI B* *10700*> <DPUSH TP* A> ; "Save as string" <HRRI E* 4(D)> ; "First string word in data" <HRLI E* *440700*> <POP P* C> <IBP C* E> ; "Rest data pointer" <POP P* O> ; "Count to transfer" <JUMPE O* TRANE> TRANL <ILDB A* C> <IDPB A* B> <SOJG O* TRANL> TRANE <POP TP* B> <POP TP* A> <ADJSP P* -2> <ADJSP TP* -6> <JRST MPOPJ> RFALSE <POP P* A> <SKIPL (TP)> <PUSHJ P* DCLOSE> RFALS1 <MOVSI A* <TYPE-CODE FALSE>> <MOVEI B* 0> <ADJSP TP* -6> <JRST MPOPJ> NEWUV <SUBM M* (P)> <HLRZ A* -1(P)> ; "Length of block" <ADDI A* 10> <MOVEI O* IBLOCK> <PUSHJ P* RCALL> <MOVE D* <MQUOTE <RGLOC SPARE-UV T>>> <ADD D* GLOTOP 1> <MOVEM A* (D)> <MOVEM B* 1(D)> <JRST MPOPJ> INIT <SUBM M* (P)> <MOVE E* <MQUOTE <RGLOC FILJFN T>>> <ADD E* GLOTOP 1> <GETYP A* (E)> <CAIE A* <TYPE-CODE FALSE>> <JRST [<MOVE A* 1(E)> <JRST MPOPJ>]> <MOVE A* [<(*100001*) 0>]> <MOVE B* <MQUOTE "PS:<UNSUPPORTED>PEOPLE.DATA�">> <GTJFN> <ERRUUO*> <HRRZS A> <HRRM A* 1(E)> <MOVSI B* <TYPE-CODE FIX>> <MOVEM B* (E)> <JRST MPOPJ> DOPEN <SUBM M* (P)> <MOVE B* [<(*440000*) *200000*>]> <OPENF> <ERRUUO*> <JRST MPOPJ> DCLOSE <SUBM M* (P)> <TLO A* *400000*> <CLOSF> <JFCL> <JRST MPOPJ> <SUB-ENTRY LSR-INIT ("VALUE" FIX)> <PUSHJ P* IINIT> <JRST FINIS> <INTERNAL-ENTRY IINIT 0> <SUBM M* (P)> <PUSHJ P* INIT> ;"Leaves JFN in A" <PUSHJ P* DOPEN> <MOVE E* <MQUOTE <RGLOC FILJFN T>>> <ADD E* GLOTOP 1> <DMOVE A* (E)> <JRST MPOPJ> <SUB-ENTRY LSR-UNINIT ("VALUE" FALSE)> <PUSHJ P* IUNINIT> <JRST FINIS> <INTERNAL-ENTRY IUNINIT 0> <SUBM M* (P)> <MOVE E* <MQUOTE <RGLOC FILJFN T>>> <ADD E* GLOTOP 1> <GETYP O* (E)> <CAIN O* <TYPE-CODE FALSE>> <JRST UNOUT> <MOVE A* 1(E)> <CLOSF> <JFCL> <MOVSI A* <TYPE-CODE FALSE>> <MOVEM A* (E)> <SETZM 1(E)> UNOUT <MOVSI A* <TYPE-CODE FALSE>> <MOVEI B* 0> <JRST MPOPJ> <SUB-ENTRY LSR-ENTRY ("VALUE" <OR FALSE WORD> STRING)> <DPUSH TP* (AB)> <PUSHJ P* IRCUSR> <JRST FINIS> <INTERNAL-ENTRY IRCUSR 1> <SUBM M* (P)> <HRRZ C* -1(TP)> <MOVE B* (TP)> <IDIVI C* 5> <JUMPN D* DORCU> <PUSH TP* -1(TP)> <PUSH TP* -1(TP)> <DPUSH TP* <MQUOTE "�">> <MOVEI A* 2> <PUSHJ P* CISTNG> DORCU <HRLZI A* 1> <RCUSR> <JUMP R* DORERR> <MOVE B* C> <MOVSI A* <TYPE-CODE WORD>> <SUB TP* [<(2) 2>]> <JRST MPOPJ> DORERR <MOVE D* A> <MOVSI C* <TYPE-CODE WORD>> <MOVEI E* 0> <PUSHJ P* CICONS> <MOVSI A* <TYPE-CODE FALSE>> <SUB TP* [<(2) 2>]> <JRST MPOPJ> <SUB-ENTRY NEXT-USER ("VALUE" <OR FALSE WORD> STRING <OR FALSE WORD>)> <DPUSH TP* (AB)> <DPUSH TP* 2(AB)> <PUSHJ P* INEXT> <JRST FINIS> <INTERNAL-ENTRY INEXT 2> <SUBM M* (P)> <MOVE A* -2(TP)> <HRRZ B* -3(TP)> <SUBI B* 1> <IDIVI B* 5> <ADD A* B> <JUMPE C* NLE> NL <IBP A> <SOJE C* NL> NLE <ILDB B* A> <JUMPE B* OKSTR> <ILDB B* A> <JUMPE B* OKSTR> <PUSH TP* -3(TP)> <PUSH TP* -3(TP)> <PUSH TP* <TYPE-WORD CHARACTER>> <PUSH TP* [0]> <MOVEI A* 2> <PUSHJ P* CISTNG> <MOVEM A* -3(TP)> <MOVEM B* -2(TP)> OKSTR <MOVE B* -2(TP)> <MOVE C* (TP)> <GETYP O* -1(TP)> <MOVSI A* *6*> <CAIN O* <TYPE-CODE FALSE>> <TLZ A* *4*> <RCUSR> <TLNE A* *070000*> <JRST [<MOVSI A* <TYPE-CODE FALSE>> <MOVEI B* 0> <JRST LEAVE>]> <MOVSI A* <TYPE-CODE WORD>> <MOVE B* C> LEAVE <ADJSP TP* -4> <JRST MPOPJ> <END> <ENDPACKAGE>

; "These are all (E)" > > > <DECLARE ("VALUE" <OR STRING FALSE> <OR STRING <PRIMTYPE WORD>> FIX "OPTIONAL" <OR ATOM FALSE>)> <HLRE A* AB> PLOOP <DPUSH TP* (AB)> <ADD AB* [<(2) 2>]> <JUMPL AB* PLOOP> <ASH A* -1> <ADDI A* DTAB> <PUSHJ P* @ 2(A)> <JRST FINIS> <IFIELD3> DTAB <IFIELD2> <INTERNAL-ENTRY IFIELD2 2> <PUSH TP* <TYPE-WORD FALSE>> <PUSH TP* [0]> <INTERNAL-ENTRY IFIELD3 3> <SUBM M* (P)> <GETYP O* -5(TP)> <CAIE O* <TYPE-CODE STRING>> <JRST GTFIL> <PUSH TP* -5(TP)> <PUSH TP* -5(TP)> <PUSHJ P* IRCUSR> <GETYP O* A> <CAIN O* <TYPE-CODE FALSE>> <JRST RFALS1> ; "No such user" <DMOVEM A* -5(TP)> ; "Save user number" GTFIL <SKIPGE (TP)> <JRST [<MOVE A* <MQUOTE <RGLOC FILJFN T>>> <ADD A* GLOTOP 1> <MOVE A* 1(A)> <JRST GOTFIL>]> <PUSHJ P* INIT> ; "Get the file" <PUSHJ P* DOPEN> ; "Open it" GOTFIL <PUSH P* A> ; "Save jfn" <HRRZ C* -4(TP)> ; "Directory number" <RIN> ; "Get the pointer" <JUMPE B* RFALSE> ; "Nothing there" <PUSH P* B> <HRRZS B> <SFPTR> <JFCL> <MOVE D* <MQUOTE <RGLOC SPARE-UV T>>> <ADD D* GLOTOP 1> <HLRE E* 1(D)> <MOVNS E> <HLRZ F* (P)> <CAIGE E* (F)> ; "Enough space?" <PUSHJ P* NEWUV> ; "No, make a new one" <MOVE A* -1(P)> <MOVE B* 1(D)> ; "Note that NEWUV returns loc in D" <HRLI B* *444400*> <DPUSH TP* (D)> <HLRZ C* (P)> <MOVNS C> <SIN-JSYS> ; "Read it in" <SKIPL -2(TP)> <PUSHJ P* DCLOSE> <MOVE A* <MQUOTE <RGLOC PTUV T>>> <ADD A* GLOTOP 1> <MOVE A* 1(A)> ; "uvector of byte pointers" <MOVEI C* 0> <MOVE D* -4(TP)> ; "field #" <MOVE E* (TP)> ; "Pointer to data" <SOJL D* FIELDE> ; "first one" FIELDL <LDB F* (A)> ; "pick up a length" <ADD C* F> <ADDI A* 1> <SOJGE D* FIELDL> FIELDE <LDB O* (A)> ; "field length" <PUSH P* O> ; "Save it" <PUSH P* C> ; "How far to rest" <MOVE A* O> <IDIVI A* 5> <SKIPE B> <ADDI A* 1> <MOVEI O* IBLOCK> <PUSHJ P* RCALL> ; "UV in A and B" <POP TP* D> ; "Get back data UV" <ADJSP TP* -1> <HRR A* -1(P)> <HRLI A* <TYPE-CODE STRING>> <SUBI B* 1> <HRLI B* *10700*> <DPUSH TP* A> ; "Save as string" <HRRI E* 4(D)> ; "First string word in data" <HRLI E* *440700*> <POP P* C> <IBP C* E> ; "Rest data pointer" <POP P* O> ; "Count to transfer" <JUMPE O* TRANE> TRANL <ILDB A* C> <IDPB A* B> <SOJG O* TRANL> TRANE <POP TP* B> <POP TP* A> <ADJSP P* -2> <ADJSP TP* -6> <JRST MPOPJ> RFALSE <POP P* A> <SKIPL (TP)> <PUSHJ P* DCLOSE> RFALS1 <MOVSI A* <TYPE-CODE FALSE>> <MOVEI B* 0> <ADJSP TP* -6> <JRST MPOPJ> NEWUV <SUBM M* (P)> <HLRZ A* -1(P)> ; "Length of block" <ADDI A* 10> <MOVEI O* IBLOCK> <PUSHJ P* RCALL> <MOVE D* <MQUOTE <RGLOC SPARE-UV T>>> <ADD D* GLOTOP 1> <MOVEM A* (D)> <MOVEM B* 1(D)> <JRST MPOPJ> INIT <SUBM M* (P)> <MOVE E* <MQUOTE <RGLOC FILJFN T>>> <ADD E* GLOTOP 1> <GETYP A* (E)> <CAIE A* <TYPE-CODE FALSE>> <JRST [<MOVE A* 1(E)> <JRST MPOPJ>]> <MOVE A* [<(*100001*) 0>]> <MOVE B* <MQUOTE "PS:<UNSUPPORTED>PEOPLE.DATA�">> <GTJFN> <ERRUUO*> <HRRZS A> <HRRM A* 1(E)> <MOVSI B* <TYPE-CODE FIX>> <MOVEM B* (E)> <JRST MPOPJ> DOPEN <SUBM M* (P)> <MOVE B* [<(*440000*) *200000*>]> <OPENF> <ERRUUO*> <JRST MPOPJ> DCLOSE <SUBM M* (P)> <TLO A* *400000*> <CLOSF> <JFCL> <JRST MPOPJ> <SUB-ENTRY LSR-INIT ("VALUE" FIX)> <PUSHJ P* IINIT> <JRST FINIS> <INTERNAL-ENTRY IINIT 0> <SUBM M* (P)> <PUSHJ P* INIT> ;"Leaves JFN in A" <PUSHJ P* DOPEN> <MOVE E* <MQUOTE <RGLOC FILJFN T>>> <ADD E* GLOTOP 1> <DMOVE A* (E)> <JRST MPOPJ> <SUB-ENTRY LSR-UNINIT ("VALUE" FALSE)> <PUSHJ P* IUNINIT> <JRST FINIS> <INTERNAL-ENTRY IUNINIT 0> <SUBM M* (P)> <MOVE E* <MQUOTE <RGLOC FILJFN T>>> <ADD E* GLOTOP 1> <GETYP O* (E)> <CAIN O* <TYPE-CODE FALSE>> <JRST UNOUT> <MOVE A* 1(E)> <CLOSF> <JFCL> <MOVSI A* <TYPE-CODE FALSE>> <MOVEM A* (E)> <SETZM 1(E)> UNOUT <MOVSI A* <TYPE-CODE FALSE>> <MOVEI B* 0> <JRST MPOPJ> <SUB-ENTRY LSR-ENTRY ("VALUE" <OR FALSE WORD> STRING)> <DPUSH TP* (AB)> <PUSHJ P* IRCUSR> <JRST FINIS> <INTERNAL-ENTRY IRCUSR 1> <SUBM M* (P)> <HRRZ C* -1(TP)> <MOVE B* (TP)> <IDIVI C* 5> <JUMPN D* DORCU> <PUSH TP* -1(TP)> <PUSH TP* -1(TP)> <DPUSH TP* <MQUOTE "�">> <MOVEI A* 2> <PUSHJ P* CISTNG> DORCU <HRLZI A* 1> <RCUSR> <JUMP R* DORERR> <MOVE B* C> <MOVSI A* <TYPE-CODE WORD>> <SUB TP* [<(2) 2>]> <JRST MPOPJ> DORERR <MOVE D* A> <MOVSI C* <TYPE-CODE WORD>> <MOVEI E* 0> <PUSHJ P* CICONS> <MOVSI A* <TYPE-CODE FALSE>> <SUB TP* [<(2) 2>]> <JRST MPOPJ> <SUB-ENTRY NEXT-USER ("VALUE" <OR FALSE WORD> STRING <OR FALSE WORD>)> <DPUSH TP* (AB)> <DPUSH TP* 2(AB)> <PUSHJ P* INEXT> <JRST FINIS> <INTERNAL-ENTRY INEXT 2> <SUBM M* (P)> <MOVE A* -2(TP)> <HRRZ B* -3(TP)> <SUBI B* 1> <IDIVI B* 5> <ADD A* B> <JUMPE C* NLE> NL <IBP A> <SOJE C* NL> NLE <ILDB B* A> <JUMPE B* OKSTR> <ILDB B* A> <JUMPE B* OKSTR> <PUSH TP* -3(TP)> <PUSH TP* -3(TP)> <PUSH TP* <TYPE-WORD CHARACTER>> <PUSH TP* [0]> <MOVEI A* 2> <PUSHJ P* CISTNG> <MOVEM A* -3(TP)> <MOVEM B* -2(TP)> OKSTR <MOVE B* -2(TP)> <MOVE C* (TP)> <GETYP O* -1(TP)> <MOVSI A* *6*> <CAIN O* <TYPE-CODE FALSE>> <TLZ A* *4*> <RCUSR> <TLNE A* *070000*> <JRST [<MOVSI A* <TYPE-CODE FALSE>> <MOVEI B* 0> <JRST LEAVE>]> <MOVSI A* <TYPE-CODE WORD>> <MOVE B* C> LEAVE <ADJSP TP* -4> <JRST MPOPJ> <END> <ENDPACKAGE>