(FILECREATED "18-SEP-77 19:31:34" <KRL1>MEMSTRUC.;63 26247 changes to: MEMSTRUCCOMS previous date: "15-SEP-77 08:39:07" <KRL1>MEMSTRUC.;62) (PRETTYCOMPRINT MEMSTRUCCOMS) (RPAQQ MEMSTRUCCOMS ((* Defines stuff for memory level structures on a fiel) (FILEDOC) (F: (AllocateFileObject COPYFILE CreateSpace Doublet FileObjectName FindCurrentPage GetFileObject HandleFor InitKrlMem KrlSysoutAdvice MYFAILEDMAPIN MakeKCTemplate ReleaseHandle SetLispArray SpaceName)) (MACROS: (CheckHandle ClearField ConstantHandle FetchMem HLOC HandleValue KrlCreate LispFor MYMAPIN NLoadField NSetField NewHandle PMAP SetHandleFlag SmashHandle StoreMem TestHandleFlag)) (DMACROS: (KrlCreate FetchMem StoreMem)) (PROP OPD LDV2@) (VARS (SYSSPACEDIRECTORY)))) (* Defines stuff for memory level structures on a fiel) (DECLARE: DONTCOPY (* Externally available functions: FileObjectName: Gets name for handle, either atom or cons of two atoms GetFileObject: Tries to find object with given name, either string, atom or cons of two. returns NIL if not there, smashing oldHandle to 0 if there. If found, reuses oldHandle if there, sets type to type or guesses based on name, sets Named and/or Primary if appropriate, returns handle HandleFor: Returns a pseudo handle to an arbitrary S expression, reusing oldHandle if present. If it is a PseudoHandle, will reuse its slot in the array, thus freeing the old contents Externally available variables: None Masterscope database on file MEMSTRUC.DATABASE External functions called: CLOSEHASHFILE: OPENHASHFILE: EVALNEXUS: This is the defeval fn for nexuses GETHASHFILE: KrlTypeName: Converts a type code to a type ame for a memory structure GETPNAME: Returns a temporary string pointer to the PNAME of ATOMPTR. GETPAGE: Returns the page number of a virgin page in HASHFILE. Available to a user who wants non-hash pages in the file KrlTypeCode: Looks up the type code for a memory structure PUTHASHFILE: External variables used freely: SYSHASHFILE: The KRL memory file OLDKRLMEMFILE: address space file from previous sysout KRLMEMFILE: Address space file for KRL memory structures MAXKRLMEMIO: size of arrays of file-to-core pointers MAXKRLMEMLAI: size of array of arrays for file-to-core pointers KRLMEMLISPARRAY: array of arrays for file-to-core pointers KRLMEMCARFLG: if T then last stored file-to-core poitner used SETA else SETD KRLMEMITEMOFFSET: current slot in current array for file-to-core pointers KRLMEMLAINDEX: Last used slot in the array of arrays for file-to-core pointers CURRENTMEMORYSPACE: The space in which objects are allocated faut de mieux )) (InitDoc MEMSTRUC (FileObjectName GetFileObject HandleFor) NIL (PUTHASHFILE GETHASHFILE OPENHASHFILE CLOSEHASHFILE))(PRETTYCOMPRINT (F: (AllocateFileObject COPYFILE CreateSpace Doublet FileObjectName FindCurrentPage GetFileObject HandleFor InitKrlMem KrlSysoutAdvice MYFAILEDMAPIN MakeKCTemplate ReleaseHandle SetLispArray SpaceName))) (DEFINEQ (AllocateFileObject [LAMBDA (#words name type space handle) (* ht: "14-JUL-77 12:03" posted: " 7-JUN-77 15:59") (* returns a handle to a new object) (if #words GT 509 then (ERROR #words "exceeds max. object size (509)")) (if ~space then space←(OR CURRENTMEMORYSPACE 'NeutralSpace)) (if ~handle then handle←(create FileHandle)) (PROG ((dirEnt (FindCurrentPage space)) nfw curPagePtr oldPagePtr dirBlockPtr fw) (curPagePtr←dirEnt:spacePagePtr) (if nfw←(fw←dirEnt:spaceFreeWord)+#words GT 512 then (dirBlockPtr←dirEnt:spaceBlockPtr) (if ~(AND (EQP dirBlockPtr:currentPagePtr (HandleValue curPagePtr)) (EQP dirBlockPtr:currentPageIndex dirEnt:spacePageIndex) (EQP curPagePtr:firstFreeWord dirEnt:spaceFreeWord)) then (HELP "inconsistent directory entry")) (oldPagePtr←curPagePtr) [curPagePtr←(create FileHandle filePage# ←(GETPAGE) hType ←(CONSTANT (KrlTypeCode 'FilePage] (curPagePtr:firstFreeWord←3) (StoreMem curPagePtr predecessorPagePtr oldPagePtr) (StoreMem curPagePtr spaceIDPtr dirBlockPtr) (dirEnt:spacePagePtr←curPagePtr) (StoreMem dirBlockPtr currentPagePtr curPagePtr) (dirEnt:spaceFreeWord←fw←3) (dirBlockPtr:currentPageIndex←(dirEnt:spacePageIndex←dirEnt:spacePageIndex+1)) (nfw←fw+#words)) (curPagePtr:firstFreeWord←nfw) (dirEnt:spaceFreeWord←nfw) (handle:filePage#←curPagePtr:filePage#) (handle:fileWord#←fw) (handle:hType←(OR type 0)) (handle:hFlags←0) (if name then (PUTHASHFILE (if (NLISTP name) then name else (Doublet name:1 name::1)) handle)) (RETURN handle]) (COPYFILE [LAMBDA (FROM TO) (* ht: "15-JUN-77 12:57" posted: "14-JUN-77 17:47") (* Uses SUBSYS to do it) (TENEX (CONCAT "COPY " FROM " " TO←(OUTFILEP TO) " ")) TO]) (CreateSpace [LAMBDA (name) (* ht: "14-JUL-77 12:04" posted: "15-JUN-77 14:33") (* creates a new space in the memory file, error if already there) (PROG (fp1 fp2 cp (fw 3)) (if (FindCurrentPage name T) then (ERROR name "is already a space name")) (cp←(GETPAGE)) (if name='SpaceDirectory then [fp1←(create FileHandle filePage# ← cp fileWord# ← 3 hType ←(CONSTANT (KrlTypeCode 'SpaceAllocBlock] (PUTHASHFILE (Doublet "KrlSysMemSpace" name) fp1) (fw←6) else fp1←(KrlCreate SpaceAllocBlock <"KrlSysMemSpace" ! name> 'SpaceDirectory)) (fp1:currentPageIndex←1) [fp2←(create FileHandle filePage# ← cp hType ←(CONSTANT (KrlTypeCode 'FilePage] (StoreMem fp1 currentPagePtr fp2) (fp2:firstFreeWord←fw) (StoreMem fp2 spaceIDPtr fp1) (fp2:predecessorPagePtr←0) (push SYSSPACEDIRECTORY (<name ! (create SpaceDirEntry spacePagePtr ← fp2 spacePageIndex ← 1 spaceFreeWord ← fw spaceBlockPtr ← fp1) >]) (Doublet [LAMBDA (s1 s2 scratchString scratchPtr) (* ht: "15-JUN-77 23:33" posted: "15-JUN-77 17:20") (* makes two strings into a single one for hashing uniquely (almost)) (PROG ((nc ((NCHARS s1)+ 1))) (if ~scratchString then scratchString←(CONSTANT (CONCAT " " ))) (if ~scratchPtr then scratchPtr←(CONSTANT (CONCAT ""))) (RPLSTRING scratchString 1 s1) (RPLSTRING scratchString nc (FCHARACTER 0)) (RPLSTRING scratchString nc+1 s2) (RETURN (SUBSTRING scratchString 1 nc+(NCHARS s2) scratchPtr]) (FileObjectName [LAMBDA (h noErrFlg) (* ht: "15-SEP-77 08:38" posted: "14-JUL-77 13:11") (* Gets name for handle, either atom or cons of two atoms) (PROG ((s (GETPNAME h)) n) (if s then (if n←(STRPOS (FCHARACTER 0) s) then (RETURN <(MKATOM (SUBSTRING s 1 n-1)) ! (MKATOM (SUBSTRING s n+1))>) else (RETURN (MKATOM s))) else (if noErrFlg then (RETURN) else (ERROR "not a file object" h]) (FindCurrentPage [LAMBDA (space flg) (* ht: "14-JUL-77 11:58" posted: "15-JUN-77 17:20") (* returns the in core directory entry for a space if Flg is NIL, otherwise returns T if space exists, NIL otherwise) (OR (CDR (FASSOC space SYSSPACEDIRECTORY)) (PROG (fp1 fp2 de) (if fp1←(GetFileObject <"KrlSysMemSpace" ! space> NIL (CONSTANT (KrlTypeCode 'SpaceAllocBlock))) then (if flg then (RETURN T)) (de←(create SpaceDirEntry (spacePagePtr←fp2←(FetchMem fp1 currentPagePtr)) spacePageIndex ← fp1:currentPageIndex)) (de:spaceFreeWord←fp2:firstFreeWord) (push SYSSPACEDIRECTORY (<space ! de>)) (RETURN de) else (if flg then (RETURN) else (ERROR space "is not a valid space name"]) (GetFileObject [LAMBDA (name oldHandle type) (* ht: "19-AUG-77 09:07" posted: "14-JUL-77 13:12") (* Tries to find object with given name, either string, atom or cons of two. returns NIL if not there, smashing oldHandle to 0 if there. If found, reuses oldHandle if there, sets type to type or guesses based on name, sets Named and/or Primary if appropriate, returns handle) (PROG [(v (GETHASHFILE (if (NLISTP name) then name else (Doublet name:1 name::1] (if v then (if ~oldHandle then oldHandle←(create FileHandle) else (oldHandle:hFlags←0)) (oldHandle:fPtr←v) [oldHandle:hType←(OR type (if (LISTP name) then (CONSTANT (KrlTypeCode 'Anchor)) else (CONSTANT (KrlTypeCode 'MemUnit] (SELECTQ (KrlTypeName oldHandle:hType) (MemUnit oldHandle:Named←T) (Anchor oldHandle:Named←T oldHandle:Primary←T (* this is really too simple. needs to check metaAnchor somehow) ) NIL) (RETURN oldHandle) else (if oldHandle then (oldHandle:fPtr←0)) (RETURN]) (HandleFor [LAMBDA (sExp oldHandle) (* ht: "13-SEP-77 11:39" posted: "28-JUN-77 17:28") (* Returns a pseudo handle to an arbitrary S expression, reusing oldHandle if present. If it is a PseudoHandle, will reuse its slot in the array, thus freeing the old contents) (if (AND oldHandle oldHandle:hType=(CONSTANT (KrlTypeCode 'PseudoHandle))) then (SetLispArray oldHandle:array# oldHandle:itemOffset oldHandle:carFlg sExp) else [if KRLMEMCARFLG then KRLMEMCARFLG←NIL else (KRLMEMCARFLG←T) (if (add KRLMEMITEMOFFSET 1) GT MAXKRLMEMIO then (if (add KRLMEMLAINDEX 1) GT MAXKRLMEMLAI then (HELP "Exceeded size of arrays for storing file-to-LISP pointers") else (KRLMEMITEMOFFSET←1) ((ELT KRLMEMLISPARRAY KRLMEMLAINDEX)←(ARRAY MAXKRLMEMIO] (if oldHandle then (oldHandle:hFlags←0) else oldHandle←(create DFileHandle)) (oldHandle:hType←(CONSTANT (KrlTypeCode 'PseudoHandle))) (SetLispArray oldHandle:array#←KRLMEMLAINDEX oldHandle:itemOffset←KRLMEMITEMOFFSET oldHandle:carFlg←KRLMEMCARFLG sExp)) oldHandle]) (InitKrlMem [LAMBDA NIL (* ht: "13-SEP-77 17:19" posted: "14-JUN-77 18:53") (* Figure what fiel to use for memory and open it properly) (DEFEVAL 'NEXUS (FUNCTION EVALNEXUS)) (PROG ((flg ('SYMBOLTABLE)) (SYSBUFFERLISTSIZE 4)) (if OLDKRLMEMFILE then (printout NIL T "Old memory file is " OLDKRLMEMFILE "," T) (GO OLDF)) (SELECTQ [OLDKRLMEMFILE←(ASKUSER DWIMWAIT 'Y "Use a new (virgin) memory file? " '((Y "es ") (N "o old file name: " KEYLST (( NIL RETURN (CADR ANSWER] (Y KRLMEMFILE←(OUTFILEP (PACKFILENAME 'DIRECTORY USERNAME 'NAME KRLMEMFILE 'EXTENSION 'KRL)) (GO NEWF)) NIL) OLDF(KRLMEMFILE←(SELECTQ (ASKUSER DWIMWAIT 'C "use a Copy or Modify the original? " '((C "opy ") (M "odify "))) (M (INFILEP OLDKRLMEMFILE)) (C (COPYFILE (INFILEP OLDKRLMEMFILE) (PACKFILENAME 'DIRECTORY USERNAME 'NAME KRLMEMFILE 'EXTENSION 'KRL))) (SHOULDNT))) (flg←T) NEWF(printout NIL T "Using " KRLMEMFILE " as memory file" T) (OLDKRLMEMFILE←NIL) (OPENHASHFILE KRLMEMFILE flg) (if flg='SYMBOLTABLE then (CreateSpace 'SpaceDirectory) (CreateSpace 'NeutralSpace]) (KrlSysoutAdvice [LAMBDA NIL (* ht: "15-JUN-77 12:02" posted: "14-JUN-77 17:46") (* Checks to see if user wants memory saved and does so if wanted. WARNING!!! page pointers are not preserved across calls to SYSOUT which do save memory!!!) (if SYSHASHFILE then (SELECTQ [OLDKRLMEMFILE←(ASKUSER DWIMWAIT 'N "Save state of KRL memory? " '([Y "es File name: " KEYLST (( NIL RETURN (CADR ANSWER] (N "o "] (N OLDKRLMEMFILE←KRLMEMFILE) (PROGN (CLOSEHASHFILE) OLDKRLMEMFILE←(COPYFILE KRLMEMFILE OLDKRLMEMFILE) (OPENHASHFILE KRLMEMFILE T]) (MYFAILEDMAPIN [LAMBDA (PAGE#) [CLISP:(ARRAYBLOCK KHashFile ((HValueType BITS 22Q) (FileJfn BITS 22Q) (FullprintPage# BITS 22Q) (FullPrintMargin BITS 22Q) File Tag Write?) (* must concur with defn in HASH) ) (ARRAYBLOCK KBufPage (Location (MappedFileJfn BITS 22Q) (MappedPage BITS 22Q] (* ht: "30-JUN-77 10:56" posted: "16-JUN-77 18:18") (* picks up where the open coded version of mapin leaves off) (PROG (PGE BUFPAGE (PREV (SYSBUFFERLIST::1)) (TAIL (SYSBUFFERLIST::2))) LP (BUFPAGE←TAIL:1) (if BUFPAGE:MappedPage=PAGE# then (* Do nothing; page is already in) (PGE←BUFPAGE:Location) elseif TAIL::1 then (PREV←TAIL) (TAIL←TAIL::1) (GO LP) else (PMAP SYSHASHFILE:FileJfn PAGE# PGE←BUFPAGE:Location) (* Normal case: just map into this page) (BUFPAGE:MappedPage←PAGE#)) (PREV::1←TAIL::1) (* Splice this page into beginning) (TAIL::1←SYSBUFFERLIST::1) (* Smashing not really needed if PREV=SYSBUFFERLIST) (SYSBUFFERLIST::1←TAIL) (TAIL:1←(PROG1 SYSBUFFERLIST:1 SYSBUFFERLIST:1←TAIL:1)) (RETURN PGE]) (MakeKCTemplate [LAMBDA (X) (* ht: "13-JUL-77 16:26" posted: "23-JUN-77 16:21") (* Kludge to build a structure with the right properties for masterscope to analyze KrlCreate forms) <!! <'PROG '(X) <'create X:1> X:2 X:3 <'RPLACA X:4> <'fetch (PACK <X:1 'Length >) 'of 'X >> ! (for f in X::4 collect (SUBST f 'f '(replace f of X with T))) >]) (ReleaseHandle [LAMBDA (handle) (* ht: "29-JUN-77 10:42" posted: "28-JUN-77 17:27") (* Stops a pseudo handle from pointing to what it was pointing to, by pointing it to NIL thereby possibly allowing garbage collection.) (SetLispArray handle:array# handle:itemOffset handle:carFlg) handle]) (SetLispArray [LAMBDA (array# itemOffset carFlg val) (* ht: "13-SEP-77 10:57" posted: "29-JUN-77 11:03") (* Sets an entry in a file-to-core array) (if carFlg then ((ELT (ELT KRLMEMLISPARRAY array#) itemOffset)←val) else (SETD (ELT KRLMEMLISPARRAY array#) itemOffset val]) (SpaceName [LAMBDA (handle oldHandle) (* ht: "14-JUL-77 12:13" posted: " 4-JUL-77 17:12") (* Returns (as an atom) the name of the space in whihc the object for which handle is a handle resides) (if ~oldHandle then oldHandle←(create FileHandle)) oldHandle:filePage#←handle:filePage# oldHandle:fileWord#←0 (FetchMem oldHandle spaceIDPtr oldHandle) (FileObjectName oldHandle)::1]) ) (DECLARE: DOEVAL@COMPILE (DEFINEP [CheckHandle MACRO [H (PROGN (* Takes a single arg. Gets a handle into AC1 and checks it if CHECKHANDLEFLG is non-NIL) (SUBST (CAR H) (QUOTE H) (COND [CHECKHANDLEFLG (QUOTE (ASSEMBLE NIL (CQ H) (VAR (CKUDT DFileHandle%DATATYPE] (T (QUOTE H] ] [ClearField MACRO [(H N) (PROGN (* clears a field of an object for which H is a handle at offset N) (ASSEMBLE NIL (CQ (HLOC H)) (SETZM 0 , N (1] ] [ConstantHandle MACRO (NIL (CONSTANT (create FileHandle))) ] [FetchMem MACRO (X (PROGN (* Args are (H F OH). Returns the handle found in field F of the object for which H is a handle. If OH is present, smashes the value into it, otherwise builds a new handle Uses the record package to get the offset for the field, see NFetchField.) (CONS (COND ((CADDR X) (QUOTE SmashHandle)) (T (QUOTE NewHandle))) X))) ] [HLOC MACRO [(H) (PROGN (* Computes an in core pointer to the object which has H for a handle. Calls MAPIN, so result is only guaranteed until the next call to MAPIN.) (ASSEMBLE NIL (CQ (CheckHandle H)) (PUSHP) (LDB 1 , = 111701000000Q) [CQ (MYMAPIN (LOC (AC] (POP PP , 3) (HRRZ 2 , 0 (3)) (ANDI 2 , 777Q) (ADDI 1 , 0 (2] ] [HandleValue MACRO [(H) (PROGN (* Returns the (large number) contents of the handle itself, NOT where it points to. Used by StoreMem inside a VAG.) (OPENR (LOC (CheckHandle H] ] [KrlCreate MACRO [X (PROG ((rn (CAR X)) (on (CADR X)) (sp (CADDR X)) (h (CADDDR X)) (flgs (CDDDDR X)) ty len form initFlg tfl) (* Args are (recordName objectName spaceName oldHandle . trueFlags) Allocates an object of the right size in the indicated space (or NeutralSpace), gives it its name if it has one, smashes a pointer into oldHandle or makes a new one, sets the type field appropriately, and turns on the indicated flags, if any. Initializes ends of multiword fields, if any, to empty extender pointers with lastEntry bit set) (SETQ ty (OR (KrlTypeCode rn) (ERROR rn "not a KRL structure"))) (SETQ len (RECORDACCESS (PACK (LIST (CAR X) (QUOTE Length))) X)) [SETQ initFlg (CAR (FMEMB (PACK (LIST (CAR X) (QUOTE Init))) (SETQ tfl (RECORDFIELDNAMES rn] (SETQ form (LIST (QUOTE AllocateFileObject) len on ty sp h)) (RETURN (COND [(OR flgs initFlg) (APPEND [QUOTE (PROG ($$1) (DECLARE (LOCALVARS $$1] (CONS (LIST (QUOTE SETQ) (QUOTE $$1) form)) [COND (flgs (for f in flgs collect (COND [(OR (FMEMB f tfl) (EQ f (QUOTE lastEntry))) (SUBST f (QUOTE f) (QUOTE (replace f of $$1 with T] (T (ERROR (LIST rn f) "unknown flag"] [COND (initFlg (SUBST initFlg (QUOTE i) (QUOTE ((replace i of $$1 with T] (COPY (QUOTE ((RETURN $$1] (T form] ] [LispFor MACRO [X (DSUBST (CAR X) (QUOTE X) ([LAMBDA (Y) (if CHECKHANDLEFLG then (NCONC [COPY (QUOTE (AND (EQ (fetch hType of X) (CONSTANT (KrlTypeCode (QUOTE PseudoHandle] (LIST Y)) else Y] (COPY (QUOTE (COND ((fetch carFlg of X) (ELT (ELT KRLMEMLISPARRAY (fetch array# of X)) (fetch itemOffset of X))) (T (ELTD (ELT KRLMEMLISPARRAY (fetch array# of X)) (fetch itemOffset of X] ] [MYMAPIN MACRO ((X) (ASSEMBLE NIL (CQ (VAG X)) (VAR (LDV2@ SYSBUFFERLIST)) (HLRZ 3 , 2 (2)) (* load MappedPage of CAR of SYSBUFFERLIST) (CAMN 1 , 3) (JRST GOTIT) (HLRZ 2 , 2) (* CDR of SYSBUFFERLIST) (MOVE 2 , 0 (2)) (* CADR of SYSBUFFERLIST) (HLRZ 3 , 2 (2)) (* next MappedPage of CADR of SYSBUFFERLIST) (CAME 1 , 3) (JRST NOGOOD) GOTIT (HLRZ 1 , 3 (2)) (* location) (JRST DONE) NOGOOD [CQ (MYFAILEDMAPIN (LOC (AC] DONE)) ] [NLoadField MACRO [(D N) (PROGN (* This is what field accesses compile into. Takes a handle and a numerical offset and loads the contents into AC1. The boxing will normally be nullified by an enclosing VAG, see e.g. FetchMem.) (LOC (ASSEMBLE NIL (CQ (HLOC D)) (MOVE 1 , N (1] ] [NSetField MACRO [(D N V) (PROGN (* Thsi is what field stores compile into. Takes a handle and an offset and a (large number) value and stores the value into the objectat the offset. The unboxing will normally be nullified by an enclosed LOC, see e.g. StoreMem.) (ASSEMBLE NIL (CQ (CheckHandle D)) (CQ2 (VAG V)) (PUSH PP , 2) (PUSHP) (LDB 1 , = 111701000000Q) [CQ (MYMAPIN (LOC (AC] (POP PP , 2) (MOVE 2 , 0 (2)) (ANDI 2 , 777Q) (ADDI 1 , 0 (2)) (POP PP , 2) (MOVEM 2 , N (1] ] [NewHandle MACRO [(H F) (PROGN (* Used by FetchMem (q.v.) when there is no old handle to reuse. Calls SmashHandle with a create.) (SmashHandle H F (create FileHandle] ] [PMAP MACRO ((FILEJFN PAGE# LOCATION) (ASSEMBLE NIL (CQ (VAG (LOGOR (LLSH FILEJFN 22Q) PAGE#))) (CQ2 LOCATION) (LSH 2 , -11Q) (HRLI 2 , 400000Q) (HRLZI 3 , 140000Q) (JSYS 56Q))) ] [SetHandleFlag MACRO ((D M V) (PROGN (* M is an 18 bit mask with one bit set. Sets corresponding bit in high order half of D, which must be a file handle, to 1 or 0, depending on whether V is non-NIL or NIL. This is what foo:flag←x translates to.) (ASSEMBLE NIL (CQ (CheckHandle D)) (CQ2 V) (HLRZ 3 , 0 (1)) (* load the high order half of the handle) (TRZ 3 , M) (* clear the bit) (CAME 2 , KNIL) (TRO 3 , M) (* Set the bit if non-NIL) (HRLM 3 , 0 (1)) (* store it back) ) V)) ] [SmashHandle MACRO [(H F OH) (PROGN (* Used by FetchMem (q.v.) when there is an old handle to reuse.) (ASSEMBLE NIL (CQ (VAG (fetch F of H))) (PUSHP) (E (PSTEP)) (CQ (CheckHandle OH)) (POP PP , 2) (E (PSTEPN -1)) (MOVEM 2 , 0 (1] ] [StoreMem MACRO [(H F VH) (PROGN (* Sets the F field of the object for which H is a handle to have in it the contents of handle VH) (replace F of H with (HandleValue VH] ] [TestHandleFlag MACRO [(D M) (PROGN (* M is an 18 bit mask with one bit set. Checks to see whether it is set in D, which must be a file handle This is what foo:flag translagtes to.) (ASSEMBLE NIL (CQ (CheckHandle D)) (HLRZ 2 , 0 (1)) (* load the high order half of the handle) (HRRZ 1 , ' NIL) (TRNE 2 , M) (* skip if mask bit is 0) (HRRZ 1 , ' T] ] ) ) (MacroDoc [KrlCreate (NIL (objectType objectName spaceName oldHandle trueFlag1 ... trueFlagN)) (! NIL CREATE EVAL EVAL SMASH .. REPLACE)] [FetchMem (NIL (handle field oldHandle)) (! NIL EVAL FETCH (IF (NOT (NULL EXPR)) SMASH) . PPE)] [StoreMem (handle field newValue) (! NIL EVAL REPLACE EVAL . PPE)] ) (PUTPROPS LDV2@ OPD ((V) (MOVE 2 , @ V))) (RPAQ SYSSPACEDIRECTORY NIL) (DECLARE: DONTCOPY (FILEMAP (NIL (3335 17392 (AllocateFileObject 3347 . 5280) (COPYFILE 5284 . 5578) (CreateSpace 5582 . 6823) (Doublet 6827 . 7674) (FileObjectName 7678 . 8279) (FindCurrentPage 8283 . 9231) (GetFileObject 9235 . 10554) (HandleFor 10558 . 11829) (InitKrlMem 11833 . 13262) (KrlSysoutAdvice 13266 . 13973) ( MYFAILEDMAPIN 13977 . 15480) (MakeKCTemplate 15484 . 16001) (ReleaseHandle 16005 . 16453) ( SetLispArray 16457 . 16849) (SpaceName 16853 . 17389))))) STOP