'<PCODE "LUP">

<PACKAGE "LUP"> 

<USE "SDM"> 

<ENTRY LUP-ACT LUP-DCT LUP-DEC LUP-ADD-DATUM LUP-ADD-PACK LUP-MOVE LUP-ADD-ENTRY
LUP-DEL-ENTRY LUP-DEL> 

<OR <GASSIGNED? FC-BUF> <SETG FC-BUF <IUVECTOR 100 0>>> 

<SETG FC  %<RSUBR!- '[ %<PCODE!- "LUP" 0> FC #DECL ("VALUE" <OR ATOM CHANNEL 
FALSE> STRING STRING) SDMPUTVARC CL GROUP-LOAD SDMGETYPE SDMPUT SDMDLI SDMGET 
SDMDCT SDMACT "READB" "PRINTB" %<RGLOC FC-BUF T> T " _LOCK_" " _BLOK_" "PRINTO" 
"FILE LOCKED" "PRINT" TO SNM (STRING) "_UN LOCK_" " _" %<RGLOC L-ITEMS-NAME T> 
%<RGLOC L-INDEX-NAME T> " " %<RGLOC ACTIVE-LUP T> "CURRENTLY ACTIVATED" %<RGLOC 
DBASE-LOCKED T> #FALSE ("DATA BASE LOCKED") %<RGLOC SDMGBC T> %<RGLOC FC T> %<
RGLOC INDX-CHN T> %<RGLOC ITMS-CHN T> %<TYPE-W PMCHAN VECTOR> %<RGLOC UPN1 T> %<
RGLOC UPN2 T> %<RGLOC OSNM T> %<RGLOC ON1 T> %<RGLOC ON2 T> OUTCHAN " ACTIVATED"
 %<RGLOC NULL T> #FALSE ("NO DATA BASE ACTIVE") OBLIST (ANY) 
"ROOT ENTRY NOT ONLY ENTRY" "ALSO PRESENT IN" "!- " "ROOT ENTRY" "IN PACKAGE" 
"ALREADY PRESENT" INITIAL "ATOM, " ", GOES THROUGH INITIAL" PACKAGE RPACKAGE 
ENTRY ENDPACKAGE DEFINE SETG LIST FLOAD #FALSE ("FLOAD ENCOUNTERED") UVECTOR 
WORD VALUE BAD-FIRST-ARG-TO-DEFINE-OR-SETG!-ERRORS %<RGLOC DBASE-BAD T> 
DATA-BASE-MUNGED!-ERRORS DEACTIVATION-NOT-ALLOWED NO-ACTIVE-DATA-BASE!-ERRORS 
ERRET-NON-FALSE-TO-RETRY "READ" "DELETED" "OBJECT APPARENTLY NOT PRESENT" 
ITEM-ALREADY-PRESENT!-ERRORS ERRET-NON-FALSE-TO-UPDATE!-ERRORS LUP-ADD-DATUM %<
RGLOC SDMPUTARC T> %<RGLOC SDMPUTVARC T> "DATUM ADDED" RECYCLED-GROUP-NAME 
LUP-ADD-PACK PACKAGE-ALREADY-PRESENT!-ERRORS L2 (LIST) 
PACKAGE-NOT-PRESENT!-ERRORS LUP-HACK-ENTRY CH FILE-DOES-NOT-EXIST!-ERRORS 
LUP-MOVE]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,FC PGLUE ![715829247 -1 -1 -1 -1 -67108864!]>> 


<SETG LOCK %<RSUBR-ENTRY '[FC LOCK #DECL ("VALUE" <OR CHANNEL FALSE> ANY)] 100>> 

<SETG UNLOCK %<RSUBR-ENTRY '[FC UNLOCK #DECL ("VALUE" <OR ATOM CHANNEL FALSE> 
CHANNEL)] 175>> 

<OR <GASSIGNED? ACTIVE-LUP> <SETG ACTIVE-LUP <>>> 

<OR <GASSIGNED? DBASE-LOCKED> <SETG DBASE-LOCKED <>>> 

<SETG LUP-ACT %<RSUBR-ENTRY '[FC LUP-ACT #DECL ("VALUE" ANY STRING "OPTIONAL" 
ANY)] 206>> 

