From 1336be304292e85dec799651345f677605be2f8d Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 14 Jun 2021 07:25:16 +0200 Subject: [PATCH] Package system for Muddle. --- src/rrs/itspkg.urs233 | 521 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 521 insertions(+) create mode 100644 src/rrs/itspkg.urs233 diff --git a/src/rrs/itspkg.urs233 b/src/rrs/itspkg.urs233 new file mode 100644 index 00000000..735cb99b --- /dev/null +++ b/src/rrs/itspkg.urs233 @@ -0,0 +1,521 @@ + + "ITSPKG URS227 PART 1" + + +;" ITSPKG is a minimal PACKAGE handling routines for ITS MUDDLE. + Based RRS's code and MIMPCK + " + +)> + ;" atoms on used by the PACKAGE handling routines. + At the present time Only PACKAGE, ENTRY, ENDPACKAGE, USE and + L_UNUSE are supported by ITSPKG RRS " + + PACKAGE-MODE PACKAGE RPACKAGE ENTRY RENTRY SURVIVOR EXTERNAL USE + USE-WHEN USE-TOTAL USE-DEBUG USE-DEFER EXPORT INCLUDE INCLUDE-WHEN + INCLUDE-DEBUG COMPILING? DEBUGGING? DEFINITIONS END-DEFINITIONS DROP + NULL-OBLIST ENDPACKAGE L-SEARCH-PATH L-SECOND-NAMES L-OPEN L-FLOAD + L-LOAD L-LOADER L-NO-FILES L-NO-MAGIC L-ALWAYS-INQUIRE L-UNUSE + UNUSE L-GASSIGNED? L-NOISY L-VERY-NOISY L-TRANSLATIONS + L-USE-ABSTRACTS? TRANSLATE UNTRANSLATE TRANSLATIONS IN-COLLECTION + OBLIST IOBLIST DISMISS + ;"NPCK is loaded before INT. + + On root oblist used by PACKAGE routines. " + + + + +;" Build oblists package we are building " + )> + + + ;" create atom SEARCH!-PKG!-PACKAGE " + +" USED BY L PACKAGE " + +> +> +> +"..................................................." + +"________________________PART 2____________________________________________" +" For debugging + Print names of oblists on .OBLIST +--------------------------------------------------" +) .OBLIST>> + +> + +;" set .OBLIST for PACKAGE debugging" + + + ) .NLS> > + > + .NLS + ;> + +;" GET OBLIST FOR OBLIST NAMED .PNAM " + OBLIST>> + +"...................PART 3.........................................." + + + +"------------------------------PART 4---------------------------" + +"BEFORE GDECL" + + + (L-SEARCH-PATH) ]>> +"AFTER GDECL" + +"========================PART 5==========================" +> + +> +"BEFORE OR GASSIGNED?" + + > + +"BEFORE GDECL" +;"THIS SHOULD BE SETG'ED TO T IN COMPILERS." + > + "AFTER GDECL" + +;"------------------------------------------------------------- + modified bY rrs on 210308 " + +) ATM + IATM OBL IOBL TMP + (OBLIS .OBLIST)) + #DECL( (NAME INAME) STRING + (TNAME) + (VALUE ATM IATM) ATOM + (TMP OBLIS) LIST + (OBL IOBL) OBLIST ) + >)> + >> + > + >> + > + )>>> + .NO-LOAD> + )>) + ( !.OBLIS)>> )> + )> + + .ATM> + + +;"-------------------------------------------------------------" + ) + .NAME> + +;" +PKG-OB is the PACKAGE!- oblist. + -taa + ------------------------------------------------------------- + + + ENTRY function of the PACKAGE routines + +-------------------------------------------------------------" + + + (VALUE) ATOM) + DEFINITIONS>> + >)>> + + + + (OBLIS) LIST + (NAME VALUE) ATOM ) + + > + )> + )> + > + > + > )> + <1 .OBLIS>> + .OBL>) + ( .OBL>> + )>>> + +;"------------------------------------------------------------- + + USE MODIFIED ON 210319 BY RRS + -------------------------------------------------------------" + + + "MUDDLE" "RRS")> + + + + (VALUE) ATOM + (OBLIS) + (NAME) STRING + (PK) + (OBL) + (N M)FIX ) + ]> ) + )> + > + > + > + ) + (<==? .PK T>) + (> DEFINITIONS> + + >) + (> + >>>> + > .N 1>> + (.OBL !>)>) + (T + 1>> (.OBL)>)>)> + )>>> + + + +)) + ;"MODIFIED BY RRS 219318" + #DECL ( (PKNAME) ATOM + (L) ) + >> + )>> + + + +;" ------------------------------------------------------------------------------------------ + FIND/LOAD and friends + this is called by USE to find packaghes in memory or disk file + FixED SearthPath Error --- RRS 210615 + ------------------------------------------------------------------------------------------" +) + "AUX" (PKG-OB ,PKG-OB) TMP1 TMP2 TMP3 + (TMP %<>) (TL %<>) (NO-LOAD <>) + (L .SRCHPATH) (OBLIS .OBLIST) + (LACTION .INDC) + (STR .PKNAM) (TSTR ) + (OUTCHAN ,OUTCHAN) + RESULT CH LDRSLT + "ACT" FL) + + #DECL( (PKNAM) STRING + (SRCHPATH L) + (VALUE TMP1) + (TL) + (INDC LACTION) + (PKG-OB) OBLIST + (OBLIS) + (TMP2 TMP3) ANY + (OUTCHAN) + (CH) CHANNEL + (NO-LOAD) + (FL) ACTIVATION) + + ;" PKNAM, STR. <-- .NAME IS PACKAGE NAME TO FIND / LOAD + SRCHPATH, L <-- IS THE SEARCH PATH + INDC. <-- PACKAGE-FIND.. IS ATOM, INDCATOR OF WHAT IT FIND?? + VALUE. IS ATOM OF FOUND PACKAGE OR FALSE + PKG-OB. <-- + " + > + ;"IF .TMP1 is <> then PACKAGE NOT LOADED OR NONEXISTANT" + .TMP1 + ;"Needs to be loaded" + > + )> + )> + .TMP1> + + + + + (VALUE TMP1) ) + + + #FUNCTION((SDIR) + ">> + + > + + .AMPL> )> )> ) + .SRCHPATH > ) + ( <>);" DON'T DO TWINEX MUDDLE" + (T )> + #FALSE("PACKAGE NOT FOUND")> + +" ------------------------------------------------------------------------------------------" + + + +;"------------------------------------------------------------- + + ENDPACKAGE function + + -------------------------------------------------------------" + + +) + "AUX" (OBLIS .OBLIST) PK) ;" MODIFIED BY RRS ON 210310" + #DECL( (PKNM) + (OBLIS) + (PK) ) + > + + + + .PK) + ( ) + (T + + )> + <=? .PKNM>> )>>> + + +;" --------------------------------------------------------------- + DROP AND FRIENDS BY RRS ON 210415 + --------------------------------------------------------------- + + find the index needed by NTH of the package's oblist in .OBLIST." + + (IDX VALUE) ) + ) OBL) + #DECL( (I LEN) FIX (OBL) OBLIST ) + > + >> + + ) + (T > )> + > > + > + )> + .IDX> + + +;" REMOVE THE NTH NODE IN A LIST. Doesn't MODIFIES THE ORGINAL LIST + LIKE REST FOR N ==? 0 RETURN THE LIST UNCHANGED. LST IS A SALLOW + COPY OF .L" +) "ACT" A) + #DECL ((L LST VALUE) LIST (N) FIX) + .A>) + (<==? .N 1> > .A>)> + > >> + .LST> + +;" REMOVE A DROPPED PACKAGE FROM .OBLIST . IF THE PACKAGE + IS NOT FOUND, THEN NO CHANGES TO .OBLIST ARE MADE" + + (NOBLS OOBLS) FALSE> + (VALUE) STRING ) + + > + > + > + ;"Danger! Will Robbinson" + + "PAGKAGE DROPPED" > + + +" ------------------------------------------------------------- + + PACKAGE routine's L-UNUSE function and friends + + -------------------------------------------------------------" + +;" PACKAGE routine's L-UNUSE function + Modified by RRS on 210310 + Modified by RRS on 210406 fixed TMP's DECL + Modified by RRS on 210527 added SPCL-ATOM-TABLE" + + + (ATM IATM) + (TMP) + (ATOM-TABLE) FALSE>) + > + > ;" ADDED 210527 " + );" input STR is FALSE do nothing " + (> > + > + + > + " ---------OLD CODE---commented out------------- " + ; + + ) + .ATM> + <==? .IATM>> + )>> + .L>> + ;",ATOM-TABLE> whats this??? REMOVED 210527 " + .ATOM-TABLE> ;" ADDED 210527 " + " -------------------NEW code ------------------- " + + ,UNASS-REMOV + .ATOM-TABLE > + " --------------------------------------------- " + + + + "PACKAGE REMOVED") + (T #FALSE ("NOT PACKAGE OR DATUM"));" STR is not a valid PACKAGE">> + + + +" ---------------------------------------------------------------------------------------" +;" UNSET / UNSETG A GIVE ATOM AND REMOVE IT " + )> + )> + > + +;"MAKE A SPECAL ATOM-TABLE FOR L-UNUSE + ONLY LOOK AT THE PACKAGES TWO OBLIST. I DON'T THINK + THIS WILL WORK FOR RPACKAGES" +> + (PKGNAM STRE STRI) STRING + (ATME ATMI) ATOM + (POBLE POBLI) OBLIST + (FLAGS) + (X Y Z) ANY + (A) ACTIVATION) + ;"Name of package & external oblist" + >> ;"Atom's PNAME is name package oblist" + > + > ;"Name of package's internal oblist" + >> ;"Atom's PNAME is name package internal oblist" + > :"Package external oblist" + > ;"Package internal oblist" + > ;"Flatten Package external oblist" + > ;"Flatten Package internal oblist" + > ;"Build atom-table." + .ATOM-TABLE > + + ;" OBL2ALST CREATES A FLAT LIST OF ATOMS FROM AN OBLIUST + THIS FUNCTION WAS DESIGNED TO WORK WITH THE OLD FORM + OF OBLISTS, BUT WORKS FINE ON THE NEW FORM OF OBLISTS" +> + (ALST VALUE) LIST (TMP) ANY) + + #FUNCTION ((OB) >) + .OBL> + .ALST> + + + +" --------------------------------------------------------------------------------------" + + +;"------------------------------------------------------------- + + + unused at the minute. RRS 210310 at the present time + -------------------------------------------------------------" + +;]> + ,L-TRANSLATIONS)) + ) + (<=? <1 .L>:STRING .NAME> >)> + >>> + +; + "AUX" (L:]> + ,L-TRANSLATIONS) (OUTCHAN:CHANNEL ,OUTCHAN)) + + + ) + (<=? <1 .L>:STRING .FROM> )> + >> + + "> + + > + +;]> + ,L-TRANSLATIONS)) + + + + ) + (T + ]> .L) + L2:]>) + ) + (<=? <1 .L1>:STRING .NAME> + + >) + ( >)> + )> + + >>)>> +;"------------------------------------------------------------- + + + +; ------------------------------------------------------------- + +; clean up at the end of ITSPKG " + +> +> +>>> + + + + + + \ No newline at end of file