X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=sumex%2Fmuddle.mcr291;fp=sumex%2Fmuddle.mcr291;h=29bd01134824b4c174a908e9f5dfdae04b2a0dba;hp=0000000000000000000000000000000000000000;hb=1c973408824dee4a587c040bc8075cd1bf047ba3;hpb=a3df309bdd1ea54242d39e62403548d1e4845f8e diff --git a/sumex/muddle.mcr291 b/sumex/muddle.mcr291 new file mode 100644 index 0000000..29bd011 --- /dev/null +++ b/sumex/muddle.mcr291 @@ -0,0 +1,1182 @@ +; 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 -- FOR NORMAL ATOMS +; EQUOTE -- FOR ERROR COMMENT ATOMS + +; FUNCTION CALLS TO INITIAL FUNCTIONS WILL BE CALLED USING THE FOLLOWING: + +; MCALL N, ;SEE MCALL MACRO +; ACALL AC, ; 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 + +; 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 + +;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 +; OBJ +; 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,,+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 + +; ,,<0 OR BINDID> ; TLOCI MEANS VAL EXISTS. + ; 0 MEANS GLOBAL +; ; BINDID SPECS ENV IN + ; WHICH LOCAL VAL EXISTS +; +; +; +; <400000+SATOM,,0> +; ,,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"=14 ;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 +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.>->,ITS==0 + IFN ITS,[PRINTC /ITS VERSION +/] + IFE ITS,[PRINTC /TENEX VERSION +/] + + TERMIN + +DEFINE DEFMAI ARG,\D + D==.TYPE ARG + IFE ,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,\CH + IFSE [CHF],CH==0 + IFSN [CHF],CH==CHBIT + IFSE [NAME]IN,CH==CHBIT + IFSN [CHF]-1,[ + TATOM,,CH+SAT + IFSN [NAME],[IFSE [NAME]IN,MQUOTE INTERNAL + IFSN [NAME]IN,MQUOTE [NAME] + ] + IFSE [NAME],MQUOTE TYPE + ] + IFSE [CHF]-1,[ + TATOM,,CH+SAT + IMQUOTE [NAME] + ] + TERMIN +] +] +IF2 [IFE MAIN,[DEFINE TYPMAK SAT,LIST + RMT [EXPUN [LIST] +] + TERMIN +] +] + +;DEFINE THE STORAGE ALLOCATION TYPES IN THE WORLD + + +NUMSAT==0 +GENERAL==400000,,0 ;FLAG FOR BEING A GENERAL VECTOR + +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,LOCT] + +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 + +; 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,FLOAT,[CHRS,CHARACTER],[ENTRY,IN],[SUBR,,1],[FSUBR,,1]] +TYPMAK S1WORD,[[UNBOUND,,1],[BIND,IN],[ILLEGAL,,1],TIME] +TYPMAK S2WORD,[LIST,FORM,[SEG,SEGMENT],[EXPR,FUNCTION],[FUNARG,CLOSURE]] +TYPMAK SLOCL,[LOCL] +TYPMAK S2WORD,[FALSE] +TYPMAK S2DEFRD,[[DEFER,IN]] +TYPMAK SNWORD,[[UVEC,UVECTOR],[OBLS,OBLIST,-1]] +TYPMAK S2NWORD,[[VEC,VECTOR],[CHAN,CHANNEL,1]] +TYPMAK SLOCV,[LOCV] +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]] +TYPMAK SABASE,[[AB,IN]] +TYPMAK STBASE,[[TB,IN]] +TYPMAK SFRAME,[FRAME] +TYPMAK SCHSTR,[[CHSTR,STRING]] +TYPMAK SATOM,[ATOM] +TYPMAK SLOCID,[LOCD] +TYPMAK SBYTE,[BYTE] +TYPMAK SFRAME,[[ENV,ENVIRONMENT],[ACT,ACTIVATION,1]] +TYPMAK SASOC,[ASOC] +TYPMAK SLOCU,[LOCU] +TYPMAK SLOCS,[LOCS] +TYPMAK SLOCA,[LOCA] +TYPMAK S1WORD,[[CBLK,IN]] +TYPMAK STMPLT,[[TMPLT,TEMPLATE]] +TYPMAK SLOCT,[LOCT] + ;THE FOLLOWING TYPES (THROUGH CSUBR) CAN PROBABLY BE RECYCLED +TYPMAK S1WORD,[[PC,IN]] +TYPMAK SINFO,[[INFO,IN]] +TYPMAK SATOM,[[BNDS,IN]] +TYPMAK S2NWORD,[[BVLS,IN]] +TYPMAK S1WORD,[[CSUBR,,1]] + +TYPMAK S1WORD,[[WORD]] +TYPMAK S2NWORD,[[RSUBR,,1]] +TYPMAK SNWORD,[CODE] + ;TYPE CLIST CAN PROBABLY BE RECYCLED +TYPMAK S2WORD,[[CLIST,IN]] +TYPMAK S1WORD,[[BITS]] +TYPMAK SSTORE,[STORAGE,PICTURE] +TYPMAK STPSTK,[[SKIP,IN]] +TYPMAK SATOM,[[LINK,,1]] +TYPMAK S2NWORD,[[INTH,IHEADER,1],[HAND,HANDLER,1]] +TYPMAK SLOCN,[[LOCN,LOCAS]] +TYPMAK S2WORD,[DECL] +TYPMAK SATOM,[DISMISS] +TYPMAK S2WORD,[[DCLI,IN]] +TYPMAK S2NWORD,[[ENTER,RSUBR-ENTRY,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]] +IFN MAIN,[RMT [LOC SAVE + ] + ] +IF2,EXPUNGE TYPMAK,DOTYPS + +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 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] +.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 + +; CALL WITH AN ASSEMBLE TIME KNOWN NUMBER OF ARGUMENTS + +IF1 [ +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 + +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 + +] + + +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 + (TVP) +NAME": + VECTGO DUMMY1 + ADDSQU NAME + IFSE [PNAME],MAKAT NAME,T!TYPE,NAME,SYSTEM, + IFSN [PNAME],MAKAT [PNAME]T!TYPE,NAME,SYSTEM, + 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][][\ + ] + TERMIN + ] +TERMIN + +; MACRO TO HANDLE FATAL ERRORS + +DEFINE FATAL MSG/ + FATINS [ASCIZ /: FATAL ERROR MSG  +/] + TERMIN +] + +CHRWD==5 + +IFN READER,[ +NCHARS==177 +;CHARACTER TABLE GENERATING MACROS + +DEFINE SETSYM WRDL,BYTL,COD + WRD!WRDL==& + WRD!WRDL==\<_<<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==/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,\ + TERMIN + TERMIN + +DEFINE INCRCH OCOD,LIST + IRPC CHAR,,[LIST] + DUM3=="CHAR + DUM1==DUM3/5 + DUM2==DUM3-DUM1*5 + SETSYM \DUM1,\DUM2,\ + 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 + +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==&77 + REST== + IFN N,IFGE <31-N>,IFGE ,TOTAL==TOTAL*10.+ + 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==<<<&77>+40>_29.> + B==<&77> + IFN B,A==A+<_22.> + B==<&77> + IFN B,A==A+<_15.> + B==<&77> + IFN B,A==A+<_8.> + B==<&77> + IFN B,A==A+<_1.> + A + IFN ,<+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 \ + 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 +