MUDDLE/muddle.196

   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 \f;DEFINE TYPES AND $TYPES AND IF MAIN NOT 0, MAKE THE $TYPE WORDS
 279
 280 NUMPRI==-1      ;NUMBER OF PRIMITIVE TYPES
 281
 282
 283 DEFINE TYPMAK  SAT,LIST
 284 IRP A,,[LIST]
 285 NUMPRI==NUMPRI+1
 286 IRP B,C,[A]
 287 T!B==NUMPRI
 288 .GLOBAL $!T!B
 289 IFN MAIN,[$!T!B=[T!B,,0]
 290 ]
 291 .ISTOP
 292 TERMIN
 293 IFN MAIN,[
 294 RMT [ADDTYP [A]SAT
 295 ]]
 296 TERMIN
 297 IFE MAIN,[RMT [EXPUN [LIST]
 298 ]
 299 ]
 300 TERMIN
 301
 302 ;MACRO TO ADD STUFF TO TYPE VECTOR
 303
 304 IFN MAIN,[
 305 DEFINE ADDTYP TYPE,SAT,\LOCN
 306         IRP TYP,NAME,[TYPE]
 307         TFIX,,SAT
 308         IFSN [NAME],[IFSE [NAME]IN,MQUOTE INTERNAL
 309                 IFSN [NAME]IN,MQUOTE [NAME]
 310                 ]
 311         IFSE [NAME],MQUOTE TYP
 312         .ISTOP
 313         TERMIN
 314         TERMIN
 315 ]
 316
 317 ;DEFINE THE STORAGE ALLOCATION TYPES IN THE WORLD
 318
 319
 320 NUMSAT==0
 321 GENERAL==400000,,0      ;FLAG FOR BEING A GENERAL VECTOR
 322
 323 IRP A,,[1WORD,2WORD,2DEFRD,NWORD,2NWORD,TPSTK,PSTK,ARGS
 324 ABASE,TBASE,FRAME,BYTE,ATOM,PVP,CHSTR,ASOC,INFO]
 325 NUMSAT==NUMSAT+1
 326 S!A==NUMSAT
 327 TERMIN
 328
 329
 330 ;MACRO FOR SAVING STUFF TO DO LATER
 331
 332 .GSSET 4
 333
 334 DEFINE HERE G00002,G00003
 335 G00002!G00003!TERMIN
 336
 337 DEFINE RMT A
 338 HERE [DEFINE HERE G00002,G00003
 339 G00002!][A!G00003!TERMIN]
 340 TERMIN
 341
 342
 343 RMT [EXPUNGE SYSTEM,ERRORS,INTRUP
 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 S2NWORD,[[LOCI,IN]]
 360 TYPMAK STPSTK,[[TP,IN]]
 361 TYPMAK S2NWORD,[[SP,IN]]
 362 TYPMAK STPSTK,[[LOCS,IN],[PP,IN]]
 363 TYPMAK SPSTK,[[PDL,IN]]
 364 TYPMAK SARGS,[[ARGS,ARGUMENTS]]
 365 TYPMAK SABASE,[[AB,IN]]
 366 TYPMAK STBASE,[[TB,IN]]
 367 TYPMAK SFRAME,[FRAME]
 368 TYPMAK SCHSTR,[[CHSTR,STRING]]
 369 TYPMAK SATOM,[ATOM]
 370 TYPMAK S2NWORD,[LOCD]
 371 TYPMAK SBYTE,[BYTE]
 372 TYPMAK S2NWORD,[[ENV,ENVIRONMENT]]
 373 TYPMAK SFRAME,[[ACT,ACTIVATION]]
 374 TYPMAK S2WORD,[[PIC,PICTURE],[MOVTO,MOVE-TO],[MOVREL,MOVE-REL],[DRWTO,DRAW-TO],[DRWREL,DRAW-REL],TEXT]
 375 TYPMAK SASOC,[ASOC]
 376 TYPMAK SNWORD,[LOCU]
 377 TYPMAK SCHSTR,[LOCC]
 378 TYPMAK SARGS,[LOCA]
 379 TYPMAK S1WORD,[[ENTS,IN],[TBS,IN],[PDLS,IN],[PC,IN]]
 380 TYPMAK SINFO,[[INFO,IN]]
 381 TYPMAK S2WORD,[[UNAS,UNASSIGNED],[AF,ACTORFORM],[SAF,SACTORFORM]]
 382 TYPMAK S2WORD,[ACTOR,[ACTF,ACTOR-FUNCTION]]
 383
 384
 385 IFN MAIN,[RMT [LOC SAVE
 386         ]
 387         ]
 388 EXPUNGE TYPMAK
 389
 390 RMT [EQUALS XP EXPUNGE
 391 ]
 392
 393 DEFINE EXPUN LIST
 394         IRP A,,[LIST]
 395         IRP B,,[A]
 396         EXPUNGE T!B
 397         .ISTOP
 398         TERMIN
 399         TERMIN
 400         TERMIN
 401
 402
 403 DEFINE GETYP AC,ADR
 404         LDB AC,[221500,,ADR]
 405         TERMIN
 406
 407 DEFINE GETYPF AC,ADR
 408         LDB AC,[003700,,ADR]
 409         TERMIN
 410 \f
 411
 412 ;DEFINE ENTRIES IN PROCESS VECTOR AS BEING GLOBAL
 413
 414 IRP A,,[0,A,B,C,D,E,PVP,TVP,TP,TB,AP,AB,P,PB,SP,PP]
 415 .GLOBAL A!STO
 416 TERMIN
 417
 418 ;MUDDLE WIDE GLOBALS
 419
 420
 421 .GLOBAL FOPEN,VECTOR,EVECTOR,CALER1,IVAL,SPECBIND,6TOCHS,CHMAK
 422 .GLOBAL ILOOKU
 423
 424
 425 .GLOBAL PROCID,LPROG,LERR,FINIS,PARTOP,VECTOP,TVLNTH,PVLNTH,SAT
 426 .GLOBAL CODTOP
 427
 428 .GLOBAL SAVCAL,RESCAL,SAVCN,RESCN,LCKINT,SAVEUP,WNA,NOTATOM,INTFLG,TYPVEC
 429
 430 ;PRINTER GLOBALS NEEDED (WILL GO WHEN CHANNLES USED)
 431
 432 .GLOBAL POSIT,CHRLIN
 433
 434 ;GLOBALS ASSOCIATED WITH CHANNELS (SEE 'FOPEN >' FOR DETAILS)
 435
 436 .GLOBAL CHANNO,DIRECT,DEVICE,NAME1,NAME2,SNAME,RNAME1,RNAME2,STATUS,IOINS,LINLN
 437 .GLOBAL CHRPOS,PAGLN,LINPOS,UNAME,FDIR,CALER1,ROOT,TTICHN,TTOCHN
 438
 439
 440 ;GLOBALS FOR MACROS IN VECTOR AND PAIR SPACE
 441
 442 .GLOBAL VECLOC,PARLOC,TVBASE,TVLOC,PVLOC,PVBASE
 443 .GLOBAL PARTOP,VECTOP,TVLNTH,PVLNTH
 444
 445
 446 ;STORAGE ALLOCATIN SPECIFICATION GLOBALS
 447
 448 PROLOC=10       ;NUMBER OF INITIAL LOCALS PER PROCESS
 449 PPLNT==150.             ;PLANNER PDL LENGTH
 450 TPLNT"=1500.    ;TEMP PDL LENGTHH
 451 GSPLNT==2000    ;INITIAL GLOBAL SP
 452 SPLNT"=300.     ;SPECIAL LENGTH
 453 GCPLNT"=1000.   ;GARBAGE COLLECTOR'S PDL LENGTH
 454 PVLNT"=100      ;LENGTH OF INITIAL PROCESS VECTOR
 455 TVLNT"==2000    ;MAX TRANSFER VECTOR
 456 IAPLNT"=100     ;AP FOR GC
 457 ITPLNT"=100     ;TP FOR GC
 458 PLNT"=300.      ;PDL FOR USER PROCESS
 459
 460 ;LOCATIONS OF VARIOUS STORAGE AREAS
 461
 462
 463
 464 PARBASE"=26000  ;START OF PAIR SPACE
 465 VECBASE"=40000  ;START OF VECTOR SPACE
 466 IFN MAIN,[PARLOC"=PARBASE
 467 VECLOC"=VECBASE
 468 ]
 469 \f
 470 ;INITIAL MACROS
 471
 472
 473
 474 ;STANDARD SUBROUTINE CALL TO F WITH N ARGUMENTS
 475 ;VALUE COMES BACK IN B WITH TYPE IN A
 476 ;IN ORDER TO BE ABLE TO BUM CALLS IN THE FUTURE, ALL CALLS SHOULD BE
 477 ;COMMENTED AS TO WHICH STACK POINTERS THEY ASSUME ARE SAVED.
 478
 479 ;SYMBLOS ASSOCIATED WITH STACK FRAMES
 480 FRAMLN==10      ;LENGTH OF A FRAME
 481 FSAV==-8        ;POINT TO CALLED FUNCTION
 482 OTBSAV==-7      ;POINT TO PREVIOUS FRAME AND CONTAINS TIME
 483 ABSAV==-6       ;ARGUMENT POINTER
 484 SPSAV==-5       ;BINDING POINTER
 485 PSAV==-4        ;SAVED P-STACK
 486 TPSAV==-3       ;TOP OF STACK POINTER
 487 PPSAV==-2       ;SAVED PLANNER PDL
 488 PCSAV==-1       ;PCWORD
 489
 490 RMT [EXPUNGE FRAMLN
 491 ]
 492 IFE MAIN,[RMT [EXPUNGE PCSAV TPSAV SPSAV PSAV ABSAV FSAV TBSAV
 493 ]
 494 ]
 495
 496 ;STANDARD SUBROUTINE RETURN
 497 ;       JRST FINIS"
 498 ;CALL MACRO
 499
 500 .GLOBAL .MCALL,.ACALL,FINIS,CONTIN
 501
 502 DEFINE MCALL N,F
 503         .GLOBAL F
 504         IFGE <17-N>,.MCALL N,F
 505         IFL <17-N>,[PRINTC /LOSSAGE AT MCALL - TOO MANY ARGS
 506 /
 507         .MCALL F
 508         ]
 509         TERMIN
 510
 511 DEFINE ACALL N,F
 512         .GLOBAL F
 513         .ACALL N,F
 514         TERMIN
 515
 516 .GLOBAL TBINIT
 517
 518
 519
 520
 521
 522
 523 ;INTERRUPT IF THERE IS A WAITING INTERRUPT
 524
 525 DEFINE INTGO
 526         SKIPGE INTFLG
 527         JSR LCKINT
 528 TERMIN
 529
 530
 531 ;CHECK THAT THE ENTRY POINT WAS CALLED WITH N ARGUMENTS
 532 ;AND SEE IF THERE ARE PENDING INTERRUPTS
 533 ;THEN PROBABLY WANT TO SAVE TB WITH GENTEM (BELOW)
 534
 535 DEFINE ENTRY N
 536         IFSN N,,[
 537                 HLRZ A,AB
 538                 CAIE A,-2*N
 539                 JRST WNA]
 540 TERMIN
 541
 542
 543 ;TO BECOME INTERRUPTABLE
 544
 545 DEFINE ENABLE
 546         AOSN INTFLG
 547         JSR LCKINT
 548 TERMIN
 549
 550
 551 ;TO BECOME UNITERRUPTABLE
 552
 553 DEFINE DISABLE
 554         SETZM INTFLG
 555 TERMIN
 556 \f;MACRO TO BUILD TYPE DISPATCH TABLES EASILY
 557
 558 DEFINE TBLDIS NAME,DEFAULT,LIST,LNTH
 559
 560 NAME:
 561         REPEAT LNTH+1,DEFAULT
 562         IRP A,,[LIST]
 563                 IRP TYPE,LOCN,[A]
 564                 LOC NAME+TYPE
 565                 LOCN
 566                 .ISTOP
 567                 TERMIN
 568         TERMIN
 569         LOC NAME+LNTH+1
 570 TERMIN
 571
 572 ; DISPATCH FOR NUMPRI GOODIES
 573
 574 DEFINE DISTBL NAME,DEFAULT,LIST
 575         TBLDIS NAME,DEFAULT,[LIST]NUMPRI
 576         TERMIN
 577
 578 DEFINE DISTBS NAME,DEFAULT,LIST
 579         TBLDIS NAME,DEFAULT,[LIST]NUMSAT
 580         TERMIN
 581
 582 \f
 583
 584 VECFLG==0
 585 PARFLG==0
 586
 587 ;MACROS FOR INITIIAL MUDDLE LIST STRUCTURE
 588
 589 ;CHAR STRING MAKER, RETURNS POINTER AND TYPE
 590
 591 DEFINE MACHAR NAME,TYPE,VAL,\LNT,WHERE,LAST
 592                 TYPE==TCHSTR
 593                 VECTGO WHERE
 594                 ASCII \NAME!\
 595                 LAST==$."
 596                 TCHRS,,0
 597                 $."-WHERE+1,,0
 598                 VAL==-<LAST-WHERE>,,WHERE
 599                 VECRET
 600
 601 TERMIN
 602 ;MACRO TO DEFINE ATOMS
 603
 604 DEFINE MAKAT NAME,TYAT,VALU,OBLIS,REFER,LOCN,\TVENT,FIRST
 605         FIRST==.
 606         TYAT,,OBLIS
 607         VALU
 608         ASCII \NAME!\
 609         400000+SATOM,,0
 610         .-FIRST+1,,0
 611         TVENT==FIRST-.+2,,FIRST
 612         IFSN [LOCN],LOCN==TVENT
 613         ADDTV TATOM,TVENT,REFER
 614         TERMIN
 615
 616
 617
 618 \f;MACROS TO SWITCH BACK AND FORTH INTO AND OUT OF VECTOR AND PAIR SPACE
 619 ;GENERAL SWITCHER
 620
 621 DEFINE LOCSET LOCN,RETNAM,NEWLOC,OTHLOC,F1,F2,TOPWRD,\SAVE,SAVEF1,SAVEF2,NEW
 622
 623         IFE F1,[SAVE==.
 624                 LOC NEWLOC
 625                 SAVEF2==F2
 626                 IFN F2,OTHLOC==SAVE
 627                 F2==0
 628                 DEFINE RETNAM
 629                         F1==F1-1
 630                         IFE F1,[NEWLOC==.
 631                         F2==SAVEF2
 632                         LOC TOPWRD
 633                         NEWLOC
 634                         LOC SAVE
 635                         ]
 636                         TERMIN
 637                 ]
 638
 639         IFN F1,[F1==F1+1
 640                 ]
 641
 642         IFSN LOCN,,LOCN==.
 643         IFE F1,F1==1
 644
 645 TERMIN
 646
 647
 648 DEFINE VECTGO LOCN
 649         LOCSET LOCN,VECRET,VECLOC,PARLOC,VECFLG,PARFLG,VECTOP
 650         TERMIN
 651
 652 DEFINE PARGO LOCN
 653         LOCSET LOCN,PARRET,PARLOC,VECLOC,PARFLG,VECFLG,PARTOP
 654         TERMIN
 655
 656 DEFINE ADDTV TYPE,GOODIE,REFER,\SAVE
 657         SAVE==.
 658         LOC TVLOC
 659         TVOFF==.-TVBASE+1
 660         TYPE,,REFER
 661         GOODIE
 662         TVLOC==.
 663         LOC SAVE
 664         TERMIN
 665
 666 ;MACRO TO ADD TO PROCESS VECTOR
 667
 668 DEFINE ADDPV TYPE,GOODIE,OFFS,\SAVE
 669         SAVE==.
 670         LOC PVLOC
 671         PVOFF==.-PVBASE
 672         IFSN OFFS,,OFFS==PVOFF
 673         TYPE,,0
 674         GOODIE
 675         PVLOC==.
 676         LOC SAVE
 677         TERMIN
 678
 679
 680
 681
 682 \f;MACRO TO DEFINE A FUNCTION ATOM
 683
 684 DEFINE MFUNCTION NAME,TYPE,PNAME
 685         (TVP)
 686 NAME":
 687         VECTGO DUMMY1
 688         IFSE [PNAME],MAKAT NAME,T!TYPE,NAME,SYSTEM,<NAME-1>
 689         IFSN [PNAME],MAKAT [PNAME]T!TYPE,NAME,SYSTEM,<NAME-1>
 690         VECRET
 691         TERMIN
 692
 693 ;MACRO TO DEFINE QUOTED GOODIE
 694
 695 DEFINE MQUOTE ARG,PNAME,OBLIS,\LOCN
 696         (TVP)
 697
 698         LOCN==.-1
 699         VECTGO DUMMY1
 700         IFSE [PNAME],MAKAT [ARG]TUNBOU,0,OBLIS,LOCN
 701         IFSN [PNAME],MAKAT [PNAME]TUNBOU,0,OBLIS,LOCN
 702         VECRET
 703         TERMIN
 704
 705
 706
 707
 708 DEFINE CHQUOTE NAME,\LOCN,TYP,VAL
 709         (TVP)
 710         LOCN==.-1
 711         MACHAR [NAME]TYP,VAL
 712         ADDTV TYP,VAL,LOCN
 713
 714         TERMIN
 715
 716 \f
 717 CHRWD==5
 718
 719 IFN READER,[
 720 NCHARS==177
 721 ;CHARACTER TABLE GENERATING MACROS
 722
 723 DEFINE SETSYM WRDL,BYTL,COD
 724         WRD!WRDL==<WRD!WRDL>&<MSK!BYTL>
 725         WRD!WRDL==<WRD!WRDL>\<<COD&177>_<<4-BYTL>*7+1>>
 726         TERMIN
 727
 728 DEFINE INIWRD N,INIT
 729         WRD!N==INIT
 730         TERMIN
 731
 732 DEFINE OUTWRD N
 733         WRD!N
 734         TERMIN
 735
 736 ;MACRO TO KILL THESE SYMBOLS LATER
 737
 738 DEFINE KILLWD N
 739         EXPUNGE WRD!N
 740         TERMIN
 741 DEFINE SETMSK N
 742         MSK!N=<177_<<4-N>*7+1>>#<-1>
 743         TERMIN
 744
 745 ;MACRO TO KILL MASKS LATER
 746
 747 DEFINE KILMSK N
 748         EXPUNGE MSK!N
 749         TERMIN
 750
 751 NWRDS==<NCHARS+CHRWD-1>/CHRWD
 752
 753 REPEAT CHRWD,SETMSK \.RPCNT
 754
 755 REPEAT NWRDS,INIWRD \.RPCNT,004020100402
 756
 757 DEFINE OUTTBL
 758         REPEAT NWRDS,OUTWRD \.RPCNT
 759         TERMIN
 760
 761
 762 ;MACRO TO GENERATE THE DUMMIES EASLILIER
 763
 764 DEFINE INITCH \DUM1,DUM2,DUM3
 765
 766
 767 DEFINE SETCOD  COD,LIST
 768         IRP CHAR,,[LIST]
 769         DUM1==CHAR/5
 770         DUM2==CHAR-DUM1*5
 771         SETSYM \DUM1,\DUM2,COD
 772         TERMIN
 773         TERMIN
 774
 775 DEFINE SETCHR COD,LIST
 776         IRPC CHAR,,[LIST]
 777         DUM3=="CHAR
 778         DUM1==DUM3/5
 779         DUM2==DUM3-DUM1*5
 780         SETSYM \DUM1,\DUM2,COD
 781         TERMIN
 782         TERMIN
 783
 784 DEFINE INCRCO OCOD,LIST
 785         IRP CHAR,,[LIST]
 786         DUM1==CHAR/5
 787         DUM2==CHAR-DUM1*5
 788         SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>
 789         TERMIN
 790         TERMIN
 791
 792 DEFINE INCRCH OCOD,LIST
 793         IRPC CHAR,,[LIST]
 794         DUM3=="CHAR
 795         DUM1==DUM3/5
 796         DUM2==DUM3-DUM1*5
 797         SETSYM \DUM1,\DUM2,\<OCOD+.IRPCN>
 798         TERMIN
 799         TERMIN
 800         RMT [EXPUNGE DUM1,DUM2,DUM3
 801         REPEAT NWRDS,KILLWD \.RPCNT
 802         REPEAT CHRWD,KILMSK \.RPCNT
 803 ]
 804
 805 TERMIN
 806
 807 INITCH
 808 ]
 809 \f
 810 ;REDEFINE END DO ALL THE REMOTES (ON LAST PASS ONLY)
 811
 812 EQUALS E.END END
 813
 814 DEFINE END ARG
 815         EQUALS END E.END
 816         CONSTANTS
 817         VARIABLES
 818         HERE
 819         .LNKOT
 820         IFP GEXPUN
 821         CONSTANTS
 822         VARIABLES
 823         CODEND==.
 824         LOC CODTOP
 825         CODEND
 826         LOC CODEND
 827         END ARG
 828         TERMIN
 829
 830
 831 ;MACROS TO PRINT VERSIONS OF PROGRAMS DURING ASSEMBLY
 832
 833 DEFINE NUMGEN SYM,\REST,N
 834         NN==NN-1
 835         N==<SYM_-30.>&77
 836         REST==<SYM_6>
 837         IFN N,IFGE <31-N>,IFGE <N-20>,TOTAL==TOTAL*10.+<N-20>
 838         IFN NN,NUMGEN REST
 839         EXPUNGE N,REST
 840         TERMIN
 841
 842 DEFINE VERSIO N
 843         PRINTC /VERSION = N
 844 /
 845         TERMIN
 846
 847 TOTAL==0
 848 NN==7
 849
 850 NUMGEN .FNAM2
 851
 852 IF1 [
 853 RADIX 10.
 854
 855 VERSIO \TOTAL
 856
 857 RADIX 8
 858 PROGVN==TOTAL
 859
 860
 861 ]
 862
 863 DEFINE VATOM SYM,\LOCN,TV,A,B
 864         VECTGO
 865         LOCN==.
 866         TFIX,,ERRORS
 867         PROGVN
 868         A==<<<<SYM_-30.>&77>+40>_29.>
 869         B==<<SYM_-24.>&77>
 870         IFN B,A==A+<<B+40>_22.>
 871         B==<<SYM_-18.>&77>
 872         IFN B,A==A+<<B+40>_15.>
 873         B==<<SYM_-12.>&77>
 874         IFN B,A==A+<<B+40>_8.>
 875         B==<<SYM_-6.>&77>
 876         IFN B,A==A+<<B+40>_1.>
 877         A
 878         IFN <SYM&77>,<<SYM&77>+40>_29.
 879         400000+SATOM,,
 880         .-LOCN+1,,0
 881         TV==LOCN-.+2,,LOCN
 882         ADDTV TATOM,TV,0
 883         VECRET
 884         TERMIN
 885
 886 VATOM .FNAM1
 887
 888
 889 ;MACRO TO REMMVE SYMBOLS OF THE FORM "GXXXXX"
 890
 891 DEFINE GEXPUN \SYM
 892         NN==7
 893         TOTAL==0
 894         NUMGEN \<SIXBIT /SYM!/>
 895         RADIX 10.
 896         .GSSET 0
 897         REPEAT TOTAL,XXP
 898         RADIX 8
 899 TERMIN
 900
 901 DEFINE XXP \A
 902         EXPUNGE A
 903         TERMIN
 904 \f;MACRO TO SET A FAILPOINT WITH ADDRESS PC, GIVEN N WORDS PUSHED ABOVE -1(TB)
 905
 906 DEFINE FPOINT PC,N
 907         PUSH    PP,$TPC         ;PUSH PC MARKER
 908         PUSH    PP,[PC]
 909         PUSH    PP,[TTP,,ON]    ;PUSH FRAME LOCATION
 910         MOVE    A,TP
 911         SUB     A,[<N-1>,,<N-1>]
 912         PUSH    PP,A
 913         MOVEM   TP,TPSAV(TB)    ;MAKE SURE TP SLOT IS CORRECT
 914         MOVE    E,TB
 915         PUSHJ   P,BCKTRE        ;COPY FRAME
 916 TERMIN\f\ 3\f