(FILECREATED "25-Apr-84 16:01:35" {INDIGO}<LOOPS>SOURCES>LOOPSUID.;8 7077
changes to: (FNS DB-PackUI)
previous date: "10-Feb-84 10:28:53" {INDIGO}<LOOPS>SOURCES>LOOPSUID.;7)
(PRETTYCOMPRINT LOOPSUIDCOMS)
(RPAQQ LOOPSUIDCOMS ((* Copyright (c)
1983 by Xerox Corporation)
(* Creates unique identifiers for instances)
(RECORDS UIREC)
(VARS * UIVARS)
(FNS * UIFNS)
(P (DB-InitUI))))
(* Copyright (c) 1983 by Xerox Corporation)
(* Creates unique identifiers for instances)
[DECLARE: EVAL@COMPILE
(RECORD UIREC (NetNumber HostNumber PartitionNumber Day Month Year UICount))
]
(RPAQQ UIVARS ((DB.PRINTDESTINATION PROMPTWINDOW)
[DB.UIFILENAME (COND ((FMEMB (SYSTEMTYPE)
(QUOTE (ALTO D)))
(QUOTE {DSK}Lore-UI.SAVE))
(T (QUOTE Lore-UI.SAVE]
(DB.UIREC NIL)
(DB.FRONTUI NIL)
(DB.UICOUNT 0)
(DB.UIDUMPINCR 1000)
(DB.NEXTUIDUMP NIL)
(DB.ENVIRONMENT NIL)
(UIDPRINTFLG)
(NETNUMBER 0)))
(RPAQ DB.PRINTDESTINATION PROMPTWINDOW)
(RPAQ DB.UIFILENAME (COND ((FMEMB (SYSTEMTYPE)
(QUOTE (ALTO D)))
(QUOTE {DSK}Lore-UI.SAVE))
(T (QUOTE Lore-UI.SAVE))))
(RPAQQ DB.UIREC NIL)
(RPAQQ DB.FRONTUI NIL)
(RPAQQ DB.UICOUNT 0)
(RPAQQ DB.UIDUMPINCR 1000)
(RPAQQ DB.NEXTUIDUMP NIL)
(RPAQQ DB.ENVIRONMENT NIL)
(RPAQQ UIDPRINTFLG NIL)
(RPAQQ NETNUMBER 0)
(RPAQQ UIFNS (DB-InitUI DB-PackUI DB-UnpackUI RADIX64NUM UID))
(DEFINEQ
(DB-InitUI
[LAMBDA NIL (* dgb: "10-Feb-84 10:27")
(* DECLARATIONS: INTEGER)
(* Initializes the UniqueIdentifer Generation System in
DB. Sets the global variables DB.FRONTUI and and
DB.UICOUNT)
(PROG (date year month day monthCode dateCode startIndex temp nsHostNumber)
(* Compute DB.FRONTUI and DB.UIREC for today.)
(AND [NLISTP (SETQ nsHostNumber (EVALV (QUOTE \MY.NSHOSTNUMBER]
(SETQ nsHostNumber (LIST (DAYTIME)
0 0)))
(* Set up hostNumbe from \MY.NSHOSTNUMBER which should always be set in Interlisp-D -- else compute a random one
which should not be used by any one)
(SETQ date (DATE)) (* Compute dateCode which encodes the date in 16 bits.)
(SETQ year (SUBATOM date 8 9))
(SETQ month (SUBATOM date 4 6))
(SETQ day (OR (NUMBERP (SUBATOM date 1 2))
(SUBATOM date 2 2)))
[SETQ startIndex (IDIFFERENCE (IDATE date)
(IDATE (CONCAT (SUBSTRING date 1 10)
"00:00:00"]
(* start index is seconds today.
Wait a second to be sure no one can use this index
again)
(WAITMS 1000)
(SETQ monthCode (SELECTQ month
((Jan JAN)
(QUOTE J))
((Feb FEB)
(QUOTE F))
((Mar MAR)
(QUOTE M))
((Apr APR)
(QUOTE A))
((May MAY)
(QUOTE Y))
((Jun JUN)
(QUOTE U))
((Jul JUL)
(QUOTE L))
((Aug AUG)
(QUOTE G))
((Sep SEP)
(QUOTE S))
((Oct OCT)
(QUOTE O))
((Nov NOV)
(QUOTE N))
((Dec DEC)
(QUOTE D))
(ERROR month "IS NOT A MONTH")))
(* An unique ID consists of a front followed by a count. The front is set up any time one enters -- It is unique
because it contains the machine ID, the date, time of day in seconds, and has waited a second.
It then creates all of the UIDS in order from there.)
(SETQ DB.UICOUNT 0)
(RETURN (SETQ DB.FRONTUI (CONCAT monthCode (CHARACTER (IPLUS 64 day))
(CHARACTER year)
(RADIX64NUM (CADR nsHostNumber))
(QUOTE %.)
(RADIX64NUM (IPLUS (LLSH (CADDR nsHostNumber)
6)
(CADDDR nsHostNumber)))
(QUOTE %.)
(RADIX64NUM startIndex)
(QUOTE %.])
(DB-PackUI
[LAMBDA NIL (* dgb: "25-Apr-84 15:46")
(* Creates and returns a unique identifier.)
(CONCAT DB.FRONTUI (SETQ DB.UICOUNT (ADD1 DB.UICOUNT])
(DB-UnpackUI
[LAMBDA (UI) (* dgb: " 7-JUL-83 23:57")
(* DECLARATIONS: INTEGER)
(* Given a unique identifier, returns a UIREC record
that unpacks and decodes the bits.)
(PROG (netNumber hostNumber partiton day month year uiCount charCodes dateCode)
(SETQ charCodes (CHCON UI)) (* Decode the ethernet number and host number.)
(SETQ dateCode (IPLUS (CADDR charCodes)
(LSH (CADDDR charCodes)
8)))
(SETQ year (CAR (NTH charCodes 3)))
(SETQ day (IDIFFERENCE (CAR (NTH charCodes 2))
64))
(SETQ month (SELECTQ (CHARACTER (CAR charCodes))
(J (QUOTE JAN))
(F (QUOTE FEB))
(M (QUOTE MAR))
(A (QUOTE APR))
(Y (QUOTE MAY))
(U (QUOTE JUN))
(L (QUOTE JUL))
(G (QUOTE AUG))
(S (QUOTE SEP))
(O (QUOTE OCT))
(N (QUOTE NOV))
(D (QUOTE DEC))
(ERROR month "IS NOT A MONTH")))
(RETURN (LIST "Created" day month year])
(RADIX64NUM
[LAMBDA (inputNum) (* dgb: "31-OCT-83 10:01")
(* Computes a string which uses 64 printing characters
to represent a number)
(PROG (rem (chars (CONS))
(num inputNum))
LP (SETQ rem (SELECTQ (SETQ rem (IPLUS 48 (LOGAND 63 num)))
(96 (* change non printing character to a printing one)
122)
rem))
(TCONC chars (CHARACTER rem))
[COND
((EQ 0 (SETQ num (LRSH num 6)))
(RETURN (CONCATLIST (CAR chars]
(GO LP])
(UID
[LAMBDA (obj nameFlg) (* dgb: "28-DEC-83 08:50")
(* * creates the form of UID that is to be stored on a file. Currently we have atom as UID in entityRecord, so
must convert it to string for printout on file. If nameFlg is T returns the atom)
(PROG ((uid (fetch OBJUID of obj)))
[COND
([OR (NULL uid)
(NOT (type? Entity (GetEntityFromUID uid]
(SETQ uid (CreateEntity obj uid]
(RETURN (COND
(nameFlg (MKNAME uid))
(T (MKSTRING uid])
)
(DB-InitUI)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1544 7043 (DB-InitUI 1554 . 4292) (DB-PackUI 4294 . 4569) (DB-UnpackUI 4571 . 5808) (
RADIX64NUM 5810 . 6469) (UID 6471 . 7041)))))
STOP