<SETG LUP-DCT %<RSUBR-ENTRY '[FC LUP-DCT #DECL ("VALUE" <OR ATOM CHANNEL FALSE>)
] 495>> 

<SETG DEL-ENTS %<RSUBR-ENTRY '[FC DEL-ENTS #DECL ("VALUE" ATOM ANY STRING <LIST 
[REST ATOM]>)] 610>> 

<SETG ADD-ENTS %<RSUBR-ENTRY '[FC ADD-ENTS #DECL ("VALUE" <OR ATOM FALSE> ANY 
STRING <LIST [REST ATOM]>)] 828>> 

<SETG COB %<RSUBR-ENTRY '[FC COB #DECL ("VALUE" <OR ATOM FALSE> ATOM)] 1165>> 

<SETG CL %<RSUBR-ENTRY '[FC CL #DECL ("VALUE" <OR FALSE <LIST <OR FALSE STRING> 
<LIST [REST ATOM]>>> LIST)] 1256>> 

<SETG CPL %<RSUBR-ENTRY '[FC CPL #DECL ("VALUE" <OR ATOM FALSE> <PRIMTYPE LIST> 
ANY)] 1669>> 

<SETG CPA %<RSUBR-ENTRY '[FC CPA #DECL ("VALUE" <OR ATOM FALSE> STRUCTURED ANY)]
1788>> 

<SETG GATM %<RSUBR-ENTRY '[FC GATM #DECL ("VALUE" ANY ANY)] 1893>> 

<OR <GASSIGNED? DBASE-BAD> <SETG DBASE-BAD <>>> 

<OR <LOOKUP "NULL" <ROOT>> <SETG <INSERT "NULL" <ROOT>> <INSERT <STRING <ASCII 
127>> <ROOT>>>> 

<SETG OK-BASE? %<RSUBR-ENTRY '[FC OK-BASE? #DECL ("VALUE" ATOM)] 1954>> 

<SETG FNEXP %<RSUBR-ENTRY '[FC FNEXP #DECL ("VALUE" <LIST ANY STRING> ANY)] 1986
>> 

<SETG LUP-DEL %<RSUBR-ENTRY '[FC LUP-DEL #DECL ("VALUE" STRING STRING)] 2030>> 

<SETG LUP-ADD-DATUM %<RSUBR-ENTRY '[FC LUP-ADD-DATUM #DECL ("VALUE" <OR FALSE 
STRING> STRING STRING "OPTIONAL" ANY ANY)] 2143>> 

<SETG LUP-ADD-PACK %<RSUBR-ENTRY '[FC LUP-ADD-PACK #DECL ("VALUE" <OR FALSE <
VECTOR STRING ANY>> STRING "OPTIONAL" ANY ANY)] 2265>> 

<SETG LDIF %<RSUBR-ENTRY '[FC LDIF #DECL ("VALUE" <LIST [REST ATOM]> <LIST [REST
ATOM]> LIST)] 2567>> 

<SETG LUP-HACK-ENTRY %<RSUBR-ENTRY '[FC LUP-HACK-ENTRY #DECL ("VALUE" <LIST [
REST ATOM]> STRING <OR ATOM <LIST [REST ATOM]>> <OR 'T FALSE>)] 2640>> 

<SETG LUP-ADD-ENTRY %<RSUBR-ENTRY '[FC LUP-ADD-ENTRY #DECL ("VALUE" <LIST [REST 
ATOM]> STRING <OR ATOM <LIST [REST ATOM]>>)] 2807>> 

<SETG LUP-DEL-ENTRY %<RSUBR-ENTRY '[FC LUP-DEL-ENTRY #DECL ("VALUE" <LIST [REST 
ATOM]> STRING <OR ATOM <LIST [REST ATOM]>>)] 2827>> 

<SETG LUP-MOVE %<RSUBR-ENTRY '[FC LUP-MOVE #DECL ("VALUE" ANY STRING STRING)] 
2848>> 

<SETG LINCA %<RSUBR-ENTRY '[FC LINCA #DECL ("VALUE" <LIST [REST ATOM]> <LIST [
REST ATOM]> LIST)] 2915>> 

<SETG LDIFA %<RSUBR-ENTRY '[FC LDIFA #DECL ("VALUE" <LIST [REST ATOM]> <LIST [
REST ATOM]> LIST)] 3029>> 

<ENDPACKAGE>