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