PDP-10.its/src/mudsys/muddle.347

; 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)





; 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--

;


; 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

; 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

; 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


;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

IF1 [
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==1
;	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

;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,NUMSAT
]

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
]
];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

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
]
]
;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
]

;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


; 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
]
IF1 [
;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
]


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



;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





;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 /: FATAL ERROR MSG 
/]
	TERMIN
]

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
]

;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