mirror of
https://github.com/PDP-10/its.git
synced 2026-01-13 15:27:28 +00:00
109 lines
4.3 KiB
Plaintext
109 lines
4.3 KiB
Plaintext
'<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>
|