X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=MUDDLE%2Fmuddle.196;fp=MUDDLE%2Fmuddle.196;h=f73305a84c19466538854ef3f5c50e99d2f7ef3e;hb=39c5769144e7f2a58076bdb973d2c80fa603345c;hp=0000000000000000000000000000000000000000;hpb=bab072f950a643ac109660a223b57e635492ac25;p=pdp10-muddle.git diff --git a/MUDDLE/muddle.196 b/MUDDLE/muddle.196 new file mode 100644 index 0000000..f73305a --- /dev/null +++ b/MUDDLE/muddle.196 @@ -0,0 +1,916 @@ +;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 +; FUNCTION CALLS TO INITIAL FUNCTIONS WILL BE CALLED USING THE FOLLOWING: + +; MCALL N, ;SEE MCALL MACRO + +; UNLESS PNAME IS NOT A VALID MIDAS SYMBOL, IN WHICH CASE FUNINESS + + + + ; 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 + + + ;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 + ; 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 +; OBJ +; VD-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. + +;THE INFORMATION MAY BE ACCESSED WITH FUNCTIONS "SAT" AND "TYPE" + + +;TYPE TO NAME OF TYPE TRANSLATION TABLE + +; TATOM,, +; ATOMIC NAME + +;AN ATOM IS A VECTOR WITH 3 ELEMENTS AS FOLLOWS + +; TYPE OF VALUE TYPES ARE FULL WORD QUANTITIES +; VALUE +; TLIST,, +; 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 +; ;CAN BE REFERENCED SYMBOLICALLY AS LERR(PVP) + +; TTB,,0 +; ;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) + + + + 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) +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 ,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 + + ;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 +] + ;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 + + +;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 +] + +;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 + ;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 + +DEFINE MACHAR NAME,TYPE,VAL,\LNT,WHERE,LAST + TYPE==TCHSTR + VECTGO WHERE + ASCII \NAME!\ + LAST==$." + TCHRS,,0 + $."-WHERE+1,,0 + VAL==-,,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 + + + + ;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 + + + + + ;MACRO TO DEFINE A FUNCTION ATOM + +DEFINE MFUNCTION NAME,TYPE,PNAME + (TVP) +NAME": + VECTGO DUMMY1 + IFSE [PNAME],MAKAT NAME,T!TYPE,NAME,SYSTEM, + IFSN [PNAME],MAKAT [PNAME]T!TYPE,NAME,SYSTEM, + 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 + + +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 + 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==&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,,ERRORS + PROGVN + 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 + + +;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 + ;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,[,,] + PUSH PP,A + MOVEM TP,TPSAV(TB) ;MAKE SURE TP SLOT IS CORRECT + MOVE E,TB + PUSHJ P,BCKTRE ;COPY FRAME +TERMIN  \ No newline at end of file