MUDDLE/muddle.old

   1 ;CONVENTIONS USED IN ALL  INTERNAL MUDDLE PROGRAMS
   2
   3 ;FOR EFFICIENCY THE STANDARD MODE OF RUNNING IS UNINTERRUPTABLE
   4 ;WITH EXPLICIT CHECKS
   5 ;FOR PENDING INTERRUPTS
   6
   7
   8 ; FOR INTERRUPTS TO WORK IN INTERRUPTABLE CODE, IT MUST
   9 ;BE ABSOLUTELY PURE.
  10 ;BETWEEN ANY TWO INSTRUCTIONS OF
  11 ;INTERRUPTABLE CODE THERE MAY
  12 ;BE AN INTERUPT IN WHICH
  13 ;A COMPACTING GARBAGE COLLECTION IS CALLED
  14 ;AND THEN THE PROCESS WHICH WAS RUNNING IS
  15 ;PASSIVATED AND ANOTHER RESUMED.
  16
  17 ; ALL ATOM HEADERS WILL BE REFERRED TO IN ASSEMBLED CODE BY
  18 ; MQUOTE <PNAME>
  19 ; FUNCTION CALLS TO INITIAL FUNCTIONS WILL BE CALLED USING THE FOLLOWING:
  20
  21 ;       MCALL N,<PNAME> ;SEE MCALL MACRO
  22
  23 ; UNLESS PNAME IS NOT A VALID MIDAS SYMBOL, IN WHICH CASE FUNINESS
  24
  25
  26
  27 \f; ORGANIZATION OF CORE STORAGE IN THE MUDDLE SYSTEM (ENVIRONMENT)
  28
  29 ;     20:       SPECIAL CODE FOR UUO AND INTERUPTS
  30
  31 ;CODBOT:        WORD CONTAINING LOCATION OFBOTTOMMOST WORD OF CODE
  32
  33 ;               --CODE--
  34
  35 ;CODTOP:        WORD CONTAINING LOCATION OFWORD AFTER LAST WORD OF CODE
  36
  37 ;PARBOT:        WORD CONTAINING LOCATION OFBOTTOMMOST LIST
  38
  39 ;               --PAIRSS--
  40
  41 ;PARTOP:        WORD CONTAINING LOCATION OFWORD AFTER LAST PAIR WORD
  42
  43 ;VECBOT:        WORD CONTAINING LOCATION OFFIRST WORD OF VECTORS
  44
  45 ;               --VECTORS--
  46
  47 ;VECTOP:        WORD CONTAINING LOCATION OFWORD AFTER TOPMOST VECTOR
  48 ;               THE WORD BEFORE VECTOP IS THE DOPE FOR THE LAST VECTOR
  49
  50
  51 \f;BASIC DATA TYPES PRE-DEFINED IN MUDDLE
  52
  53 ; PRIMITIVE DATA TYPES
  54 ; IF T IS A DATA TYPE THEN $T=[T,,0]
  55
  56 ; DATA TYPES ARE ASSIGNED BY THE TYPMAK MACRO IN SOME ARBITRARY ORDER
  57
  58
  59 ;TLOSE          ;ILLEGAL TYPE (USED PRIMARILY FOR ERRORS)
  60 ;TFIX           ;FIXED POINT
  61 ;TFLOT          ;FLOATING POINT
  62 ;TCHRS          ;WORD OF UP TO 5 ASCII CHARACTERS
  63 ;TLIST          ;LIST ELEMENT
  64 ;TVEC           ;VECTOR  (AOBJN POINTER TO GENERALIZED VECTOR)
  65 ;TAP            ;SAVED AP
  66 ;TAB            ;SAVED AB (CANT APPEAR IN LISTS)
  67 ;TTP            ;SAVED TP
  68 ;TTB            ;SAVED TP
  69 ;TATOM          ;ATOM WHICH IS REALLY A SPECIAL TYPE OF VECTOR BUT MAY CHANGE
  70 ;TEXPR          ;FUNCTIONS CORRESPONDING TO THE STANDARD LISP FUNCTIONS
  71 ;TSUBR          ;MACHINE LANGUAGE 'EXPR'
  72 ;TFSUBR         ;MACHINE LANGUAGE PROGRAM (TAKES LIST AS ARG)
  73 ;TENTRY         ;RETURN ADDRESS FROM MCALL MACRO
  74 ;TPDL           ;SAVE "P"
  75 ;TUNBOU         ;UNBOUND VALUE
  76 ;TLOCI          ;IDENTIFIER LOCATIVE
  77 ;TFUNARG        ;FUNCTIONAL ARGUMENT
  78 ;TTIME          ;SPECIAL TIME POINTER-NOT MARKED (USER CAN'T SEE OR CHANGE)
  79 ;TSKIP          ;SKIP WORD ON SPECIAL PDL
  80 ;TCHVEC         ;VECTOR OF UNIFORM CHARACTERS NOT MARKED
  81 ;TCHSTR         ;GENERAL VECTOR OF CHARACTERS
  82 ;TTVP           ;SAVE TRANSFER VEVTOR POINTER
  83 ;TPVP           ;SAVED PROCESS VECTOR POINTER
  84 ;TCHAN          ;CHANNEL VECTOR (SEE FOPEN FOR FULL DOCUMENTATION)
  85 ;TENV           ;ENVIRONMENT POINTER
  86 ;TOBL           ;OBLIST TYPE
  87 ;TLMNT          ;ELEMENT CALL
  88 ;TSEG           ;SEGMENT CALL
  89
  90 ;STORAGE ALLOCATION TYPES SAT (ALLOCATED VALUES BY AN IRP)
  91
  92 ;1WORD          ;UNMARKED ONE WORD ENTITIES
  93 ;2WORD          ;LIST STRUCTURE GOODIES
  94 ;2NWORD         ;VECTOR STRUCTURE GOODIES
  95 ;STACK          ;PUSH DOWN STACKS
  96 ;BASE           ;ONE MEMBER, NAMELY AB
  97 \f; FORMAT OF LIST ELEMENT
  98
  99 ;       WORD 1: SIGN BIT, RESERVED FOR GARBAGE COLLECTOR
 100 ;                BITS 1-17 TYPE OF FIRST ELEMENT OF LIST
 101 ;                BITS 18-35 POINTS TO REST OF LIST (ALWAYS ANOTHER LIST OR 0)
 102 ;
 103 ;       WORD 2: DATUM OF FIRST ELEMENT OF LIST OF TYPE SPECIFIED
 104
 105
 106
 107 ;FORMAT OF GENERAL VECTOR (OF N ELEMENTS)
 108 ;POINTED INTO BY AOBJN POINTER
 109 ;A GENERAL VECTOR HAS FEWER THAN 2^16 ELEMENTS
 110
 111
 112 ;       TYPE<1> TYPE OF FIRST OBJECT (THE RIGHT HALF OF THE TYPE WORD MIGHT BE NONZERO)
 113 ;       OBJ<1>  OBJECT OF SPECIFIED TYPE
 114 ;       TYPE<2>
 115 ;       OBJ<2>
 116 ;       .
 117 ;       .
 118 ;       .
 119 ;       TYPE<N>
 120 ;       OBJ<N>
 121 ;       VD-VECTOR DOPE--SIGN-G.C.; BITS 1-17 ARE 2*N+1,,18-35 G.C. RELOCATION EITHER UP OR DOWN
 122
 123
 124 \f;SPECIAL VECTORS IN THE INITIAL SYSTEM
 125
 126 ;THE SYSTEM KEEPS RELEVANT INFORMATION CONCERNING ALL TYPES
 127 ;IN A TYPE VECTOR, TYPVEC, WHICH MAY BE INDEXED BY THE TYPE NUMBER
 128 ;FOUND IN THE TYPE FIELD OF ANY GOODIE.
 129
 130 ;THE INFORMATION MAY BE ACCESSED WITH FUNCTIONS "SAT" AND "TYPE"
 131
 132
 133 ;TYPE TO NAME OF TYPE TRANSLATION TABLE
 134
 135 ;       TATOM,,<STORAGE ALLOCATION TYPE>
 136 ;       ATOMIC NAME
 137
 138 ;AN ATOM IS A VECTOR WITH 3 ELEMENTS AS FOLLOWS
 139
 140 ;       TYPE OF VALUE   TYPES ARE FULL WORD QUANTITIES
 141 ;       VALUE
 142 ;       TLIST,,<PROCESS I.D.>
 143 ;       PLIST (PROPERTY LIST)
 144 ;       TVEC (OR TCHRS IF LESS THAN 6 CHARS)
 145 ;       PNAME (VECTOR OF ELEMENTS OF TYPE TCHRS)
 146 ;       7,,0    (SIGN BIT FOR G.C. RH FOR G.C. RELOCATION)
 147
 148 ;WARNING  THE FORMAT OF ATOMS WILL CHANGE
 149 ;USE THE INTERNAL FUNCTIONS IVCELL,IGVALU,ILVALU,IPNAME,IPLIST
 150 ;AND THE EXTERNALS VCELL,GVALUE,LVALUE,PNAME,PLIST
 151
 152 ;POINTERS TO INITIAL STRUCTURES AND ATOMS NEEDED BY COMPILED CODE
 153 ;WILL BE POINTED TO BY THE TRANSFER VECTOR
 154 ;A POINTER TO THIS VECTOR ALWAYS EXISTS IN AC TVP
 155 ;THE FORMAT OF THIS VECTOR IS:
 156
 157 ;       TYPE,,0
 158 ;       VALUE
 159 ;       .
 160 ;       .
 161 ;       .
 162 ;       TV DOPE WORD
 163
 164
 165 ;INFORMATION CONCERNING EACH PROCESS IS KEPT IN THE PROCESS VECTOR
 166 ;A POINTER TO THE CURRENT PROCESS ALWAYS EXISTS IN AC PVP
 167 ;THE FORMAT OF A PROCESS VECTOR IS:
 168
 169 ;       TFIX,,0
 170 ;       PROCID  ;UNIQUE ID OF THIS PROCESS
 171
 172 ;       20 ELEMENTS (I.E. 40 WORDS) CONTAINIG SAVED ACS
 173 ;       CAN BE REFERENCED SYMBOLICALLY USING SYMBOLS
 174 ;       OF THE FORM AC!STO(PVP)
 175
 176 ;       TTP,,0
 177 ;       <TP AT LAST ERROR CALL> ;CAN BE REFERENCED SYMBOLICALLY AS LERR(PVP)
 178
 179 ;       TTB,,0
 180 ;       <LAST PROG>     ;LPROG(PVP)
 181 ;       .
 182 ;       .
 183 ;       .
 184 ;       PV DOPE WORD
 185
 186
 187
 188
 189 ;FORMAT OF PUSH DOWN STACKS USED AND CONVENTIONS
 190
 191 ;SPECIAL PDL (SP)
 192
 193 ;       .
 194 ;       .
 195 ;       .
 196 ;       TYPE OF VALUE
 197 ;       OLD CONTENTS OF VALUE CELL
 198 ;       $TATOM
 199 ;       LOCATION OF VALUE CELL
 200 ;       .
 201 ;       .
 202 ;       VD (FOR PDL)
 203
 204
 205
 206
 207
 208 ;THE FORMAT FOR TP (TEMPORARY PDL MARKED) AND AP (ARGUMENT PDL) ARE NOW THE SAME
 209 ;EVENTUALLY THIS MAY
 210 ;CHANGE BY BLOCKING THE AP WITH
 211 ;VECTOR DESCRIPTORS AT THE HEAD OF EACH BLOCK
 212
 213
 214
 215
 216 ;       .
 217 ;       .
 218 ;       .
 219 ;       TYPE
 220 ;       GOODIE
 221 ;       .
 222 ;       .
 223 ;       VD (VECTOR DOPE FOR THE VECTOR  WHICH IS PDL)
 224
 225
 226
 227 \fIF1 [
 228 PRINTC /MUDDLE - INSERT FILE FOR ALL PROGRAMS
 229 /
 230 ]
 231
 232 IF2 [PRINTC /MUDDLE
 233 /
 234 ]
 235 ;AC ASSIGNMNETS
 236
 237 P"=17   ;THE UNMARKED PDL POINTER (USED BY THE OUTSIDE WORLD AND MUDDLE)
 238 SP"=15  ;SPECIAL PDL (USED BY MUDDLE FOR VARIABLE BINDINGS) (NOT USED NOW)
 239 TP"=14  ;MARKED PDL (USED BY MUDDLE FOR ARGS TO FUNCTIONS
 240         ;AND MARKED TEMPORARIES)
 241 TB"=13  ;MARKED PDL BASE POINTER
 242 R"=12   ;RELOCATION INDEX FOR LOCATION INSENSITIVE SUBRS
 243 AB"=11  ;ARGUMENT PDL BASE (MARKED)
 244         ;AB IS AN AOBJN POINTER TO THE ARGUMENTS
 245 PP"=10  ;PLANNER PDL (MAY NOT BE IN DYNAMIC MODELLING)
 246 TVP"=7  ;TRANSFER VECTOR POINTER
 247 PVP"=6  ;PROCESS VECTOR POINTER
 248
 249 ;THE FOLLOWING ACS ARE 'SCRATCH' FOR MUDDLE
 250
 251 A"=1
 252 B"=2
 253 C"=3
 254 D"=4
 255 E"=5
 256
 257 NIL"=0  ;END OF LIST MARKER
 258
 259 ;MACRO TO DEFINE MAIN IF NOT DEFINED
 260
 261 DEFINE DEFMAI ARG,\D
 262         D==.TYPE ARG
 263         IFE <D-17>,ARG==0
 264         EXPUNGE D
 265         TERMIN
 266
 267 DEFMAI MAIN
 268 DEFMAI READER
 269
 270 EXPUNGE DEFMAI
 271
 272 ; DEFINE SYMBLOS FOR VARIOUS OBLISTS
 273
 274 SYSTEM==0       ;MAIN SYSTEM OBLIST
 275 ERRORS==1       ;ERROR COMMENT OBLIST
 276 INTRUP==2       ;INERRUPT OBLIST
 277
 278 RMT [EXPUNGE SYSTEM,ERRORS,INTRUP
 279 ]
 280 \f;DEFINE TYPES AND $TYPES AND IF MAIN NOT 0, MAKE THE $TYPE WORDS
 281
 282 NUMPRI==-1      ;NUMBER OF PRIMITIVE TYPES
 283
 284
 285 DEFINE TYPMAK  SAT,LIST
 286 IRP A,,[LIST]
 287 NUMPRI==NUMPRI+1
 288 IRP B,C,[A]
 289 T!B==NUMPRI
 290 .GLOBAL $!T!B
 291 IFN MAIN,[$!T!B=[T!B,,0]
 292 ]
 293 .ISTOP
 294 TERMIN
 295 IFN MAIN,[
 296 RMT [ADDTYP [A]SAT
 297 ]]
 298 TERMIN
 299 IFE MAIN,[RMT [EXPUN [LIST]
 300 ]
 301 ]
 302 TERMIN
 303
 304 ;MACRO TO ADD STUFF TO TYPE VECTOR
 305
 306 IFN MAIN,[
 307 DEFINE ADDTYP TYPE,SAT,\LOCN
 308         IRP TYP,NAME,[TYPE]
 309         TFIX,,SAT
 310         IFSN [NAME],[IFSE [NAME]IN,MQUOTE INTERNAL
 311                 IFSN [NAME]IN,MQUOTE [NAME]
 312                 ]
 313         IFSE [NAME],MQUOTE TYP
 314         .ISTOP
 315         TERMIN
 316         TERMIN
 317 ]
 318
 319 ;DEFINE THE STORAGE ALLOCATION TYPES IN THE WORLD
 320
 321
 322 NUMSAT==0
 323 GENERAL==400000,,0      ;FLAG FOR BEING A GENERAL VECTOR
 324
 325 IRP A,,[1WORD,2WORD,2DEFRD,NWORD,2NWORD,TPSTK,PSTK,ARGS
 326 ABASE,TBASE,FRAME,BYTE,ATOM,LOCID,PVP,CHSTR,ASOC,INFO]
 327 NUMSAT==NUMSAT+1
 328 S!A==NUMSAT
 329 TERMIN
 330
 331
 332 ;MACRO FOR SAVING STUFF TO DO LATER
 333
 334 .GSSET 4
 335
 336 DEFINE HERE G00002,G00003
 337 G00002!G00003!TERMIN
 338
 339 DEFINE RMT A
 340 HERE [DEFINE HERE G00002,G00003
 341 G00002!][A!G00003!TERMIN]
 342 TERMIN
 343
 344
 345 \f;BUILD THE TYPE CODES AND ADD STUFF TO TYPVEC AND DEFINE $!TYPE)
 346
 347 IFN MAIN,[RMT [SAVE==.
 348         LOC TYPVLC
 349         ]
 350         ]
 351
 352 TYPMAK S1WORD,[LOSE,FIX,FLOAT,[CHRS,CHARACTER],[ENTRY,IN],SUBR,FSUBR,UNBOUND,[BIND,IN],ILLEGAL]
 353 TYPMAK S1WORD,[TIME]
 354 TYPMAK S2WORD,[LIST,FORM,[SEG,SEGMENT],[EXPR,FUNCTION],[FUNARG,CLOSURE],LOCL,FALSE]
 355 TYPMAK S2DEFRD,[[DEFER,IN]]
 356 TYPMAK SNWORD,[[UVEC,UVECTOR],[OBLS,OBLIST]]
 357 TYPMAK S2NWORD,[[VEC,VECTOR],[CHAN,CHANNEL],LOCV,[TVP,IN],[BVL,IN],TAG]
 358 TYPMAK SPVP,[[PVP,IN]]
 359 TYPMAK STPSTK,[[LOCI,IN],[TP,IN],[SP,IN],[LOCS,IN],[PP,IN]]
 360 TYPMAK SPSTK,[[PDL,IN]]
 361 TYPMAK SARGS,[[ARGS,ARGUMENTS]]
 362 TYPMAK SABASE,[[AB,IN]]
 363 TYPMAK STBASE,[[TB,IN]]
 364 TYPMAK SFRAME,[FRAME]
 365 TYPMAK SCHSTR,[[CHSTR,STRING]]
 366 TYPMAK SATOM,[ATOM]
 367 TYPMAK SLOCID,[LOCD]
 368 TYPMAK SBYTE,[BYTE]
 369 TYPMAK SFRAME,[[ENV,ENVIRONMENT],[ACT,ACTIVATION]]
 370 TYPMAK S2WORD,[[PIC,PICTURE],[MOVTO,MOVE-TO],[MOVREL,MOVE-REL],[DRWTO,DRAW-TO],[DRWREL,DRAW-REL],TEXT]
 371 TYPMAK SASOC,[ASOC]
 372 TYPMAK SNWORD,[LOCU]
 373 TYPMAK SCHSTR,[LOCC]
 374 TYPMAK SARGS,[LOCA]
 375 TYPMAK S1WORD,[[ENTS,IN],[TBS,IN],[PDLS,IN],[PC,IN]]
 376 TYPMAK SINFO,[[INFO,IN]]
 377 TYPMAK SATOM,[[BNDS,IN]]
 378 TYPMAK S2NWORD,[[BVLS,IN]]
 379
 380 IFN MAIN,[RMT [LOC SAVE
 381         ]
 382         ]
 383 EXPUNGE TYPMAK
 384
 385 RMT [EQUALS XP EXPUNGE
 386 ]
 387
 388 DEFINE EXPUN LIST
 389         IRP A,,[LIST]
 390         IRP B,,[A]
 391         EXPUNGE T!B
 392         .ISTOP
 393         TERMIN
 394         TERMIN
 395         TERMIN
 396
 397
 398 DEFINE GETYP AC,ADR
 399         LDB AC,[221500,,ADR]
 400         TERMIN
 401
 402 DEFINE GETYPF AC,ADR
 403         LDB AC,[003700,,ADR]
 404         TERMIN
 405 \f
 406
 407 ;DEFINE ENTRIES IN PROCESS VECTOR AS BEING GLOBAL
 408
 409 IRP A,,[0,A,B,C,D,E,PVP,TVP,TP,TB,AP,AB,P,PB,SP,PP]
 410 .GLOBAL A!STO
 411 TERMIN
 412
 413 ;MUDDLE WIDE GLOBALS
 414
 415
 416 .GLOBAL FOPEN,VECTOR,EVECTOR,CALER1,IVAL,SPECBIND,6TOCHS,CHMAK
 417 .GLOBAL ILOOKU
 418
 419
 420 .GLOBAL PROCID,LPROG,LERR,FINIS,PARTOP,VECTOP,TVLNTH,PVLNTH,SAT
 421 .GLOBAL CODTOP
 422
 423 .GLOBAL SAVCAL,RESCAL,SAVCN,RESCN,LCKINT,SAVEUP,WNA,NOTATOM,INTFLG,TYPVEC
 424
 425 ;PRINTER GLOBALS NEEDED (WILL GO WHEN CHANNLES USED)
 426
 427 .GLOBAL POSIT,CHRLIN
 428
 429 ;GLOBALS ASSOCIATED WITH CHANNELS (SEE 'FOPEN >' FOR DETAILS)
 430
 431 .GLOBAL CHANNO,DIRECT,DEVICE,NAME1,NAME2,SNAME,RNAME1,RNAME2,STATUS,IOINS,LINLN
 432 .GLOBAL CHRPOS,PAGLN,LINPOS,UNAME,FDIR,CALER1,ROOT,TTICHN,TTOCHN
 433
 434
 435 ;GLOBALS FOR MACROS IN VECTOR AND PAIR SPACE
 436
 437 .GLOBAL VECLOC,PARLOC,TVBASE,TVLOC,PVLOC,PVBASE
 438 .GLOBAL PARTOP,VECTOP,TVLNTH,PVLNTH
 439
 440
 441 ;STORAGE ALLOCATIN SPECIFICATION GLOBALS
 442
 443 PROLOC=10       ;NUMBER OF INITIAL LOCALS PER PROCESS
 444 PPLNT==150.             ;PLANNER PDL LENGTH
 445 TPLNT"=1500.    ;TEMP PDL LENGTHH
 446 GSPLNT==2000    ;INITIAL GLOBAL SP
 447 SPLNT"=300.     ;SPECIAL LENGTH
 448 GCPLNT"=1000.   ;GARBAGE COLLECTOR'S PDL LENGTH
 449 PVLNT"=100      ;LENGTH OF INITIAL PROCESS VECTOR
 450 TVLNT"==2000    ;MAX TRANSFER VECTOR
 451 IAPLNT"=100     ;AP FOR GC
 452 ITPLNT"=100     ;TP FOR GC
 453 PLNT"=300.      ;PDL FOR USER PROCESS
 454
 455 ;LOCATIONS OF VARIOUS STORAGE AREAS
 456
 457
 458
 459 PARBASE"=26000  ;START OF PAIR SPACE
 460 VECBASE"=40000  ;START OF VECTOR SPACE
 461 IFN MAIN,[PARLOC"=PARBASE
 462 VECLOC"=VECBASE
 463 ]
 464 \f
 465 ;INITIAL MACROS
 466
 467
 468
 469 ;STANDARD SUBROUTINE CALL TO F WITH N ARGUMENTS
 470 ;VALUE COMES BACK IN B WITH TYPE IN A
 471 ;IN ORDER TO BE ABLE TO BUM CALLS IN THE FUTURE, ALL CALLS SHOULD BE
 472 ;COMMENTED AS TO WHICH STACK POINTERS THEY ASSUME ARE SAVED.
 473
 474 ;SYMBLOS ASSOCIATED WITH STACK FRAMES
 475 FRAMLN==10      ;LENGTH OF A FRAME
 476 FSAV==-8        ;POINT TO CALLED FUNCTION
 477 OTBSAV==-7      ;POINT TO PREVIOUS FRAME AND CONTAINS TIME
 478 ABSAV==-6       ;ARGUMENT POINTER
 479 SPSAV==-5       ;BINDING POINTER
 480 PSAV==-4        ;SAVED P-STACK
 481 TPSAV==-3       ;TOP OF STACK POINTER
 482 PPSAV==-2       ;SAVED PLANNER PDL
 483 PCSAV==-1       ;PCWORD
 484
 485 RMT [EXPUNGE FRAMLN
 486 ]
 487 IFE MAIN,[RMT [EXPUNGE PCSAV TPSAV SPSAV PSAV ABSAV FSAV TBSAV
 488 ]
 489 ]
 490
 491 ;STANDARD SUBROUTINE RETURN
 492 ;       JRST FINIS"
 493 ;CALL MACRO
 494
 495 .GLOBAL .MCALL,.ACALL,FINIS,CONTIN
 496
 497 DEFINE MCALL N,F
 498         .GLOBAL F
 499         IFGE <17-N>,.MCALL N,F
 500         IFL <17-N>,[PRINTC /LOSSAGE AT MCALL - TOO MANY ARGS
 501 /
 502         .MCALL F
 503         ]
 504         TERMIN
 505
 506 DEFINE ACALL N,F
 507         .GLOBAL F
 508         .ACALL N,F
 509         TERMIN
 510
 511 .GLOBAL TBINIT
 512
 513
 514
 515
 516
 517
 518 ;INTERRUPT IF THERE IS A WAITING INTERRUPT
 519
 520 DEFINE INTGO
 521         SKIPGE INTFLG
 522         JSR LCKINT
 523 TERMIN
 524
 525
 526 ;CHECK THAT THE ENTRY POINT WAS CALLED WITH N ARGUMENTS
 527 ;AND SEE IF THERE ARE PENDING INTERRUPTS
 528 ;THEN PROBABLY WANT TO SAVE TB WITH GENTEM (BELOW)
 529
 530 DEFINE ENTRY N
 531         IFSN N,,[
 532                 HLRZ A,AB
 533                 CAIE A,-2*N
 534                 JRST WNA]
 535 TERMIN
 536
 537
 538 ;TO BECOME INTERRUPTABLE
 539
 540 DEFINE ENABLE
 541         AOSN INTFLG
 542         JSR LCKINT
 543 TERMIN
 544
 545
 546 ;TO BECOME UNITERRUPTABLE
 547
 548 DEFINE DISABLE
 549         SETZM INTFLG
 550 TERMIN
 551 \f;MACRO TO BUILD TYPE DISPATCH TABLES EASILY
 552
 553 DEFINE TBLDIS NAME,DEFAULT,LIST,LNTH
 554
 555 NAME:
 556         REPEAT LNTH+1,DEFAULT
 557         IRP A,,[LIST]
 558                 IRP TYPE,LOCN,[A]
 559                 LOC NAME+TYPE
 560                 LOCN
 561                 .ISTOP
 562                 TERMIN
 563         TERMIN
 564         LOC NAME+LNTH+1
 565 TERMIN
 566
 567 ; DISPATCH FOR NUMPRI GOODIES
 568
 569 DEFINE DISTBL NAME,DEFAULT,LIST
 570         TBLDIS NAME,DEFAULT,[LIST]NUMPRI
 571         TERMIN
 572
 573 DEFINE DISTBS NAME,DEFAULT,LIST
 574         TBLDIS NAME,DEFAULT,[LIST]NUMSAT
 575         TERMIN
 576
 577 \f
 578
 579 VECFLG==0
 580 PARFLG==0
 581
 582 ;MACROS FOR INITIIAL MUDDLE LIST STRUCTURE
 583
 584 ;CHAR STRING MAKER, RETURNS POINTER AND TYPE
 585
 586 DEFINE MACHAR NAME,TYPE,VAL,\LNT,WHERE,LAST
 587                 TYPE==TCHSTR
 588                 VECTGO WHERE
 589                 ASCII \NAME!\
 590                 LAST==$."
 591                 TCHRS,,0
 592                 $."-WHERE+1,,0
 593                 VAL==-<LAST-WHERE>,,WHERE
 594                 VECRET
 595
 596 TERMIN
 597 ;MACRO TO DEFINE ATOMS
 598
 599 DEFINE MAKAT NAME,TYAT,VALU,OBLIS,REFER,LOCN,\TVENT,FIRST
 600         FIRST==.
 601         TYAT,,OBLIS
 602         VALU
 603         ASCII \NAME!\
 604         400000+SATOM,,0
 605         .-FIRST+1,,0
 606         TVENT==FIRST-.+2,,FIRST
 607         IFSN [LOCN],LOCN==TVENT
 608         ADDTV TATOM,TVENT,REFER
 609         TERMIN
 610
 611
 612
 613 \f;MACROS TO SWITCH BACK AND FORTH INTO AND OUT OF VECTOR AND PAIR SPACE
 614 ;GENERAL SWITCHER
 615
 616 DEFINE LOCSET LOCN,RETNAM,NEWLOC,OTHLOC,F1,F2,TOPWRD,\SAVE,SAVEF1,SAVEF2,NEW
 617
 618         IFE F1,[SAVE==.
 619                 LOC NEWLOC
 620                 SAVEF2==F2
 621                 IFN F2,OTHLOC==SAVE
 622                 F2==0
 623                 DEFINE RETNAM
 624                         F1==F1-1
 625                         IFE F1,[NEWLOC==.
 626                         F2==SAVEF2
 627                         LOC TOPWRD
 628                         NEWLOC
 629                         LOC SAVE
 630                         ]
 631                         TERMIN
 632                 ]
 633
 634         IFN F1,[F1==F1+1
 635                 ]
 636
 637         IFSN LOCN,,LOCN==.
 638         IFE F1,F1==1
 639
 640 TERMIN
 641
 642
 643 DEFINE VECTGO LOCN
 644         LOCSET LOCN,VECRET,VECLOC,PARLOC,VECFLG,PARFLG,VECTOP
 645         TERMIN
 646
 647 DEFINE PARGO LOCN
 648         LOCSET LOCN,PARRET,PARLOC,VECLOC,PARFLG,VECFLG,PARTOP
 649         TERMIN
 650
 651 DEFINE ADDTV TYPE,GOODIE,REFER,\SAVE
 652         SAVE==.
 653         LOC TVLOC
 654         TVOFF==.-TVBASE+1
 655         TYPE,,REFER
 656         GOODIE
 657         TVLOC==.
 658         LOC SAVE
 659         TERMIN
 660
 661 ;MACRO TO ADD TO PROCESS VECTOR
 662
 663 DEFINE ADDPV TYPE,GOODIE,OFFS,\SAVE
 664         SAVE==.
 665         LOC PVLOC
 666         PVOFF==.-PVBASE
 667         IFSN OFFS,,OFFS==PVOFF
 668         TYPE,,0
 669         GOODIE
 670         PVLOC==.
 671         LOC SAVE
 672         TERMIN
 673
 674
 675
 676
 677 \f;MACRO TO DEFINE A FUNCTION ATOM
 678
 679 DEFINE MFUNCTION NAME,TYPE,PNAME
 680         (TVP)
 681 NAME":
 682         VECTGO DUMMY1
 683         IFSE [PNAME],MAKAT NAME,T!TYPE,NAME,SYSTEM,<NAME-1>
 684         IFSN [PNAME],MAKAT [PNAME]T!TYPE,NAME,SYSTEM,<NAME-1>
 685         VECRET
 686         TERMIN
 687
 688 ;MACRO TO DEFINE QUOTED GOODIE
 689
 690 DEFINE MQUOTE ARG,PNAME,OBLIS,\LOCN
 691         (TVP)
 692
 693         LOCN==.-1
 694         VECTGO DUMMY1
 695         IFSE [PNAME],MAKAT [ARG]TUNBOU,0,OBLIS,LOCN
 696         IFSN [PNAME],MAKAT [PNAME]TUNBOU,0,OBLIS,LOCN
 697         VECRET
 698         TERMIN
 699
 700
 701
 702
 703 DEFINE CHQUOTE NAME,\LOCN,TYP,VAL
 704         (TVP)
 705         LOCN==.-1
 706         MACHAR [NAME]TYP,VAL
 707         ADDTV TYP,VAL,LOCN
 708
 709         TERMIN
 710
 711 \f
 712 CHRWD==5
 713
 714 IFN READER,[
 715 NCHARS==177
 716 ;CHARACTER TABLE GENERATING MACROS
 717
 718 DEFINE SETSYM WRDL,BYTL,COD
 719         WRD!WRDL==<WRD!WRDL>&<MSK!BYTL>
 720         WRD!WRDL==<WRD!WRDL>\<<COD&177>_<<4-BYTL>*7+1>>
 721         TERMIN
 722
 723 DEFINE INIWRD N,INIT
 724         WRD!N==INIT
 725         TERMIN
 726
 727 DEFINE OUTWRD N
 728         WRD!N
 729         TERMIN
 730
 731 ;MACRO TO KILL THESE SYMBOLS LATER
 732
 733 DEFINE KILLWD N
 734         EXPUNGE WRD!N
 735         TERMIN
 736 DEFINE SETMSK N
 737         MSK!N=<177_<<4-N>*7+1>>#<-1>
 738         TERMIN
 739
 740 ;MACRO TO KILL MASKS LATER
 741
 742 DEFINE KILMSK N
 743         EXPUNGE MSK!N
 744         TERMIN
 745
 746 NWRDS==<NCHARS+CHRWD-1>/CHRWD
 747
 748 REPEAT CHRWD,SETMSK \.RPCNT
 749
 750 REPEAT NWRDS,INIWRD \.RPCNT,004020100402
 751
 752 DEFINE OUTTBL
 753         REPEAT NWRDS,OUTWRD \.RPCNT
 754         TERMIN
 755
 756
 757 ;MACRO TO GENERATE THE DUMMIES EASLILIER
 758
 759 DEFINE INITCH \DUM1,DUM2,DUM3
 760
 761
 762 DEFINE SETCOD  COD,LIST
 763         IRP CHAR,,[LIST]
 764         DUM1==CHAR/5
 765         DUM2==CHAR-DUM1*5
 766         SETSYM \DUM1,\DUM2,COD
 767         TERMIN
 768         TERMIN
 769
 770 DEFINE SETCHR COD,LIST
 771         IRPC CHAR,,[LIST]
 772         DUM3=="CHAR
 773         DUM1==DUM3/5
 774         DUM2==DUM3-DUM1*5
 775         SETSYM \DUM1,\DUM2,COD
 776         TERMIN
 777         TERMIN
 778
 779 DEFINE INCRCO OCOD,LIST
 780         IRP CHAR,,[LIST]
 781         DUM1==CHAR/5
 782         DUM2==CHAR-DUM1*5
 783         SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>
 784         TERMIN
 785         TERMIN
 786
 787 DEFINE INCRCH OCOD,LIST
 788         IRPC CHAR,,[LIST]
 789         DUM3=="CHAR
 790         DUM1==DUM3/5
 791         DUM2==DUM3-DUM1*5
 792         SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>
 793         TERMIN
 794         TERMIN
 795         RMT [EXPUNGE DUM1,DUM2,DUM3
 796         REPEAT NWRDS,KILLWD \.RPCNT
 797         REPEAT CHRWD,KILMSK \.RPCNT
 798 ]
 799
 800 TERMIN
 801
 802 INITCH
 803 ]
 804 \f
 805 ;REDEFINE END DO ALL THE REMOTES (ON LAST PASS ONLY)
 806
 807 EQUALS E.END END
 808
 809 DEFINE END ARG
 810         EQUALS END E.END
 811         CONSTANTS
 812         VARIABLES
 813         HERE
 814         .LNKOT
 815         IFP GEXPUN
 816         CONSTANTS
 817         VARIABLES
 818         CODEND==.
 819         LOC CODTOP
 820         CODEND
 821         LOC CODEND
 822         END ARG
 823         TERMIN
 824
 825
 826 ;MACROS TO PRINT VERSIONS OF PROGRAMS DURING ASSEMBLY
 827
 828 DEFINE NUMGEN SYM,\REST,N
 829         NN==NN-1
 830         N==<SYM_-30.>&77
 831         REST==<SYM_6>
 832         IFN N,IFGE <31-N>,IFGE <N-20>,TOTAL==TOTAL*10.+<N-20>
 833         IFN NN,NUMGEN REST
 834         EXPUNGE N,REST
 835         TERMIN
 836
 837 DEFINE VERSIO N
 838         PRINTC /VERSION = N
 839 /
 840         TERMIN
 841
 842 TOTAL==0
 843 NN==7
 844
 845 NUMGEN .FNAM2
 846
 847 IF1 [
 848 RADIX 10.
 849
 850 VERSIO \TOTAL
 851
 852 RADIX 8
 853 PROGVN==TOTAL
 854
 855
 856 ]
 857
 858 DEFINE VATOM SYM,\LOCN,TV,A,B
 859         VECTGO
 860         LOCN==.
 861         TFIX,,ERRORS
 862         PROGVN
 863         A==<<<<SYM_-30.>&77>+40>_29.>
 864         B==<<SYM_-24.>&77>
 865         IFN B,A==A+<<B+40>_22.>
 866         B==<<SYM_-18.>&77>
 867         IFN B,A==A+<<B+40>_15.>
 868         B==<<SYM_-12.>&77>
 869         IFN B,A==A+<<B+40>_8.>
 870         B==<<SYM_-6.>&77>
 871         IFN B,A==A+<<B+40>_1.>
 872         A
 873         IFN <SYM&77>,<<SYM&77>+40>_29.
 874         400000+SATOM,,
 875         .-LOCN+1,,0
 876         TV==LOCN-.+2,,LOCN
 877         ADDTV TATOM,TV,0
 878         VECRET
 879         TERMIN
 880
 881 VATOM .FNAM1
 882
 883
 884 ;MACRO TO REMMVE SYMBOLS OF THE FORM "GXXXXX"
 885
 886 DEFINE GEXPUN \SYM
 887         NN==7
 888         TOTAL==0
 889         NUMGEN \<SIXBIT /SYM!/>
 890         RADIX 10.
 891         .GSSET 0
 892         REPEAT TOTAL,XXP
 893         RADIX 8
 894 TERMIN
 895
 896 DEFINE XXP \A
 897         EXPUNGE A
 898         TERMIN
 899 \f\f\f\f\ 3\f