--- /dev/null
+;CONVENTIONS USED IN ALL INTERNAL MUDDLE PROGRAMS
+
+;FOR EFFICIENCY THE STANDARD MODE OF RUNNING IS UNINTERRUPTABLE
+;WITH EXPLICIT CHECKS
+;FOR PENDING INTERRUPTS
+
+
+; 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 IS CALLED
+;AND THEN THE PROCESS WHICH WAS RUNNING IS
+;PASSIVATED AND ANOTHER RESUMED.
+
+; ALL ATOM HEADERS WILL BE REFERRED TO IN ASSEMBLED CODE BY
+; MQUOTE <PNAME>
+; FUNCTION CALLS TO INITIAL FUNCTIONS WILL BE CALLED USING THE FOLLOWING:
+
+; MCALL N,<PNAME> ;SEE MCALL MACRO
+
+; UNLESS PNAME IS NOT A VALID MIDAS SYMBOL, IN WHICH CASE FUNINESS
+
+
+
+\f; ORGANIZATION OF CORE STORAGE IN THE MUDDLE SYSTEM (ENVIRONMENT)
+
+; 20: SPECIAL CODE FOR UUO AND INTERUPTS
+
+;CODBOT: WORD CONTAINING LOCATION OFBOTTOMMOST WORD OF CODE
+
+; --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
+
+
+\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
+;TFLOT ;FLOATING POINT
+;TCHRS ;WORD OF UP TO 5 ASCII CHARACTERS
+;TLIST ;LIST ELEMENT
+;TVEC ;VECTOR (AOBJN POINTER TO GENERALIZED VECTOR)
+;TAP ;SAVED AP
+;TAB ;SAVED AB (CANT APPEAR IN LISTS)
+;TTP ;SAVED TP
+;TTB ;SAVED TP
+;TATOM ;ATOM WHICH IS REALLY A SPECIAL TYPE OF VECTOR BUT MAY CHANGE
+;TEXPR ;FUNCTIONS CORRESPONDING TO THE STANDARD LISP FUNCTIONS
+;TSUBR ;MACHINE LANGUAGE 'EXPR'
+;TFSUBR ;MACHINE LANGUAGE PROGRAM (TAKES LIST AS ARG)
+;TENTRY ;RETURN ADDRESS FROM MCALL MACRO
+;TPDL ;SAVE "P"
+;TUNBOU ;UNBOUND VALUE
+;TLOCI ;IDENTIFIER LOCATIVE
+;TFUNARG ;FUNCTIONAL ARGUMENT
+;TTIME ;SPECIAL TIME POINTER-NOT MARKED (USER CAN'T SEE OR CHANGE)
+;TSKIP ;SKIP WORD ON SPECIAL PDL
+;TCHVEC ;VECTOR OF UNIFORM CHARACTERS NOT MARKED
+;TCHSTR ;GENERAL VECTOR OF CHARACTERS
+;TTVP ;SAVE TRANSFER VEVTOR POINTER
+;TPVP ;SAVED PROCESS VECTOR POINTER
+;TCHAN ;CHANNEL VECTOR (SEE FOPEN FOR FULL DOCUMENTATION)
+;TENV ;ENVIRONMENT POINTER
+;TOBL ;OBLIST TYPE
+;TLMNT ;ELEMENT CALL
+;TSEG ;SEGMENT CALL
+
+;STORAGE ALLOCATION TYPES SAT (ALLOCATED VALUES BY AN IRP)
+
+;1WORD ;UNMARKED ONE WORD ENTITIES
+;2WORD ;LIST STRUCTURE GOODIES
+;2NWORD ;VECTOR STRUCTURE GOODIES
+;STACK ;PUSH DOWN STACKS
+;BASE ;ONE MEMBER, NAMELY AB
+\f; 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
+
+
+
+;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-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.
+
+;THE INFORMATION MAY BE ACCESSED WITH FUNCTIONS "SAT" AND "TYPE"
+
+
+;TYPE TO NAME OF TYPE TRANSLATION TABLE
+
+; TATOM,,<STORAGE ALLOCATION TYPE>
+; ATOMIC NAME
+
+;AN ATOM IS A VECTOR WITH 3 ELEMENTS AS FOLLOWS
+
+; TYPE OF VALUE TYPES ARE FULL WORD QUANTITIES
+; VALUE
+; TLIST,,<PROCESS I.D.>
+; PLIST (PROPERTY LIST)
+; TVEC (OR TCHRS IF LESS THAN 6 CHARS)
+; PNAME (VECTOR OF ELEMENTS OF TYPE TCHRS)
+; 7,,0 (SIGN BIT FOR G.C. RH FOR G.C. RELOCATION)
+
+;WARNING THE FORMAT OF ATOMS WILL CHANGE
+;USE THE INTERNAL FUNCTIONS IVCELL,IGVALU,ILVALU,IPNAME,IPLIST
+;AND THE EXTERNALS VCELL,GVALUE,LVALUE,PNAME,PLIST
+
+;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 WORD
+
+
+;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)
+
+; TTP,,0
+; <TP AT LAST ERROR CALL> ;CAN BE REFERENCED SYMBOLICALLY AS LERR(PVP)
+
+; TTB,,0
+; <LAST PROG> ;LPROG(PVP)
+; .
+; .
+; .
+; PV DOPE WORD
+
+
+
+
+;FORMAT OF PUSH DOWN STACKS USED AND CONVENTIONS
+
+;SPECIAL PDL (SP)
+
+; .
+; .
+; .
+; TYPE OF VALUE
+; OLD CONTENTS OF VALUE CELL
+; $TATOM
+; LOCATION OF VALUE CELL
+; .
+; .
+; VD (FOR PDL)
+
+
+
+
+
+;THE FORMAT FOR TP (TEMPORARY PDL MARKED) AND AP (ARGUMENT PDL) ARE NOW THE SAME
+;EVENTUALLY THIS MAY
+;CHANGE BY BLOCKING THE AP WITH
+;VECTOR DESCRIPTORS AT THE HEAD OF EACH BLOCK
+
+
+
+
+; .
+; .
+; .
+; TYPE
+; GOODIE
+; .
+; .
+; VD (VECTOR DOPE FOR THE VECTOR WHICH IS PDL)
+
+
+
+\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)
+SP"=15 ;SPECIAL PDL (USED BY MUDDLE FOR VARIABLE BINDINGS) (NOT USED NOW)
+TP"=14 ;MARKED PDL (USED BY MUDDLE FOR ARGS TO FUNCTIONS
+ ;AND MARKED TEMPORARIES)
+TB"=13 ;MARKED PDL BASE POINTER
+R"=12 ;RELOCATION INDEX FOR LOCATION INSENSITIVE SUBRS
+AB"=11 ;ARGUMENT PDL BASE (MARKED)
+ ;AB IS AN AOBJN POINTER TO THE ARGUMENTS
+PP"=10 ;PLANNER PDL (MAY NOT BE IN DYNAMIC MODELLING)
+TVP"=7 ;TRANSFER VECTOR POINTER
+PVP"=6 ;PROCESS VECTOR POINTER
+
+;THE FOLLOWING ACS ARE 'SCRATCH' FOR MUDDLE
+
+A"=1
+B"=2
+C"=3
+D"=4
+E"=5
+
+NIL"=0 ;END OF LIST MARKER
+
+;MACRO TO DEFINE MAIN IF NOT DEFINED
+
+DEFINE DEFMAI ARG,\D
+ D==.TYPE ARG
+ IFE <D-17>,ARG==0
+ EXPUNGE D
+ TERMIN
+
+DEFMAI MAIN
+DEFMAI READER
+
+EXPUNGE DEFMAI
+
+; DEFINE SYMBLOS FOR VARIOUS OBLISTS
+
+SYSTEM==0 ;MAIN SYSTEM OBLIST
+ERRORS==1 ;ERROR COMMENT OBLIST
+INTRUP==2 ;INERRUPT OBLIST
+
+\f;DEFINE TYPES AND $TYPES AND IF MAIN NOT 0, MAKE THE $TYPE WORDS
+
+NUMPRI==-1 ;NUMBER OF PRIMITIVE TYPES
+
+
+DEFINE TYPMAK SAT,LIST
+IRP A,,[LIST]
+NUMPRI==NUMPRI+1
+IRP B,C,[A]
+T!B==NUMPRI
+.GLOBAL $!T!B
+IFN MAIN,[$!T!B=[T!B,,0]
+]
+.ISTOP
+TERMIN
+IFN MAIN,[
+RMT [ADDTYP [A]SAT
+]]
+TERMIN
+IFE MAIN,[RMT [EXPUN [LIST]
+]
+]
+TERMIN
+
+;MACRO TO ADD STUFF TO TYPE VECTOR
+
+IFN MAIN,[
+DEFINE ADDTYP TYPE,SAT,\LOCN
+ IRP TYP,NAME,[TYPE]
+ TFIX,,SAT
+ IFSN [NAME],[IFSE [NAME]IN,MQUOTE INTERNAL
+ IFSN [NAME]IN,MQUOTE [NAME]
+ ]
+ IFSE [NAME],MQUOTE TYP
+ .ISTOP
+ TERMIN
+ TERMIN
+]
+
+;DEFINE THE STORAGE ALLOCATION TYPES IN THE WORLD
+
+
+NUMSAT==0
+GENERAL==400000,,0 ;FLAG FOR BEING A GENERAL VECTOR
+
+IRP A,,[1WORD,2WORD,2DEFRD,NWORD,2NWORD,TPSTK,PSTK,ARGS
+ABASE,TBASE,FRAME,BYTE,ATOM,PVP,CHSTR,ASOC,INFO]
+NUMSAT==NUMSAT+1
+S!A==NUMSAT
+TERMIN
+
+
+;MACRO FOR SAVING STUFF TO DO LATER
+
+.GSSET 4
+
+DEFINE HERE G00002,G00003
+G00002!G00003!TERMIN
+
+DEFINE RMT A
+HERE [DEFINE HERE G00002,G00003
+G00002!][A!G00003!TERMIN]
+TERMIN
+
+
+RMT [EXPUNGE SYSTEM,ERRORS,INTRUP
+]
+\f;BUILD THE TYPE CODES AND ADD STUFF TO TYPVEC AND DEFINE $!TYPE)
+
+IFN MAIN,[RMT [SAVE==.
+ LOC TYPVLC
+ ]
+ ]
+
+TYPMAK S1WORD,[LOSE,FIX,FLOAT,[CHRS,CHARACTER],[ENTRY,IN],SUBR,FSUBR,UNBOUND,[BIND,IN],ILLEGAL]
+TYPMAK S1WORD,[TIME]
+TYPMAK S2WORD,[LIST,FORM,[SEG,SEGMENT],[EXPR,FUNCTION],[FUNARG,CLOSURE],LOCL,FALSE]
+TYPMAK S2DEFRD,[[DEFER,IN]]
+TYPMAK SNWORD,[[UVEC,UVECTOR],[OBLS,OBLIST]]
+TYPMAK S2NWORD,[[VEC,VECTOR],[CHAN,CHANNEL],LOCV,[TVP,IN],[BVL,IN],TAG]
+TYPMAK SPVP,[[PVP,IN]]
+TYPMAK S2NWORD,[[LOCI,IN]]
+TYPMAK STPSTK,[[TP,IN]]
+TYPMAK S2NWORD,[[SP,IN]]
+TYPMAK STPSTK,[[LOCS,IN],[PP,IN]]
+TYPMAK SPSTK,[[PDL,IN]]
+TYPMAK SARGS,[[ARGS,ARGUMENTS]]
+TYPMAK SABASE,[[AB,IN]]
+TYPMAK STBASE,[[TB,IN]]
+TYPMAK SFRAME,[FRAME]
+TYPMAK SCHSTR,[[CHSTR,STRING]]
+TYPMAK SATOM,[ATOM]
+TYPMAK S2NWORD,[LOCD]
+TYPMAK SBYTE,[BYTE]
+TYPMAK S2NWORD,[[ENV,ENVIRONMENT]]
+TYPMAK SFRAME,[[ACT,ACTIVATION]]
+TYPMAK S2WORD,[[PIC,PICTURE],[MOVTO,MOVE-TO],[MOVREL,MOVE-REL],[DRWTO,DRAW-TO],[DRWREL,DRAW-REL],TEXT]
+TYPMAK SASOC,[ASOC]
+TYPMAK SNWORD,[LOCU]
+TYPMAK SCHSTR,[LOCC]
+TYPMAK SARGS,[LOCA]
+TYPMAK S1WORD,[[ENTS,IN],[TBS,IN],[PDLS,IN],[PC,IN]]
+TYPMAK SINFO,[[INFO,IN]]
+TYPMAK S2WORD,[[UNAS,UNASSIGNED],[AF,ACTORFORM],[SAF,SACTORFORM]]
+TYPMAK S2WORD,[ACTOR,[ACTF,ACTOR-FUNCTION]]
+
+
+IFN MAIN,[RMT [LOC SAVE
+ ]
+ ]
+EXPUNGE TYPMAK
+
+RMT [EQUALS XP EXPUNGE
+]
+
+DEFINE EXPUN LIST
+ IRP A,,[LIST]
+ IRP B,,[A]
+ EXPUNGE T!B
+ .ISTOP
+ TERMIN
+ TERMIN
+ TERMIN
+
+
+DEFINE GETYP AC,ADR
+ LDB AC,[221500,,ADR]
+ TERMIN
+
+DEFINE GETYPF AC,ADR
+ LDB AC,[003700,,ADR]
+ TERMIN
+\f
+
+;DEFINE ENTRIES IN PROCESS VECTOR AS BEING GLOBAL
+
+IRP A,,[0,A,B,C,D,E,PVP,TVP,TP,TB,AP,AB,P,PB,SP,PP]
+.GLOBAL A!STO
+TERMIN
+
+;MUDDLE WIDE GLOBALS
+
+
+.GLOBAL FOPEN,VECTOR,EVECTOR,CALER1,IVAL,SPECBIND,6TOCHS,CHMAK
+.GLOBAL ILOOKU
+
+
+.GLOBAL PROCID,LPROG,LERR,FINIS,PARTOP,VECTOP,TVLNTH,PVLNTH,SAT
+.GLOBAL CODTOP
+
+.GLOBAL SAVCAL,RESCAL,SAVCN,RESCN,LCKINT,SAVEUP,WNA,NOTATOM,INTFLG,TYPVEC
+
+;PRINTER GLOBALS NEEDED (WILL GO WHEN CHANNLES USED)
+
+.GLOBAL POSIT,CHRLIN
+
+;GLOBALS ASSOCIATED WITH CHANNELS (SEE 'FOPEN >' FOR DETAILS)
+
+.GLOBAL CHANNO,DIRECT,DEVICE,NAME1,NAME2,SNAME,RNAME1,RNAME2,STATUS,IOINS,LINLN
+.GLOBAL CHRPOS,PAGLN,LINPOS,UNAME,FDIR,CALER1,ROOT,TTICHN,TTOCHN
+
+
+;GLOBALS FOR MACROS IN VECTOR AND PAIR SPACE
+
+.GLOBAL VECLOC,PARLOC,TVBASE,TVLOC,PVLOC,PVBASE
+.GLOBAL PARTOP,VECTOP,TVLNTH,PVLNTH
+
+
+;STORAGE ALLOCATIN SPECIFICATION GLOBALS
+
+PROLOC=10 ;NUMBER OF INITIAL LOCALS PER PROCESS
+PPLNT==150. ;PLANNER PDL LENGTH
+TPLNT"=1500. ;TEMP PDL LENGTHH
+GSPLNT==2000 ;INITIAL GLOBAL SP
+SPLNT"=300. ;SPECIAL LENGTH
+GCPLNT"=1000. ;GARBAGE COLLECTOR'S PDL LENGTH
+PVLNT"=100 ;LENGTH OF INITIAL PROCESS VECTOR
+TVLNT"==2000 ;MAX TRANSFER VECTOR
+IAPLNT"=100 ;AP FOR GC
+ITPLNT"=100 ;TP FOR GC
+PLNT"=300. ;PDL FOR USER PROCESS
+
+;LOCATIONS OF VARIOUS STORAGE AREAS
+
+
+
+PARBASE"=26000 ;START OF PAIR SPACE
+VECBASE"=40000 ;START OF VECTOR SPACE
+IFN MAIN,[PARLOC"=PARBASE
+VECLOC"=VECBASE
+]
+\f
+;INITIAL MACROS
+
+
+
+;STANDARD SUBROUTINE CALL TO F WITH N ARGUMENTS
+;VALUE COMES BACK IN B WITH TYPE IN A
+;IN ORDER TO BE ABLE TO BUM CALLS IN THE FUTURE, ALL CALLS SHOULD BE
+;COMMENTED AS TO WHICH STACK POINTERS THEY ASSUME ARE SAVED.
+
+;SYMBLOS ASSOCIATED WITH STACK FRAMES
+FRAMLN==10 ;LENGTH OF A FRAME
+FSAV==-8 ;POINT TO CALLED FUNCTION
+OTBSAV==-7 ;POINT TO PREVIOUS FRAME AND CONTAINS TIME
+ABSAV==-6 ;ARGUMENT POINTER
+SPSAV==-5 ;BINDING POINTER
+PSAV==-4 ;SAVED P-STACK
+TPSAV==-3 ;TOP OF STACK POINTER
+PPSAV==-2 ;SAVED PLANNER PDL
+PCSAV==-1 ;PCWORD
+
+RMT [EXPUNGE FRAMLN
+]
+IFE MAIN,[RMT [EXPUNGE PCSAV TPSAV SPSAV PSAV ABSAV FSAV TBSAV
+]
+]
+
+;STANDARD SUBROUTINE RETURN
+; JRST FINIS"
+;CALL MACRO
+
+.GLOBAL .MCALL,.ACALL,FINIS,CONTIN
+
+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
+
+DEFINE ACALL N,F
+ .GLOBAL F
+ .ACALL N,F
+ TERMIN
+
+.GLOBAL TBINIT
+
+
+
+
+
+
+;INTERRUPT IF THERE IS A WAITING INTERRUPT
+
+DEFINE INTGO
+ SKIPGE INTFLG
+ JSR LCKINT
+TERMIN
+
+
+;CHECK THAT THE ENTRY POINT WAS CALLED WITH N ARGUMENTS
+;AND SEE IF THERE ARE PENDING INTERRUPTS
+;THEN PROBABLY WANT TO SAVE TB WITH GENTEM (BELOW)
+
+DEFINE ENTRY N
+ IFSN N,,[
+ HLRZ A,AB
+ CAIE A,-2*N
+ JRST WNA]
+TERMIN
+
+
+;TO BECOME INTERRUPTABLE
+
+DEFINE ENABLE
+ AOSN INTFLG
+ JSR LCKINT
+TERMIN
+
+
+;TO BECOME UNITERRUPTABLE
+
+DEFINE DISABLE
+ SETZM INTFLG
+TERMIN
+\f;MACRO TO BUILD TYPE DISPATCH TABLES EASILY
+
+DEFINE TBLDIS NAME,DEFAULT,LIST,LNTH
+
+NAME:
+ REPEAT LNTH+1,DEFAULT
+ IRP A,,[LIST]
+ IRP TYPE,LOCN,[A]
+ LOC NAME+TYPE
+ LOCN
+ .ISTOP
+ TERMIN
+ TERMIN
+ LOC NAME+LNTH+1
+TERMIN
+
+; DISPATCH FOR NUMPRI GOODIES
+
+DEFINE DISTBL NAME,DEFAULT,LIST
+ TBLDIS NAME,DEFAULT,[LIST]NUMPRI
+ TERMIN
+
+DEFINE DISTBS NAME,DEFAULT,LIST
+ TBLDIS NAME,DEFAULT,[LIST]NUMSAT
+ TERMIN
+
+\f
+
+VECFLG==0
+PARFLG==0
+
+;MACROS FOR INITIIAL MUDDLE LIST STRUCTURE
+
+;CHAR STRING MAKER, RETURNS POINTER AND TYPE
+
+DEFINE MACHAR NAME,TYPE,VAL,\LNT,WHERE,LAST
+ TYPE==TCHSTR
+ VECTGO WHERE
+ ASCII \NAME!\
+ LAST==$."
+ TCHRS,,0
+ $."-WHERE+1,,0
+ VAL==-<LAST-WHERE>,,WHERE
+ VECRET
+
+TERMIN
+;MACRO TO DEFINE ATOMS
+
+DEFINE MAKAT NAME,TYAT,VALU,OBLIS,REFER,LOCN,\TVENT,FIRST
+ FIRST==.
+ TYAT,,OBLIS
+ VALU
+ 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 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
+ (TVP)
+NAME":
+ VECTGO DUMMY1
+ IFSE [PNAME],MAKAT NAME,T!TYPE,NAME,SYSTEM,<NAME-1>
+ IFSN [PNAME],MAKAT [PNAME]T!TYPE,NAME,SYSTEM,<NAME-1>
+ 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
+
+\f
+CHRWD==5
+
+IFN READER,[
+NCHARS==177
+;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/5
+ DUM2==CHAR-DUM1*5
+ SETSYM \DUM1,\DUM2,COD
+ TERMIN
+ TERMIN
+
+DEFINE SETCHR COD,LIST
+ IRPC CHAR,,[LIST]
+ DUM3=="CHAR
+ DUM1==DUM3/5
+ DUM2==DUM3-DUM1*5
+ SETSYM \DUM1,\DUM2,COD
+ TERMIN
+ TERMIN
+
+DEFINE INCRCO OCOD,LIST
+ IRP CHAR,,[LIST]
+ DUM1==CHAR/5
+ DUM2==CHAR-DUM1*5
+ SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>
+ TERMIN
+ TERMIN
+
+DEFINE INCRCH OCOD,LIST
+ IRPC CHAR,,[LIST]
+ DUM3=="CHAR
+ 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
+
+DEFINE END ARG
+ EQUALS END E.END
+ CONSTANTS
+ VARIABLES
+ HERE
+ .LNKOT
+ IFP GEXPUN
+ CONSTANTS
+ VARIABLES
+ CODEND==.
+ LOC CODTOP
+ CODEND
+ LOC CODEND
+ END ARG
+ TERMIN
+
+
+;MACROS TO PRINT VERSIONS OF PROGRAMS DURING ASSEMBLY
+
+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,,ERRORS
+ PROGVN
+ 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
+
+
+;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
+\f;MACRO TO SET A FAILPOINT WITH ADDRESS PC, GIVEN N WORDS PUSHED ABOVE -1(TB)
+
+DEFINE FPOINT PC,N
+ PUSH PP,$TPC ;PUSH PC MARKER
+ PUSH PP,[PC]
+ PUSH PP,[TTP,,ON] ;PUSH FRAME LOCATION
+ MOVE A,TP
+ SUB A,[<N-1>,,<N-1>]
+ PUSH PP,A
+ MOVEM TP,TPSAV(TB) ;MAKE SURE TP SLOT IS CORRECT
+ MOVE E,TB
+ PUSHJ P,BCKTRE ;COPY FRAME
+TERMIN\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff