--- /dev/null
+; THE FOLLOWING INFORMATION IS MEANT AS GUIDE TO THE CARE AND FEEDING\r
+; OF MUDDLE. IT ATTEMPTS TO SPECIFY PROGRAMMING CONVENTIONS AND\r
+; SUPPLY SYMBOLS AND MACROS NEEDED BY ALL MODULES IN A MUDDLE.\r
+\r
+; FOR EFFICIENCY THE STANDARD MODE OF RUNNING IS UNINTERRUPTABLE.\r
+; WITH EXPLICIT CHECKS FOR PENDING INTERRUPTS. THE INTGO MACRO\r
+; PERFORMS THE APPROPRIATE CHECK\r
+\r
+; FOR INTERRUPTS TO WORK IN INTERRUPTABLE CODE, IT MUST\r
+; BE ABSOLUTELY PURE. BETWEEN ANY TWO INSTRUCTIONS OF\r
+; INTERRUPTABLE CODE THERE MAY BE AN INTERUPT IN WHICH\r
+; A COMPACTING GARBAGE COLLECTION MAY OCCUR.\r
+; NOTE: A SCRATCH AC MAY CONTAIN POINTERS TO GC SPACE IN\r
+; INTERRUPTABLE CODE OR DURING AN INTGO IF THE TYPE CODE FOR THAT AC'S\r
+; SLOT IN THE PROCESS VECTOR IS SET TO REFLECT ITS CONTENTS.\r
+\r
+; ALL ATOM POINTERS WILL BE REFERRED TO IN ASSEMBLED CODE BY\r
+; MQUOTE <PNAME> -- FOR NORMAL ATOMS\r
+; EQUOTE <PNAME> -- FOR ERROR COMMENT ATOMS\r
+\r
+; FUNCTION CALLS TO INITIAL FUNCTIONS WILL BE CALLED USING THE FOLLOWING:\r
+\r
+; MCALL N,<PNAME> ;SEE MCALL MACRO\r
+; ACALL AC,<PNAME> ; SEE ACALL MACRO\r
+\r
+; UNLESS PNAME IS NOT A VALID MIDAS SYMBOL, IN WHICH CASE ANOTHER INTERNAL \r
+; NAME WILL BE USED\r
+\r
+; WHEN CALLING A SUBR THROUGH AN INDEX OR INDIRECT, THE UUOS GENERATED\r
+; BY THE MACROS SHOULLD BE USED.\r
+; THESE ARE .MCALL AND .ACALL -- EXAMPLE:\r
+; .ACALL A,@(B)\r
+\r
+\r
+\r
+\r
+\r
+\f; ORGANIZATION OF CORE STORAGE IN THE MUDDLE SYSTEM (ENVIRONMENT)\r
+\r
+; 20: SPECIAL CODE FOR UUO AND INTERUPTS\r
+\r
+;CODBOT: WORD CONTAINING LOCATION OF BOTTOMMOST WORD OF IMPURE CODE\r
+\r
+; --IMPURE CODE--\r
+\r
+;CODTOP: WORD CONTAINING LOCATION OFWORD AFTER LAST WORD OF CODE\r
+\r
+;PARBOT: WORD CONTAINING LOCATION OFBOTTOMMOST LIST\r
+\r
+; --PAIRSS--\r
+\r
+;PARTOP: WORD CONTAINING LOCATION OFWORD AFTER LAST PAIR WORD\r
+\r
+;VECBOT: WORD CONTAINING LOCATION OFFIRST WORD OF VECTORS\r
+\r
+; --VECTORS--\r
+\r
+;VECTOP: WORD CONTAINING LOCATION OFWORD AFTER TOPMOST VECTOR\r
+; THE WORD BEFORE VECTOP IS THE DOPE FOR THE LAST VECTOR\r
+\r
+; --GC MARK PDL (SOMETIMES NOT THERE)--\r
+\r
+;CORTOP: TOP OF LOW-SEGMENT/IMPURE CORE\r
+\r
+;600000: START OF PURE CODE (SHARED ALSO)\r
+\r
+; --PURE CODE--\r
+\r
+;\r
+\r
+\r
+\f; BASIC DATA TYPES PRE-DEFINED IN MUDDLE\r
+\r
+; PRIMITIVE DATA TYPES\r
+; IF T IS A DATA TYPE THEN $T=[T,,0]\r
+\r
+; DATA TYPES ARE ASSIGNED BY THE TYPMAK MACRO IN SOME ARBITRARY ORDER\r
+\r
+\r
+;TLOSE ;ILLEGAL TYPE (USED PRIMARILY FOR ERRORS)\r
+;TFIX ;FIXED POINT\r
+;TFLOAT ;FLOATING POINT\r
+;TCHRS ;WORD OF UP TO 5 ASCII CHARACTERS\r
+;TENTRY ; MARKS BEGINNING OF A FRAME ON TP STACK\r
+;TSUBR ;BUILT IN FUNCTION WITH EVALUATED ARGS\r
+;TFSUBR ;BUILT IN FUNCTION WITH UN-EVALUATED ARGS\r
+;TUNBOU ;TYPE GIVEN TO UNBOUND OR UNASSIGNED ATOM\r
+;TBIND ;MARKS BEGINNING OF BINDING BLOCK ON TP STACK\r
+;TILLEG ;POINTER PREVIOUSLY HERE NOW ILLEGAL\r
+;TTIME ;UNIQUE NUMBER (SEE FLOAD)\r
+;TLIST ;POINTER TO LIST ELEMENT\r
+;TFORM ;POINTER TO LIST ELEMENT BUT USED AS AN EXPRESSION\r
+;TSEG ;SAME AS FORM BUT VALUE IS MUST BE STRUCTURED AND IS USED \r
+; ;AS A SEGMENT\r
+;TEXPR ;POINTER TO LIST ELEMENT BUT USED AS AN INTERPRETIVE FUNCTION\r
+;TFUNAR ;LIKE TEXPR BUT HAS PARTIALLY EVALUATED ARGS\r
+;TLOCL ;LOCATIVE TO LIST ELEMENT (SEE AT,IN AND SETLOC)\r
+;TFALSE ;NOT TRUTH\r
+;TDEFER ;POINTER TO REAL VALUE (ONLY APPEARS AS CAR OF LIST)\r
+;TUVEC ;AOBJN POINTER TO UNIFORM VECTOR\r
+;TOBLS ;AOBJN TO UVEC OF LISTS OF ATOMS. USED AS SYMBOL TABLE\r
+;TVEC ;VECTOR (AOBJN POINTER TO GENERALIZED VECTOR)\r
+;TCHAN ;VECTOR OF INFO DESCRIBING AN I/O CHANNEL\r
+;TLOCV ;LOCATIVE TO GENERAL VECTOR (SEE AT,IN AND SETLOC)\r
+;TTVP ;POINTER TO TRANSFER VECTOR\r
+;TBVL ;BEGINS A VECTOR BINDING ON THE TP STACK\r
+;TTAG ;VECTOR OF INFO SPECIFYING A GENERALIZED TAG\r
+;TPVP ;POINTER TO PROCESS VECTOR\r
+;TLOCI ;POINTER TO ATOM VALUE ON STACK (INTERNAL NOT SEEN BY USER)\r
+;TTP ;POINTER TO MAIN MARKED STACK\r
+;TSP ;POINTER TO CURRENT BINDINGS ON STACK\r
+;TLOCS ;LOCATIVE TO STACK (NOT CURRENTLY USED)\r
+;TPP ;POINTER TO PLANNER PDL (NOT CURRENTLY USED)\r
+;TPLD ;POINTER TO P-STACK (UNMARKED)\r
+;TARGS ;POINTER TO AN ARG BLOCK (HAIRY KLUDGE)\r
+;TAB ;SAVED AB (NOT GIVEN TO USER)\r
+;TTB ;SAVED TB (NOT GIVEN TO USER)\r
+;TFRAME ;USER POINTER TO STACK FRAME\r
+;TCHSTR ;BYTE POINTER TO STRING OF CHARS (COUNT ALSO INCLUDED)\r
+;TATOM ;POINTER TO ATOM\r
+;TLOCD ;USER LOCATIVE TO ATOM VALUE\r
+;TBYTE :POINTER TO ARBITRARY BYTE STRING (NOT CURRENTLY USED)\r
+;TENV ;USER POINTER TO FRAME USED AS AN ENVIRONMENT\r
+;TACT ;USER POINTER TO FRAME FOR A NAMED ACTIVATION\r
+;TASOC ;ASSOCIATION TRIPLE\r
+;TLOCU ;LOCATIVE TO UVECTOR ELEMENT (SEE AT,IN AND SETLOC)\r
+;TLOCS ;LOCATIVE TO A BYTE IN A CHAR STRING (SEE AT,IN AND SETLOC)\r
+;TLOCA ;LOCATIVE TO ELEMENT IN ARG BLOCK\r
+;TENTS ;NOT USED\r
+;TBS ; ""\r
+;TPLDS ; ""\r
+;TPC ; ""\r
+;TINFO ;POINTER TO LIST ELEMENT USED WITH ARG POINTERS\r
+;TNBS ;NOT USED\r
+;TBVLS ;NOT USED\r
+;TCSUBR ;CARE SUBR (USED ONLY WITH CUDDLE SEE -- WJL)\r
+;TWORD ;36-BIT WORD\r
+;TRSUBR ;COMPILED PROGRAM (ACTUALLY A VECTOR POINTER)\r
+;TCODE ;UNIFORM VECTOR OF INSTRUCTIONS\r
+;TCLIST ;NOT USED\r
+;TBITS ;GENERAL BYTE POINTER\r
+;TSTORA ;POINTER TO NON GC IMPURE STUFF\r
+;TPICTU ;E&S CODE IN NON GC SPACE\r
+;TSKIP ;ENVIRONMENT SPLICE\r
+;TLINK ;LEXICAL LINK \r
+;TINTH ;INTERRUPT HEADER\r
+;THAND ;INTERRUPT HANDLER\r
+;TLOCN ;LOCATIVE TO ASSOCIATION\r
+;TDECL ;POINTER TO LIST OF ATOMS AND TYPE DECLARATIONS\r
+;TDISMI ;TYPE MEANING DONT RUN REST OF HANDLERS\r
+;TDCLI ; INTERNAL TYPE FOR SAVED FUNCTION BODY\r
+;TMENT ; POINTER TO MAIN ENTRY OF WHICH THIS IS PART\r
+;TENTER ; NON-MAIN ENTRY TO AN RSUBR\r
+;TSPLICE ; RETURN FROM READ MACRO MEANS SPLICE SUBELEMENTS IN\r
+;TPCODE ; PURE CODE POINTER IN FUNNY FORMAT\r
+;TTYPEW : TYPE WORD\r
+;TTYPEC ; TYPE CODE\r
+;TGATOM ; ATOM WITH GVALUE\r
+;TREADA ; READ ACTIVATION HACK\r
+;TUNWIN ; INTERNAL FOR UNWIND SPEC ON STACK\r
+;TUBIND ; BINDING OF UNSPECIAL ATOM\r
+;TMACRO ; EVAL MACRO\r
+\f\r
+; STORGE ALLOCATION TYPES. ALLOCATED BY AN "IRP" LATER IN THIS FILE\r
+\r
+\r
+;S1WORD ;UNMARKED STUFF OF NO INTEREST TO AGC\r
+;S2WORD ;POINTERS TO ELEMENTS IN PAIR SPACE (LIST, FORM, EXPR ETC.)\r
+;S2DEFR ;DEFERRED LIST VALUES\r
+;SNWORD ;POINTERS TO UNIFORM VECTORS\r
+;S2NWOR ;POINTERS TO GENERAL VECTORS\r
+;STPSTK ;STACK POINTERS\r
+;SPSTK ;UNMARKED STACK POINTERS\r
+;SARGS ;POINTERS TO ARG BLOCKS (USER)\r
+;SABASE ;POINTER TO ARG BLOCK (INTERNAL)\r
+;STBASE ;POINTER TO FRAME (INTERNAL)\r
+;SFRAME ;POINTER TO FRAME (USER)\r
+;SBYTE ;GENERAL BYTE POINTER\r
+;SATOM ;POINTER TO ATOM\r
+;SLOCID ;POINTER TO VALUE CELL OF ATOM\r
+;SPVP ;PROCESS VECTORS\r
+;SCHSTR ;ASCII BYTE POINTER\r
+;SASOC ;POINTER TO ASSOCIATION BLOCK\r
+;SINFO ;LIST CELL CONTAINING EXTRA ARGBLOCK INFO\r
+;SSTORE ;NON GC STORGAGE POINTER\r
+;SLOCA ;ARG BLOCK LOCATIVE\r
+;SLOCD ;USER VALUE CELL LOCATIVE\r
+;SLOCS ;LOCATIVE TO STRING\r
+;SLOCU ;LOCATIVE TO UVECTOR\r
+;SLOCV ;LOCATIVE TO GENERAL VECTOR\r
+;SLOCL ;LOCATIVE TO LIST ELEENT\r
+;SLOCN ;LOCATIVE TO ASSOCIATION\r
+;SGATOM ;REALLY ATOM BUT SPECIAL GC HACK\r
+\r
+;NOTE: TO FIND OUT IF A GIVEN STORAGE ALLOCATION TYPE NEEDS TO BE DEFERRED, REFER TO\r
+;LOCATION "MKTBS:" OFFSET BY THE STORAGE TYPE. IF IT IS <0, THAT SAT NEEDS TO BE DEFERRED.\r
+;\r
+;ONE WAY TO DO THIS IS TO PUT A REAL TYPE CODE IN AC A AND PUHSJ P,NWORDT\r
+; A WILL CONTAIN 1 IF NO DEFERRED NEEDED OR 2 IF DEFER IS NEEDED\r
+\r
+\f; SOME MUDDLE DATA FORMATS\r
+\r
+; FORMAT OF LIST ELEMENT\r
+\r
+; WORD 1: SIGN BIT, RESERVED FOR GARBAGE COLLECTOR\r
+; BITS 1-17 TYPE OF FIRST ELEMENT OF LIST\r
+; BITS 18-35 POINTS TO REST OF LIST (ALWAYS ANOTHER LIST OR 0)\r
+;\r
+; WORD 2: DATUM OF FIRST ELEMENT OF LIST OF TYPE SPECIFIED\r
+;\r
+; IF DATUM REQUIRES 54 BITS TO SPECIFY, TYPE WILL BE "TDEFER" AND\r
+; VALUE WILL BE AN 18 BIT POINTER TO FULL 2 WORD PAIR\r
+\r
+\r
+\r
+;FORMAT OF GENERAL VECTOR (OF N ELEMENTS)\r
+;POINTED INTO BY AOBJN POINTER\r
+;A GENERAL VECTOR HAS FEWER THAN 2^16 ELEMENTS\r
+\r
+\r
+; TYPE<1> TYPE OF FIRST OBJECT (THE RIGHT HALF OF THE TYPE WORD MIGHT BE NONZERO)\r
+; OBJ<1> OBJECT OF SPECIFIED TYPE\r
+; TYPE<2>\r
+; OBJ<2>\r
+; .\r
+; .\r
+; .\r
+; TYPE<N>\r
+; OBJ<N>\r
+; VD(1)-VECTOR DOPE--SIGN-NOT UNIFORM, BITS 1-17 TYPE,,18-35 GROWTH/SHRINKAGE\r
+; VD(2)-VECTOR DOPE--SIGN-G.C.; BITS 1-17 ARE 2*N+1,,18-35 G.C. RELOCATION EITHER UP OR DOWN\r
+\r
+\r
+\f;SPECIAL VECTORS IN THE INITIAL SYSTEM\r
+\r
+;THE SYSTEM KEEPS RELEVANT INFORMATION CONCERNING ALL TYPES\r
+;IN A TYPE VECTOR, TYPVEC, WHICH MAY BE INDEXED BY THE TYPE NUMBER\r
+;FOUND IN THE TYPE FIELD OF ANY GOODIE. TABLES APLTYP AND EVLTYP ALSO EXIST\r
+;THEY SPECIFY HOW DIFFERENT TYPES EVAL AND APPLY.\r
+\r
+;TYPE IN AC A, PUSHJ P,SAT RETURNS STORAGE TYPE IN A\r
+\r
+;TYPE TO NAME OF TYPE TRANSLATION TABLE\r
+\r
+; TATOM,,<STORAGE ALLOCATION TYPE>+CHBIT+TMPLBT\r
+\r
+; ATOMIC NAME\r
+\r
+; CHBIT ON MEANS YOU CANT RANDOMLY CHTYPE INTO THIS TYPE\r
+; TMPLBT ON MEANS A TEMPLATE EXISTS DESCRIBING THIS\r
+\r
+;AN ATOM IS A BLOCK IN VECTOR SPACE WITH THE FOLLOWING FORMAT\r
+\r
+; <TUNBOU OR TLOCI>,,<0 OR BINDID> ; TLOCI MEANS VAL EXISTS.\r
+ ; 0 MEANS GLOBAL\r
+; ; BINDID SPECS ENV IN\r
+ ; WHICH LOCAL VAL EXISTS\r
+; <LOCATIVE TO VALUE OR 0>\r
+; <POINTER TO OBLIST OR 0>\r
+; <ASCII /PNAME/>\r
+; <400000+SATOM,,0>\r
+; <LNTH>,,0 (SIGN BIT FOR G.C. RH FOR G.C. RELOCATION)\r
+\r
+;POINTERS TO INITIAL STRUCTURES AND ATOMS NEEDED BY COMPILED CODE\r
+;WILL BE POINTED TO BY THE TRANSFER VECTOR\r
+;A POINTER TO THIS VECTOR ALWAYS EXISTS IN AC TVP\r
+;THE FORMAT OF THIS VECTOR IS:\r
+\r
+; TYPE,,0\r
+; VALUE\r
+; .\r
+; .\r
+; .\r
+; TV DOPE WORDS\r
+\r
+\r
+;INFORMATION CONCERNING EACH PROCESS IS KEPT IN THE PROCESS VECTOR\r
+;A POINTER TO THE CURRENT PROCESS ALWAYS EXISTS IN AC PVP\r
+;THE FORMAT OF A PROCESS VECTOR IS:\r
+\r
+; TFIX,,0\r
+; PROCID ;UNIQUE ID OF THIS PROCESS\r
+\r
+; 20 ELEMENTS (I.E. 40 WORDS) CONTAINIG SAVED ACS\r
+; CAN BE REFERENCED SYMBOLICALLY USING SYMBOLS\r
+; OF THE FORM AC!STO(PVP)\r
+\r
+; OTHER PROCESS LOCAL INFO LIKE LEXICAL STATE, PROCESS STATE,LAST RESUMER\r
+; .\r
+; .\r
+; .\r
+; PV DOPE WORDS\r
+\r
+\r
+\r
+\r
+;FORMAT OF PUSH DOWN STACKS USED AND CONVENTIONS\r
+\r
+\fIF1 [\r
+PRINTC /MUDDLE - INSERT FILE FOR ALL PROGRAMS\r
+/\r
+]\r
+\r
+IF2 [PRINTC /MUDDLE\r
+/\r
+]\r
+;AC ASSIGNMNETS\r
+\r
+P"=17 ;THE UNMARKED PDL POINTER (USED BY THE OUTSIDE WORLD AND MUDDLE)\r
+R"=16 ;REFERENCE BASE FOR RSUBRS\r
+M"=15 ;CODE BASE FOR RSUBRS\r
+SP"=14 ;SPECIAL PDL (USED BY MUDDLE FOR VARIABLE BINDINGS)(SPECIAL PDL IS PART OF TP)\r
+TP"=13 ;MARKED PDL (USED BY MUDDLE FOR ARGS TO FUNCTIONS \r
+ ;AND MARKED TEMPORARIES)\r
+TB"=12 ;MARKED PDL BASE POINTER AND CURRENT FRAME POINTER \r
+AB"=11 ;ARGUMENT PDL BASE (MARKED)\r
+ ;AB IS AN AOBJN POINTER TO THE ARGUMENTS\r
+TVP"=7 ;TRANSFER VECTOR POINTER\r
+PVP"=6 ;PROCESS VECTOR POINTER\r
+\r
+;THE FOLLOWING ACS ARE 'SCRATCH' FOR MUDDLE\r
+\r
+A"=1 ; A AND B CONTAIN TYPE AND VALUE UPON FUNCTION RETURNS\r
+B"=2\r
+C"=3\r
+D"=4\r
+E"=5\r
+\r
+NIL"=0 ;END OF LIST MARKER\r
+\r
+;MACRO TO DEFINE MAIN IF NOT DEFINED\r
+\r
+IF1 [\r
+DEFINE SYSQ\r
+ ITS==1\r
+ IFE <<<.AFNM1>_-24.>-<SIXBIT / T./>>,ITS==0\r
+ IFN ITS,[PRINTC /ITS VERSION\r
+/]\r
+ IFE ITS,[PRINTC /TENEX VERSION\r
+/]\r
+ \r
+ TERMIN\r
+\r
+DEFINE DEFMAI ARG,\D\r
+ D==.TYPE ARG\r
+ IFE <D-17>,ARG==0\r
+ EXPUNGE D\r
+ TERMIN\r
+]\r
+\r
+DEFMAI MAIN\r
+DEFMAI READER\r
+\r
+IF2,EXPUNGE DEFMAI\r
+\r
+\f;DEFINE TYPES AND $TYPES AND IF MAIN NOT 0, MAKE THE $TYPE WORDS\r
+\r
+\r
+IFN MAIN,NUMPRI==-1\r
+\r
+IF1 [\r
+NUMPRI==-1 ;NUMBER OF PRIMITIVE TYPES\r
+\r
+DEFINE TYPMAK SAT,LIST\r
+IRP A,,[LIST]\r
+NUMPRI==NUMPRI+1\r
+IRP B,,[A]\r
+T!B==NUMPRI\r
+.GLOBAL $!T!B\r
+IFN MAIN,[$!T!B=[T!B,,0]\r
+]\r
+.ISTOP\r
+TERMIN\r
+IFN MAIN,[\r
+RMT [ADDTYP SAT,A\r
+]]\r
+TERMIN\r
+TERMIN\r
+\r
+;MACRO TO ADD STUFF TO TYPE VECTOR\r
+\r
+IFN MAIN,[\r
+DEFINE ADDTYP SAT,TYPE,NAME,CHF,\CH\r
+ IFSE [CHF],CH==0\r
+ IFSN [CHF],CH==CHBIT\r
+ IFSE [NAME]IN,CH==CHBIT\r
+ IFSN [CHF]-1,[\r
+ TATOM,,CH+SAT\r
+ IFSN [NAME],[IFSE [NAME]IN,MQUOTE INTERNAL\r
+ IFSN [NAME]IN,MQUOTE [NAME]\r
+ ]\r
+ IFSE [NAME],MQUOTE TYPE\r
+ ]\r
+ IFSE [CHF]-1,[\r
+ TATOM,,CH+SAT\r
+ IMQUOTE [NAME]\r
+ ]\r
+ TERMIN\r
+]\r
+]\r
+IF2 [IFE MAIN,[DEFINE TYPMAK SAT,LIST\r
+ RMT [EXPUN [LIST]\r
+]\r
+ TERMIN\r
+]\r
+]\r
+\r
+;DEFINE THE STORAGE ALLOCATION TYPES IN THE WORLD\r
+\r
+\r
+NUMSAT==0\r
+GENERAL==400000,,0 ;FLAG FOR BEING A GENERAL VECTOR\r
+\r
+IF1 [\r
+DEFINE PRMACR HACKER\r
+\r
+IRP A,,[1WORD,2WORD,2DEFRD,NWORD,2NWORD,TPSTK,PSTK,ARGS\r
+ABASE,TBASE,FRAME,BYTE,ATOM,LOCID,PVP,CHSTR,ASOC,INFO,STORE\r
+LOCA,LOCD,LOCS,LOCU,LOCV,LOCL,LOCN,GATOM,LOCT]\r
+\r
+HACKER A\r
+\r
+TERMIN\r
+TERMIN\r
+\r
+\r
+\r
+DEFINE DEFINR B\r
+ NUMSAT==NUMSAT+1\r
+ S!B==NUMSAT\r
+ TERMIN\r
+]\r
+\r
+PRMACR DEFINR\r
+\r
+STMPLT==NUMSAT+1\r
+\r
+;MACRO FOR SAVING STUFF TO DO LATER\r
+\r
+.GSSET 4\r
+\r
+DEFINE HERE G00002,G00003\r
+G00002!G00003!TERMIN\r
+\r
+IF1 [\r
+DEFINE RMT A\r
+HERE [DEFINE HERE G00002,G00003\r
+G00002!][A!G00003!TERMIN]\r
+TERMIN\r
+]\r
+\r
+\r
+RMT [EXPUNGE GENERAL,NUMSTA\r
+]\r
+\r
+DEFINE XPUNGR A\r
+ EXPUNGE S!A\r
+ TERMIN\r
+\r
+IFE MAIN,[\r
+RMT [PRMACR XPUNGR\r
+]\r
+]\r
+\r
+C.BUF==1\r
+C.PRIN==2\r
+C.BIN==4\r
+C.OPN==10\r
+C.READ==40\r
+\r
+; FLAG INDICATING VECTOR FOR GCHACK\r
+\r
+.VECT.==40000\r
+\r
+; DEFINE SYMBLOS FOR VARIOUS OBLISTS\r
+\r
+SYSTEM==0 ;MAIN SYSTEM OBLIST\r
+ERRORS==1 ;ERROR COMMENT OBLIST\r
+INTRUP==2 ;INERRUPT OBLIST\r
+MUDDLE==3 ;MUDDLE GLOBAL SYMBOLS (ADDRESSES)\r
+\r
+RMT [EXPUNGE SYSTEM,ERRORS,INTRUP\r
+]\r
+; DEFINE SYMBOLS FOR PROCESS STATES\r
+\r
+RUNABL==1\r
+RESMBL==2\r
+RUNING==3\r
+DEAD==4\r
+BLOCKED==5\r
+\r
+IFE MAIN,[RMT [EXPUNGE RESMBL,RUNABL,RUNING,DEAD,BLOCKED\r
+]\r
+]\f;BUILD THE TYPE CODES AND ADD STUFF TO TYPVEC AND DEFINE $!TYPE)\r
+\r
+IFN MAIN,[RMT [SAVE==.\r
+ LOC TYPVLC\r
+ ]\r
+ ]\r
+\r
+\r
+TYPMAK S1WORD,[[LOSE],FIX,FLOAT,[CHRS,CHARACTER],[ENTRY,IN],[SUBR,,1],[FSUBR,,1]]\r
+TYPMAK S1WORD,[[UNBOUND,,1],[BIND,IN],[ILLEGAL,,1],TIME]\r
+TYPMAK S2WORD,[LIST,FORM,[SEG,SEGMENT],[EXPR,FUNCTION],[FUNARG,CLOSURE]]\r
+TYPMAK SLOCL,[LOCL]\r
+TYPMAK S2WORD,[FALSE]\r
+TYPMAK S2DEFRD,[[DEFER,IN]]\r
+TYPMAK SNWORD,[[UVEC,UVECTOR],[OBLS,OBLIST,-1]]\r
+TYPMAK S2NWORD,[[VEC,VECTOR],[CHAN,CHANNEL,1]]\r
+TYPMAK SLOCV,[LOCV]\r
+TYPMAK S2NWORD,[[TVP,IN],[BVL,IN],[TAG,,1]]\r
+TYPMAK SPVP,[[PVP,PROCESS]]\r
+TYPMAK STPSTK,[[LOCI,IN],[TP,IN],[SP,IN],[LOCS,IN]]\r
+TYPMAK S2WORD,[[MACRO]]\r
+TYPMAK SPSTK,[[PDL,IN]]\r
+TYPMAK SARGS,[[ARGS,TUPLE]]\r
+TYPMAK SABASE,[[AB,IN]]\r
+TYPMAK STBASE,[[TB,IN]]\r
+TYPMAK SFRAME,[FRAME]\r
+TYPMAK SCHSTR,[[CHSTR,STRING]]\r
+TYPMAK SATOM,[ATOM]\r
+TYPMAK SLOCID,[LOCD]\r
+TYPMAK SBYTE,[BYTE]\r
+TYPMAK SFRAME,[[ENV,ENVIRONMENT],[ACT,ACTIVATION,1]]\r
+TYPMAK SASOC,[ASOC]\r
+TYPMAK SLOCU,[LOCU]\r
+TYPMAK SLOCS,[LOCS]\r
+TYPMAK SLOCA,[LOCA]\r
+TYPMAK S1WORD,[[CBLK,IN]]\r
+TYPMAK STMPLT,[[TMPLT,TEMPLATE]]\r
+TYPMAK SLOCT,[LOCT]\r
+ ;THE FOLLOWING TYPES (THROUGH CSUBR) CAN PROBABLY BE RECYCLED\r
+TYPMAK S1WORD,[[PC,IN]]\r
+TYPMAK SINFO,[[INFO,IN]]\r
+TYPMAK SATOM,[[BNDS,IN]]\r
+TYPMAK S2NWORD,[[BVLS,IN]]\r
+TYPMAK S1WORD,[[CSUBR,,1]]\r
+\r
+TYPMAK S1WORD,[[WORD]]\r
+TYPMAK S2NWORD,[[RSUBR,,1]]\r
+TYPMAK SNWORD,[CODE]\r
+ ;TYPE CLIST CAN PROBABLY BE RECYCLED\r
+TYPMAK S2WORD,[[CLIST,IN]]\r
+TYPMAK S1WORD,[[BITS]]\r
+TYPMAK SSTORE,[STORAGE,PICTURE]\r
+TYPMAK STPSTK,[[SKIP,IN]]\r
+TYPMAK SATOM,[[LINK,,1]]\r
+TYPMAK S2NWORD,[[INTH,IHEADER,1],[HAND,HANDLER,1]]\r
+TYPMAK SLOCN,[[LOCN,LOCAS]]\r
+TYPMAK S2WORD,[DECL]\r
+TYPMAK SATOM,[DISMISS]\r
+TYPMAK S2WORD,[[DCLI,IN]]\r
+TYPMAK S2NWORD,[[ENTER,RSUBR-ENTRY,1]]\r
+TYPMAK S2WORD,[SPLICE]\r
+TYPMAK S1WORD,[[PCODE,PCODE,1],[TYPEW,TYPE-W,1],[TYPEC,TYPE-C,1]]\r
+TYPMAK SGATOM,[[GATOM,IN]]\r
+TYPMAK SFRAME,[[READA,,1]]\r
+TYPMAK STBASE,[[UNWIN,IN]]\r
+TYPMAK S1WORD,[[UBIND,IN]]\r
+IFN MAIN,[RMT [LOC SAVE\r
+ ]\r
+ ]\r
+IF2,EXPUNGE TYPMAK,DOTYPS\r
+\f\r
+RMT [EQUALS XP EXPUNGE\r
+IF2,XP STMPLT\r
+]\r
+IF1 [\r
+\r
+DEFINE EXPUN LIST\r
+ IRP A,,[LIST]\r
+ IRP B,,[A]\r
+ EXPUNGE T!B\r
+ .ISTOP\r
+ TERMIN\r
+ TERMIN\r
+ TERMIN\r
+]\r
+\r
+\r
+TYPMSK==17777\r
+MONMSK==TYPMSK#777777\r
+SATMSK==777\r
+CHBIT==1000\r
+TMPLBT==2000\r
+\r
+IF1 [\r
+DEFINE GETYP AC,ADR\r
+ LDB AC,[221500,,ADR]\r
+ TERMIN\r
+\r
+DEFINE GETYPF AC,ADR\r
+ LDB AC,[003700,,ADR]\r
+ TERMIN\r
+\r
+DEFINE MONITO\r
+ .WRMON==200000\r
+ .RDMON==100000\r
+ .EXMON== 40000\r
+ .GLOBAL .MONWR,.MONRD,.MONEX\r
+ RMT [IF2 IFE MAIN, XP .WRMON,.RDMON,.EXMON\r
+]\r
+ TERMIN\r
+]\r
+\r
+IFN MAIN,MONITO\r
+\r
+IFE MAIN,[RMT [XP SATMSK,TYPMSK,MONMSK,CHBIT\r
+]\r
+]\r
+\f;MUDDLE WIDE GLOBALS\r
+\r
+;DEFINE ENTRIES IN PROCESS VECTOR AS BEING GLOBAL\r
+\r
+IF1 [\r
+IRP A,,[0,A,B,C,D,E,PVP,TVP,TP,TB,AB,P,PB,SP,M,R]\r
+.GLOBAL A!STO\r
+TERMIN\r
+\r
+.GLOBAL CALER1,FINIS,VECTOP,VECBOT,INTFLG\r
+\r
+;GLOBALS FOR MACROS IN VECTOR AND PAIR SPACE\r
+\r
+.GLOBAL VECLOC,PARLOC,TVBASE,TVLOC,PVLOC,PVBASE,SQUTBL,SQULOC\r
+.GLOBAL PARTOP,CODTOP,HITOP,HIBOT,SPECBIND,LCKINT\r
+.GLOBAL GETWNA,WNA,TFA,TMA,WRONGT,WTYP,WTYP1,WTYP2,WTYP3,CALER,CALER1\r
+]\r
+\r
+\r
+;STORAGE ALLOCATIN SPECIFICATION GLOBALS\r
+\r
+NSUBRS==600. ; ESTIMATE OF # OF SUBRS IN WOLD\r
+TPLNT"==2000 ;TEMP PDL LENGTHH\r
+GSPLNT==2000 ;INITIAL GLOBAL SP\r
+GCPLNT"==100. ;GARBAGE COLLECTOR'S PDL LENGTH\r
+PVLNT"==100 ;LENGTH OF INITIAL PROCESS VECTOR\r
+TVLNT"==6000 ;MAX TRANSFER VECTOR\r
+ITPLNT"==100 ;TP FOR GC\r
+PLNT"==1000 ;PDL FOR USER PROCESS\r
+\r
+;LOCATIONS OF VARIOUS STORAGE AREAS\r
+\r
+PARBASE"==32000 ;START OF PAIR SPACE\r
+VECBASE"==44000 ;START OF VECTOR SPACE\r
+IFN MAIN,[PARLOC"==PARBASE\r
+VECLOC"==VECBASE\r
+]\r
+\f\r
+;INITIAL MACROS\r
+\r
+;SYMBLOS ASSOCIATED WITH STACK FRAMES\r
+;TB POINTS TO CURRENT FRAME, THE SYMBOLS BELOW ARE OFFSETS ON TB\r
+\r
+FRAMLN==7 ;LENGTH OF A FRAME\r
+FSAV==-7 ;POINT TO CALLED FUNCTION\r
+OTBSAV==-6 ;POINT TO PREVIOUS FRAME AND CONTAINS TIME\r
+ABSAV==-5 ;ARGUMENT POINTER\r
+SPSAV==-4 ;BINDING POINTER\r
+PSAV==-3 ;SAVED P-STACK\r
+TPSAV==-2 ;TOP OF STACK POINTER\r
+PCSAV==-1 ;PCWORD\r
+\r
+RMT [EXPUNGE FRAMLN\r
+]\r
+IFE MAIN,[RMT [EXPUNGE PCSAV TPSAV SPSAV PSAV ABSAV FSAV OTBSAV \r
+]\r
+]\r
+\r
+;CALL MACRO\r
+; ARGS ARE PUSHED ON THE STACK AS TYPE VALUE PAIRS\r
+\r
+.GLOBAL .MCALL,.ACALL,FINIS,CONTIN,.ECALL,FATINS\r
+\r
+; CALL WITH AN ASSEMBLE TIME KNOWN NUMBER OF ARGUMENTS\r
+\r
+IF1 [\r
+DEFINE MCALL N,F\r
+ .GLOBAL F\r
+ IFGE <17-N>,.MCALL N,F\r
+ IFL <17-N>,[PRINTC /LOSSAGE AT MCALL - TOO MANY ARGS\r
+/\r
+ .MCALL F\r
+ ]\r
+ TERMIN\r
+\r
+; CALL WITH RUN TIME KNOWN NUMBER OF ARGS IN AC SPECIFIED BY N\r
+\r
+DEFINE ACALL N,F\r
+ .GLOBAL F\r
+ .ACALL N,F\r
+ TERMIN\r
+\r
+; STANDARD SUBROUTINE RETURN\r
+\r
+; JRST FINIS\r
+\r
+; ARGUMENTS WILL NO LONGER BE ON THE STACK WHEN RETURN HAS HAPPENED\r
+; VALUE SHOULD BE IN A AND B\r
+\r
+;CHECK THAT THE ENTRY POINT WAS CALLED WITH N ARGUMENTS\r
+\r
+DEFINE ENTRY N\r
+ IFSN N,,[\r
+ HLRZ A,AB\r
+ CAIE A,-2*N\r
+ JSP E,GETWNA]\r
+TERMIN\r
+\f\r
+\r
+; MACROS ASSOCIATED WIT INTERRUPT PROCESSING\r
+;INTERRUPT IF THERE IS A WAITING INTERRUPT\r
+\r
+DEFINE INTGO\r
+ SKIPGE INTFLG\r
+ JSR LCKINT\r
+TERMIN\r
+\r
+;TO BECOME INTERRUPTABLE\r
+\r
+DEFINE ENABLE\r
+ AOSN INTFLG\r
+ JSR LCKINT\r
+TERMIN\r
+\r
+;TO BECOME UNITERRUPTABLE\r
+\r
+DEFINE DISABLE\r
+ SETZM INTFLG\r
+TERMIN\r
+]\r
+\fIF1 [\r
+;MACRO TO BUILD TYPE DISPATCH TABLES EASILY\r
+\r
+DEFINE TBLDIS NAME,DEFAULT,LIST,LNTH\r
+\r
+NAME:\r
+ REPEAT LNTH+1,DEFAULT\r
+ IRP A,,[LIST]\r
+ IRP TYPE,LOCN,[A]\r
+ LOC NAME+TYPE\r
+ LOCN\r
+ .ISTOP\r
+ TERMIN\r
+ TERMIN\r
+ LOC NAME+LNTH+1\r
+TERMIN\r
+\r
+; DISPATCH FOR NUMPRI GOODIES\r
+\r
+DEFINE DISTBL NAME,DEFAULT,LIST\r
+ TBLDIS NAME,DEFAULT,[LIST]NUMPRI\r
+ TERMIN\r
+\r
+DEFINE DISTBS NAME,DEFAULT,LIST\r
+ TBLDIS NAME,DEFAULT,[LIST]NUMSAT\r
+ TERMIN\r
+\r
+]\r
+\f\r
+\r
+VECFLG==0\r
+PARFLG==0\r
+\r
+;MACROS FOR INITIIAL MUDDLE LIST STRUCTURE\r
+\r
+;CHAR STRING MAKER, RETURNS POINTER AND TYPE\r
+\r
+IF1 [\r
+DEFINE MACHAR NAME,TYPE,VAL,\LNT,WHERE,LAST\r
+ TYPE==TCHSTR\r
+ VECTGO WHERE\r
+ LNT==.LENGTH \NAME!\\r
+ ASCII \NAME!\\r
+ LAST==$."\r
+ TCHRS,,0\r
+ $."-WHERE+1,,0\r
+ VAL==LNT,,WHERE\r
+ VECRET\r
+\r
+TERMIN\r
+;MACRO TO DEFINE ATOMS\r
+\r
+DEFINE MAKAT NAME,TYAT,VALU,OBLIS,REFER,LOCN,\TVENT,FIRST\r
+ FIRST==.\r
+ TYAT,,OBLIS\r
+ VALU\r
+ 0\r
+ ASCII \NAME!\\r
+ 400000+SATOM,,0\r
+ .-FIRST+1,,0\r
+ TVENT==FIRST-.+2,,FIRST\r
+ IFSN [LOCN],LOCN==TVENT\r
+ ADDTV TATOM,TVENT,REFER\r
+ TERMIN\r
+\r
+\r
+\r
+\f;MACROS TO SWITCH BACK AND FORTH INTO AND OUT OF VECTOR AND PAIR SPACE\r
+;GENERAL SWITCHER\r
+\r
+DEFINE LOCSET LOCN,RETNAM,NEWLOC,OTHLOC,F1,F2,TOPWRD,\SAVE,SAVEF1,SAVEF2,NEW\r
+\r
+ IFE F1,[SAVE==.\r
+ LOC NEWLOC\r
+ SAVEF2==F2\r
+ IFN F2,OTHLOC==SAVE\r
+ F2==0\r
+ DEFINE RETNAM\r
+ F1==F1-1\r
+ IFE F1,[NEWLOC==.\r
+ F2==SAVEF2\r
+ LOC TOPWRD\r
+ NEWLOC\r
+ LOC SAVE\r
+ ]\r
+ TERMIN\r
+ ]\r
+\r
+ IFN F1,[F1==F1+1\r
+ ]\r
+\r
+ IFSN LOCN,,LOCN==.\r
+ IFE F1,F1==1\r
+\r
+TERMIN\r
+\r
+\r
+DEFINE VECTGO LOCN\r
+ LOCSET LOCN,VECRET,VECLOC,PARLOC,VECFLG,PARFLG,VECTOP\r
+ TERMIN\r
+\r
+DEFINE PARGO LOCN\r
+ LOCSET LOCN,PARRET,PARLOC,VECLOC,PARFLG,VECFLG,PARTOP\r
+ TERMIN\r
+\r
+DEFINE ADDSQU NAME,\SAVE\r
+ SAVE==.\r
+ LOC SQULOC\r
+ SQUOZE 0,NAME\r
+ NAME\r
+ SQULOC==.\r
+ LOC SAVE\r
+ TERMIN\r
+\r
+DEFINE ADDTV TYPE,GOODIE,REFER,\SAVE\r
+ SAVE==.\r
+ LOC TVLOC\r
+ TVOFF==.-TVBASE+1\r
+ TYPE,,REFER\r
+ GOODIE\r
+ TVLOC==.\r
+ LOC SAVE\r
+ TERMIN\r
+\r
+;MACRO TO ADD TO PROCESS VECTOR\r
+\r
+DEFINE ADDPV TYPE,GOODIE,OFFS,\SAVE\r
+ SAVE==.\r
+ LOC PVLOC\r
+ PVOFF==.-PVBASE\r
+ IFSN OFFS,,OFFS==PVOFF\r
+ TYPE,,0\r
+ GOODIE\r
+ PVLOC==.\r
+ LOC SAVE\r
+ TERMIN\r
+\r
+\r
+\r
+\r
+\f\r
+;MACRO TO DEFINE A FUNCTION ATOM\r
+\r
+DEFINE MFUNCTION NAME,TYPE,PNAME\r
+ (TVP)\r
+NAME":\r
+ VECTGO DUMMY1\r
+ ADDSQU NAME\r
+ IFSE [PNAME],MAKAT NAME,T!TYPE,NAME,SYSTEM,<NAME-1>\r
+ IFSN [PNAME],MAKAT [PNAME]T!TYPE,NAME,SYSTEM,<NAME-1>\r
+ VECRET\r
+ TERMIN\r
+\r
+; VERSION OF MQUOTE WITH IMPURE BIT ON\r
+\r
+DEFINE IMQUOTE ARG,PNAME,OBLIS,\LOCN\r
+ (TVP)\r
+\r
+ LOCN==.-1\r
+ VECTGO DUMMY1\r
+ IFSE [PNAME],MAKAT [ARG]<400000+TUNBOU>,0,OBLIS,LOCN\r
+\r
+ IFSN [PNAME],MAKAT [PNAME]<400000+TUNBOU>,0,OBLIS,LOCN\r
+ VECRET\r
+ TERMIN\r
+\r
+;MACRO TO DEFINE QUOTED GOODIE\r
+\r
+DEFINE MQUOTE ARG,PNAME,OBLIS,\LOCN\r
+ (TVP)\r
+\r
+ LOCN==.-1\r
+ VECTGO DUMMY1\r
+ IFSE [PNAME],MAKAT [ARG]TUNBOU,0,OBLIS,LOCN\r
+ IFSN [PNAME],MAKAT [PNAME]TUNBOU,0,OBLIS,LOCN\r
+ VECRET\r
+ TERMIN\r
+\r
+\r
+\r
+\r
+DEFINE CHQUOTE NAME,\LOCN,TYP,VAL\r
+ (TVP)\r
+ LOCN==.-1\r
+ MACHAR [NAME]TYP,VAL\r
+ ADDTV TYP,VAL,LOCN\r
+\r
+ TERMIN\r
+\r
+\r
+; SPECIAL ERROR MQUOTE\r
+\r
+DEFINE EQUOTE ARG,PNAME\r
+ MQUOTE ARG,[PNAME]ERRORS TERMIN\r
+\r
+\r
+; MACRO DO .CALL UUOS\r
+\r
+DEFINE DOTCAL NM,LIST,\LOCN\r
+ .CALL LOCN\r
+ RMT [LOCN==.\r
+ SETZ\r
+ SIXBIT /NM/\r
+ IRP Q,R,[LIST]\r
+ IFSN [R][][Q\r
+ ]\r
+\r
+ IFSE [R][][<SETZ>\<Q>\r
+ ]\r
+ TERMIN\r
+ ]\r
+TERMIN\r
+\r
+; MACRO TO HANDLE FATAL ERRORS\r
+\r
+DEFINE FATAL MSG/\r
+ FATINS [ASCIZ /:\e FATAL ERROR MSG \e\r
+/]\r
+ TERMIN\r
+]\r
+\f\r
+CHRWD==5\r
+\r
+IFN READER,[\r
+NCHARS==177\r
+;CHARACTER TABLE GENERATING MACROS\r
+\r
+DEFINE SETSYM WRDL,BYTL,COD\r
+ WRD!WRDL==<WRD!WRDL>&<MSK!BYTL>\r
+ WRD!WRDL==<WRD!WRDL>\<<COD&177>_<<4-BYTL>*7+1>>\r
+ TERMIN\r
+\r
+DEFINE INIWRD N,INIT\r
+ WRD!N==INIT\r
+ TERMIN\r
+\r
+DEFINE OUTWRD N\r
+ WRD!N\r
+ TERMIN\r
+\r
+;MACRO TO KILL THESE SYMBOLS LATER\r
+\r
+DEFINE KILLWD N\r
+ EXPUNGE WRD!N\r
+ TERMIN\r
+DEFINE SETMSK N\r
+ MSK!N==<177_<<4-N>*7+1>>#<-1>\r
+ TERMIN\r
+\r
+;MACRO TO KILL MASKS LATER\r
+\r
+DEFINE KILMSK N\r
+ EXPUNGE MSK!N\r
+ TERMIN\r
+\r
+NWRDS==<NCHARS+CHRWD-1>/CHRWD\r
+\r
+REPEAT CHRWD,SETMSK \.RPCNT\r
+\r
+REPEAT NWRDS,INIWRD \.RPCNT,004020100402\r
+\r
+DEFINE OUTTBL\r
+ REPEAT NWRDS,OUTWRD \.RPCNT\r
+ TERMIN\r
+\r
+\r
+;MACRO TO GENERATE THE DUMMIES EASLILIER\r
+\r
+DEFINE INITCH \DUM1,DUM2,DUM3\r
+\r
+\r
+DEFINE SETCOD COD,LIST\r
+ IRP CHAR,,[LIST]\r
+ DUM1==CHAR/5\r
+ DUM2==CHAR-DUM1*5\r
+ SETSYM \DUM1,\DUM2,COD\r
+ TERMIN\r
+ TERMIN\r
+\r
+DEFINE SETCHR COD,LIST\r
+ IRPC CHAR,,[LIST]\r
+ DUM3=="CHAR\r
+ DUM1==DUM3/5\r
+ DUM2==DUM3-DUM1*5\r
+ SETSYM \DUM1,\DUM2,COD\r
+ TERMIN\r
+ TERMIN\r
+\r
+DEFINE INCRCO OCOD,LIST\r
+ IRP CHAR,,[LIST]\r
+ DUM1==CHAR/5\r
+ DUM2==CHAR-DUM1*5\r
+ SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>\r
+ TERMIN\r
+ TERMIN\r
+\r
+DEFINE INCRCH OCOD,LIST\r
+ IRPC CHAR,,[LIST]\r
+ DUM3=="CHAR\r
+ DUM1==DUM3/5\r
+ DUM2==DUM3-DUM1*5\r
+ SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>\r
+ TERMIN\r
+ TERMIN\r
+ RMT [EXPUNGE DUM1,DUM2,DUM3\r
+ REPEAT NWRDS,KILLWD \.RPCNT\r
+ REPEAT CHRWD,KILMSK \.RPCNT\r
+]\r
+\r
+TERMIN\r
+\r
+INITCH\r
+]\r
+\f\r
+;REDEFINE END DO ALL THE REMOTES (ON LAST PASS ONLY)\r
+\r
+EQUALS E.END END\r
+\r
+DEFINE END ARG\r
+ EQUALS END E.END\r
+ CONSTANTS\r
+\r
+ IMPURE\r
+ VARIABLES\r
+ PURE\r
+ HERE\r
+ .LNKOT\r
+ IF2 GEXPUN\r
+ CONSTANTS\r
+ IMPURE\r
+ VARIABLES\r
+ CODEND==.\r
+ LOC CODTOP\r
+ CODEND\r
+ LOC CODEND\r
+ PURE\r
+ CODEND==.\r
+ LOC HITOP\r
+ CODEND\r
+ LOC CODEND\r
+ IF2 EXPUNGE PARFLG,VECFLG,CHRWD,NN,NUMPRI,PURITY,EAD,ACD,PUSHED\r
+ IF2 EXPUNGE INSTNT,DUMMY1,PRIM,PPLNT,GSPLNT,MEDIAT\r
+ END ARG\r
+ TERMIN\r
+\r
+\r
+;MACROS TO PRINT VERSIONS OF PROGRAMS DURING ASSEMBLY\r
+\r
+IF1 [\r
+DEFINE NUMGEN SYM,\REST,N\r
+ NN==NN-1\r
+ N==<SYM_-30.>&77\r
+ REST==<SYM_6>\r
+ IFN N,IFGE <31-N>,IFGE <N-20>,TOTAL==TOTAL*10.+<N-20>\r
+ IFN NN,NUMGEN REST\r
+ EXPUNGE N,REST\r
+ TERMIN\r
+\r
+DEFINE VERSIO N\r
+ PRINTC /VERSION = N\r
+/\r
+ TERMIN\r
+]\r
+\r
+TOTAL==0\r
+NN==7\r
+\r
+NUMGEN .FNAM2\r
+\r
+IF1 [\r
+RADIX 10.\r
+\r
+VERSIO \TOTAL\r
+\r
+RADIX 8\r
+PROGVN==TOTAL\r
+\r
+\r
+DEFINE VATOM SYM,\LOCN,TV,A,B\r
+ VECTGO\r
+ LOCN==.\r
+ TFIX,,MUDDLE\r
+ PROGVN\r
+ 0\r
+ A==<<<<SYM_-30.>&77>+40>_29.>\r
+ B==<<SYM_-24.>&77>\r
+ IFN B,A==A+<<B+40>_22.>\r
+ B==<<SYM_-18.>&77>\r
+ IFN B,A==A+<<B+40>_15.>\r
+ B==<<SYM_-12.>&77>\r
+ IFN B,A==A+<<B+40>_8.>\r
+ B==<<SYM_-6.>&77>\r
+ IFN B,A==A+<<B+40>_1.>\r
+ A\r
+ IFN <SYM&77>,<<SYM&77>+40>_29.\r
+ 400000+SATOM,,\r
+ .-LOCN+1,,0\r
+ TV==LOCN-.+2,,LOCN\r
+ ADDTV TATOM,TV,0\r
+ VECRET\r
+ TERMIN\r
+\r
+;VATOM .FNAM1 ;"HACK REMOVED FOR EFFICIENCY"\r
+\r
+\r
+;MACRO TO REMMVE SYMBOLS OF THE FORM "GXXXXX"\r
+\r
+DEFINE GEXPUN \SYM\r
+ NN==7\r
+ TOTAL==0\r
+ NUMGEN \<SIXBIT /SYM!/>\r
+ RADIX 10.\r
+ .GSSET 0\r
+ REPEAT TOTAL,XXP\r
+ RADIX 8\r
+TERMIN\r
+\r
+DEFINE XXP \A\r
+ EXPUNGE A\r
+ TERMIN\r
+\r
+\r
+DEFINE ..LOC NEW,OLD\r
+ .LIFS .LPUR"+.LIMPU"\r
+ OLD!"==$."\r
+ LOC NEW!"\r
+ .ELDC\r
+ .LIFS -.LPUR"\r
+ LOC $."\r
+ .ELDC\r
+ .LIFS -.LIMPU\r
+ LOC $."\r
+ .ELDC\r
+ TERMIN\r
+\r
+\r
+; PURE - MACRO TO SWITCH LOADING TO PURE CORE.\r
+\r
+DEFINE PURE\r
+ IFE PURITY-1, ..LOC .LPUR,.LIMPU\r
+ PURITY==0\r
+ TERMIN\r
+\r
+; IMPURE - MACRO TO SWITCH LOADING TO IMPURE CORE.\r
+\r
+DEFINE IMPURE\r
+ IFE PURITY, ..LOC .LIMPU,.LPUR\r
+ PURITY==1\r
+ TERMIN\r
+]\r
+PURITY==0\r
+\f\f\r
projects / pdp10-muddle.git / blobdiff