<mdllib>/lsrtns.mud.20

   1 <PACKAGE "LSRTNS">
   2
   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>
   6
   7 <SETG $DNAME 0>
   8 <SETG $HNAME 1>
   9 <SETG $NNAME 2>
  10 <SETG $WADDR 3>
  11 <SETG $WPHON 4>
  12 <SETG $HADDR 5>
  13 <SETG $HPHON 6>
  14 <SETG $NADDR 7>
  15 <SETG $BRDAY 8>
  16 <SETG $SUPER 9>
  17 <SETG $PROJN 10>
  18 <SETG $ACCNT 11>
  19 <SETG $RELAT 12>
  20 <SETG $REMRK 13>
  21 <SETG $ALTBY 14>
  22
  23 <MANIFEST $DNAME $HNAME $NNAME $WADDR $WPHON $HADDR $HPHON
  24           $NADDR $BRDAY $SUPER $PROJN $ACCNT $RELAT $REMRK
  25           $ALTBY>
  26
  27 ; "These are all (E)"
  28 <SETG PTUV <UVECTOR
  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">>
  44
  45 <SETG SPARE-UV <IUVECTOR 50>>
  46
  47 <SETG FILJFN <>>
  48
  49 <TITLE LSR-EXTRACT>
  50         <DECLARE ("VALUE" <OR STRING FALSE>
  51                   <OR STRING <PRIMTYPE WORD>> FIX "OPTIONAL" <OR ATOM FALSE>)>
  52         <HLRE   A* AB>
  53 PLOOP   <DPUSH  TP* (AB)>
  54         <ADD    AB* [<(2) 2>]>
  55         <JUMPL  AB* PLOOP>
  56         <ASH    A* -1>
  57         <ADDI   A* DTAB>
  58         <PUSHJ  P* @ 2(A)>
  59         <JRST   FINIS>
  60         <IFIELD3>
  61 DTAB    <IFIELD2>
  62
  63 <INTERNAL-ENTRY IFIELD2 2>
  64         <PUSH   TP* <TYPE-WORD FALSE>>
  65         <PUSH   TP* [0]>
  66 <INTERNAL-ENTRY IFIELD3 3>
  67         <SUBM   M* (P)>
  68         <GETYP  O* -5(TP)>
  69         <CAIE   O* <TYPE-CODE STRING>>
  70          <JRST  GTFIL>
  71         <PUSH   TP* -5(TP)>
  72         <PUSH   TP* -5(TP)>
  73         <PUSHJ  P* IRCUSR>
  74         <GETYP  O* A>
  75         <CAIN   O* <TYPE-CODE FALSE>>
  76          <JRST  RFALS1>                 ; "No such user"
  77         <DMOVEM A* -5(TP)>              ; "Save user number"
  78 GTFIL   <SKIPGE (TP)>
  79          <JRST  [<MOVE  A* <MQUOTE <RGLOC FILJFN T>>>
  80                  <ADD   A* GLOTOP 1>
  81                  <MOVE  A* 1(A)>
  82                  <JRST  GOTFIL>]>
  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"
  89         <PUSH   P* B>
  90         <HRRZS  B>
  91         <SFPTR>
  92          <JFCL>
  93         <MOVE   D* <MQUOTE <RGLOC SPARE-UV T>>>
  94         <ADD    D* GLOTOP 1>
  95         <HLRE   E* 1(D)>
  96         <MOVNS  E>
  97         <HLRZ   F* (P)>
  98         <CAIGE  E* (F)>                 ; "Enough space?"
  99          <PUSHJ P* NEWUV>               ; "No, make a new one"
 100         <MOVE   A* -1(P)>
 101         <MOVE   B* 1(D)>                ; "Note that NEWUV returns loc in D"
 102         <HRLI   B* *444400*>
 103         <DPUSH  TP* (D)>
 104         <HLRZ   C* (P)>
 105         <MOVNS  C>
 106         <SIN-JSYS>                      ; "Read it in"
 107         <SKIPL  -2(TP)>
 108          <PUSHJ P* DCLOSE>
 109         <MOVE   A* <MQUOTE <RGLOC PTUV T>>>
 110         <ADD    A* GLOTOP 1>
 111         <MOVE   A* 1(A)>                ; "uvector of byte pointers"
 112         <MOVEI  C* 0>
 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"
 117         <ADD    C* F>
 118         <ADDI   A* 1>
 119         <SOJGE  D* FIELDL>
 120 FIELDE  <LDB    O* (A)>                 ; "field length"
 121         <PUSH   P* O>                   ; "Save it"
 122         <PUSH   P* C>                   ; "How far to rest"
 123         <MOVE   A* O>
 124         <IDIVI  A* 5>
 125         <SKIPE  B>
 126          <ADDI  A* 1>
 127         <MOVEI  O* IBLOCK>
 128         <PUSHJ  P* RCALL>               ; "UV in A and B"
 129         <POP    TP* D>                  ; "Get back data UV"
 130         <ADJSP  TP* -1>
 131         <HRR    A* -1(P)>
 132         <HRLI   A* <TYPE-CODE STRING>>
 133         <SUBI   B* 1>
 134         <HRLI   B* *10700*>
 135         <DPUSH  TP* A>                  ; "Save as string"
 136         <HRRI   E* 4(D)>                ; "First string word in data"
 137         <HRLI   E* *440700*>
 138         <POP    P* C>
 139         <IBP    C* E>                   ; "Rest data pointer"
 140         <POP    P* O>                   ; "Count to transfer"
 141         <JUMPE  O* TRANE>
 142 TRANL   <ILDB   A* C>
 143         <IDPB   A* B>
 144         <SOJG   O* TRANL>
 145 TRANE   <POP    TP* B>
 146         <POP    TP* A>
 147         <ADJSP  P* -2>
 148         <ADJSP  TP* -6>
 149         <JRST   MPOPJ>
 150 RFALSE  <POP    P* A>
 151         <SKIPL  (TP)>
 152          <PUSHJ P* DCLOSE>
 153 RFALS1  <MOVSI  A* <TYPE-CODE FALSE>>
 154         <MOVEI  B* 0>
 155         <ADJSP  TP* -6>
 156         <JRST   MPOPJ>
 157
 158 NEWUV   <SUBM   M* (P)>
 159         <HLRZ   A* -1(P)>               ; "Length of block"
 160         <ADDI   A* 10>
 161         <MOVEI  O* IBLOCK>
 162         <PUSHJ  P* RCALL>
 163         <MOVE   D* <MQUOTE <RGLOC SPARE-UV T>>>
 164         <ADD    D* GLOTOP 1>
 165         <MOVEM  A* (D)>
 166         <MOVEM  B* 1(D)>
 167         <JRST   MPOPJ>
 168
 169 INIT    <SUBM   M* (P)>
 170         <MOVE   E* <MQUOTE <RGLOC FILJFN T>>>
 171         <ADD    E* GLOTOP 1>
 172         <GETYP  A* (E)>
 173         <CAIE   A* <TYPE-CODE FALSE>>
 174          <JRST  [<MOVE  A* 1(E)>
 175                  <JRST  MPOPJ>]>
 176         <MOVE   A* [<(*100001*) 0>]>
 177         <MOVE   B* <MQUOTE "PS:<UNSUPPORTED>PEOPLE.DATA\0">>
 178         <GTJFN>
 179          <ERRUUO*>
 180         <HRRZS  A>
 181         <HRRM   A* 1(E)>
 182         <MOVSI  B* <TYPE-CODE FIX>>
 183         <MOVEM  B* (E)>
 184         <JRST   MPOPJ>
 185
 186 DOPEN   <SUBM   M* (P)>
 187         <MOVE   B* [<(*440000*) *200000*>]>
 188         <OPENF>
 189          <ERRUUO*>
 190         <JRST   MPOPJ>
 191
 192 DCLOSE  <SUBM   M* (P)>
 193         <TLO    A* *400000*>
 194         <CLOSF>
 195          <JFCL>
 196         <JRST   MPOPJ>
 197
 198 <SUB-ENTRY LSR-INIT ("VALUE" FIX)>
 199         <PUSHJ  P* IINIT>
 200         <JRST   FINIS>
 201
 202 <INTERNAL-ENTRY IINIT 0>
 203         <SUBM   M* (P)>
 204         <PUSHJ  P* INIT>        ;"Leaves JFN in A"
 205         <PUSHJ  P* DOPEN>
 206         <MOVE   E* <MQUOTE <RGLOC FILJFN T>>>
 207         <ADD    E* GLOTOP 1>
 208         <DMOVE  A* (E)>
 209         <JRST   MPOPJ>
 210
 211 <SUB-ENTRY LSR-UNINIT ("VALUE" FALSE)>
 212         <PUSHJ  P* IUNINIT>
 213         <JRST   FINIS>
 214
 215 <INTERNAL-ENTRY IUNINIT 0>
 216         <SUBM   M* (P)>
 217         <MOVE   E* <MQUOTE <RGLOC FILJFN T>>>
 218         <ADD    E* GLOTOP 1>
 219         <GETYP  O* (E)>
 220         <CAIN   O* <TYPE-CODE FALSE>>
 221          <JRST  UNOUT>
 222         <MOVE   A* 1(E)>
 223         <CLOSF>
 224          <JFCL>
 225         <MOVSI  A* <TYPE-CODE FALSE>>
 226         <MOVEM  A* (E)>
 227         <SETZM  1(E)>
 228 UNOUT   <MOVSI  A* <TYPE-CODE FALSE>>
 229         <MOVEI  B* 0>
 230         <JRST   MPOPJ>
 231
 232 <SUB-ENTRY LSR-ENTRY ("VALUE" <OR FALSE WORD> STRING)>
 233         <DPUSH  TP* (AB)>
 234         <PUSHJ  P* IRCUSR>
 235         <JRST   FINIS>
 236
 237 <INTERNAL-ENTRY IRCUSR 1>
 238         <SUBM   M* (P)>
 239         <HRRZ   C* -1(TP)>
 240         <MOVE   B* (TP)>
 241         <IDIVI  C* 5>
 242         <JUMPN  D* DORCU>
 243         <PUSH   TP* -1(TP)>
 244         <PUSH   TP* -1(TP)>
 245         <DPUSH  TP* <MQUOTE "\0">>
 246         <MOVEI  A* 2>
 247         <PUSHJ  P* CISTNG>
 248 DORCU   <HRLZI  A* 1>
 249         <RCUSR>
 250         <JUMP   R* DORERR>
 251         <MOVE   B* C>
 252         <MOVSI  A* <TYPE-CODE WORD>>
 253         <SUB    TP* [<(2) 2>]>
 254         <JRST   MPOPJ>
 255 DORERR  <MOVE   D* A>
 256         <MOVSI  C* <TYPE-CODE WORD>>
 257         <MOVEI  E* 0>
 258         <PUSHJ  P* CICONS>
 259         <MOVSI  A* <TYPE-CODE FALSE>>
 260         <SUB    TP* [<(2) 2>]>
 261         <JRST   MPOPJ>
 262
 263 <SUB-ENTRY NEXT-USER ("VALUE" <OR FALSE WORD> STRING <OR FALSE WORD>)>
 264         <DPUSH  TP* (AB)>
 265         <DPUSH  TP* 2(AB)>
 266         <PUSHJ  P* INEXT>
 267         <JRST   FINIS>
 268
 269 <INTERNAL-ENTRY INEXT 2>
 270         <SUBM   M* (P)>
 271         <MOVE   A* -2(TP)>
 272         <HRRZ   B* -3(TP)>
 273         <SUBI   B* 1>
 274         <IDIVI  B* 5>
 275         <ADD    A* B>
 276         <JUMPE  C* NLE>
 277 NL      <IBP    A>
 278         <SOJE   C* NL>
 279 NLE     <ILDB   B* A>
 280         <JUMPE  B* OKSTR>
 281         <ILDB   B* A>
 282         <JUMPE  B* OKSTR>
 283         <PUSH   TP* -3(TP)>
 284         <PUSH   TP* -3(TP)>
 285         <PUSH   TP* <TYPE-WORD CHARACTER>>
 286         <PUSH   TP* [0]>
 287         <MOVEI  A* 2>
 288         <PUSHJ  P* CISTNG>
 289         <MOVEM  A* -3(TP)>
 290         <MOVEM  B* -2(TP)>
 291 OKSTR   <MOVE   B* -2(TP)>
 292         <MOVE   C* (TP)>
 293         <GETYP  O* -1(TP)>
 294         <MOVSI  A* *6*>
 295         <CAIN   O* <TYPE-CODE FALSE>>
 296          <TLZ   A* *4*>
 297         <RCUSR>
 298         <TLNE   A* *070000*>
 299          <JRST  [<MOVSI A* <TYPE-CODE FALSE>>
 300                  <MOVEI B* 0>
 301                  <JRST  LEAVE>]>
 302         <MOVSI  A* <TYPE-CODE WORD>>
 303         <MOVE   B* C>
 304 LEAVE   <ADJSP  TP* -4>
 305         <JRST   MPOPJ>
 306
 307 <END>
 308
 309 <ENDPACKAGE>