sumex/uuoh.mcr0072

   1 TITLE UUO HANDLER FOR MUDDLE AND HYDRA\r
   2 RELOCATABLE\r
   3 .INSRT MUDDLE >\r
   4 \r
   5 ;GLOBALS FOR THIS PROGRAM\r
   6 \r
   7 .GLOBAL BACKTR,PRINT,PDLBUF,TPGROW,SPECSTO,TIMOUT,AGC,VECBOT,VECTOP\r
   8 .GLOBAL BCKTRK,TPOVFL,.MONWR,.MONRD,.MONEX,MAKACT,IGVAL,ILVAL,BFRAME\r
   9 .GLOBAL PURTOP,PURBOT,PLOAD,PURVEC,STOSTR,MSGTYP,UUOH,ILLUUO\r
  10 \r
  11 ;SETUP UUO DISPATCH TABLE HERE\r
  12 \r
  13 UUOTBL: ILLUUO\r
  14 \r
  15 IRP UUOS,,[[DP,DODP],[.MCALL,DMCALL],[.ACALL,DACALL],[.ECALL,DECALL],[.FATAL,DFATAL]]\r
  16 UUFOO==.IRPCNT+1\r
  17 IRP UUO,DISP,[UUOS]\r
  18 .GLOBAL UUO\r
  19 UUO=UUFOO_33\r
  20 DISP\r
  21 .ISTOP\r
  22 TERMIN\r
  23 TERMIN\r
  24 \r
  25 REPEAT 100-UUFOO,[ILLUUO\r
  26 ]\r
  27 \r
  28 \r
  29 RMT [\r
  30 IMPURE\r
  31 \r
  32 UUOH:\r
  33 LOC 41\r
  34         JSR     UUOH\r
  35 LOC UUOH\r
  36         0\r
  37         JRST    UUOPUR          ;GO TO PURE CODE FOR THIS\r
  38 \r
  39 SAVEC:  0                       ; USED TO SAVE WORKING AC\r
  40 NOLINK: 0\r
  41 \r
  42 PURE\r
  43 ]\r
  44 \r
  45 ;SEPARATION OF PURE FROM IMPURE CODE HERE\r
  46 \r
  47 UUOPUR: MOVEM   C,SAVEC         ; SAVE AC\r
  48         LDB     C,[330900,,40]\r
  49         JRST    @UUOTBL(C)      ;DISPATCH BASED ON THE UUO\r
  50 \r
  51 \r
  52 \r
  53 ILLUUO: FATAL ILLEGAL UUO\r
  54 \f;CALL HANDLER\r
  55 \r
  56 MQUOTE CALLER\r
  57 CALLER:\r
  58 \r
  59 DMCALL":\r
  60         MOVEI   D,0             ; FLAG NOT ENTRY CALL\r
  61         LDB     C,[270400,,40]  ; GET AC FIELD OF UUO\r
  62 COMCAL: LSH     C,1             ; TIMES 2\r
  63         MOVN    AB,C            ; GET NEGATED # OF ARGS\r
  64         HRLI    C,(C)           ; TO BOTH SIDES\r
  65         SUBM    TP,C            ; NOW HAVE TP TO SAVE\r
  66         MOVEM   C,TPSAV(TB)     ; SAVE IT\r
  67         MOVSI   AB,(AB)         ; BUILD THE AB POINTER\r
  68         HRRI    AB,1(C)         ; POINT TO ARGS\r
  69         HRRZ    C,UUOH          ; GET PC OF CALL\r
  70         CAMG    C,PURTOP        ; SKIP IF NOT IN GC SPACE\r
  71         CAIGE   C,STOSTR        ; SKIP IF IN GC SPACE\r
  72         JRST    .+3\r
  73         SUBI    C,(M)           ; RELATIVIZE THE PC\r
  74         HRLI    C,M             ; FOR RETURNER TO WIN\r
  75         MOVEM   C,PCSAV(TB)\r
  76         MOVEM   SP,SPSAV(TB)    ; SAVE BINDING GOODIE\r
  77         MOVSI   C,TENTRY        ; SET UP ENTRY WORD\r
  78         HRR     C,40            ; POINT TO CALLED SR\r
  79         ADD     TP,[FRAMLN,,FRAMLN]     ; ALLOCATE NEW FRAME\r
  80         JUMPGE  TP,TPLOSE\r
  81 CALDON: MOVEM   C,FSAV+1(TP)    ; CLOBBER THE FRAME\r
  82         MOVEM   TB,OTBSAV+1(TP)\r
  83         MOVEM   AB,ABSAV+1(TP)  ; FRAME BUILT\r
  84         MOVEM   P,PSAV(TB)\r
  85         HRRI    TB,(TP)         ; SETUP NEW TB\r
  86         MOVEI   C,(C)\r
  87         MOVEI   M,0             ; UNSETUP M FOR GC WINNAGE\r
  88         CAMG    C,VECTOP        ; SKIP IF NOT RSUBR\r
  89         CAMGE   C,VECBOT        ; SKIP IF RSUBR\r
  90         JRST    CALLS\r
  91         GETYP   A,(C)           ; GET CONTENTS OF SLOT\r
  92         JUMPN   D,EVCALL        ; EVAL CALLING ENTRY ?\r
  93         CAIE    A,TRSUBR        ; RSUBR CALLING RSUBR ?\r
  94         JRST    RCHECK          ; NO\r
  95         MOVE    R,(C)+1         ; YES, SETUP R\r
  96 CALLR0: HRRM    R,FSAV+1(TB)    ; FIXUP THE PROPER FSAV\r
  97 CALLR1: AOS     E,2(R)          ; COUNT THE CALLS\r
  98         TRNN    E,-1            ; SKIP IF OK\r
  99         JRST    COUNT1\r
 100 \r
 101         SKIPL   M,(R)+1         ; SETUP M\r
 102         JRST    SETUPM          ; JUMP IF A PURE RSUBR IN QUESTION\r
 103         AOBJP   TB,.+1          ; GO TO CALLED RSUBR\r
 104         INTGO                   ; CHECK FOR INTERRUPTS\r
 105         JRST    (M)\r
 106 \r
 107 COUNT1: SOS     2(R)            ; UNDO OVERFLOW\r
 108         HLLZS   2(R)\r
 109         JRST    CALLR1\r
 110 \r
 111 CALLS:  AOBJP   TB,.+1          ; GO TO CALLED SUBR\r
 112         INTGO                   ; CHECK FOR INTERRUPTS\r
 113         JRST    @C\r
 114 \f\r
 115 ; HERE TO HANDLE A PURE RSUBR (LOAD IF PUNTED OR OTHERWISE FLUSHED)\r
 116 \r
 117 SETUPM: MOVEI   C,0             ; OFFSET (FOR MAIN ENTRIES)\r
 118 STUPM1: MOVEI   D,(M)           ; GET OFFSET INTO  CODE\r
 119         HLRS    M               ; GET VECTOR OFFSET IN BOTH HALVES\r
 120         ADD     M,PURVEC+1(TVP) ; GET IT\r
 121         SKIPL   M\r
 122         FATAL   LOSING PURE RSUBR POINTER\r
 123         HLLM    TB,2(M)         ; MARK FOR LRU ALGORITHM\r
 124         SKIPN   M,1(M)          ; POINT TO CORE IF LOADED\r
 125         AOJA    TB,STUPM2       ; GO LOAD IT\r
 126 STUPM3: ADDI    M,(D)           ; POINT TO REAL THING\r
 127         HRLI    C,M             ; POINT TO START PC\r
 128         AOBJP   TB,.+1\r
 129         INTGO\r
 130         JRST    @C              ; GO TO IT\r
 131 \r
 132 STUPM2: HLRZ    A,1(R)          ; SET UP TO CALL LOADER\r
 133         PUSH    P,D\r
 134         PUSH    P,C\r
 135         PUSHJ   P,PLOAD         ; LOAD IT\r
 136         JRST    PCANT1\r
 137         POP     P,C\r
 138         POP     P,D\r
 139         MOVE    M,B             ; GET LOCATION\r
 140         SOJA    TB,STUPM3\r
 141 \r
 142 RCHECK: CAIN    A,TPCODE        ; PURE RSUBR?\r
 143         JRST    .+3\r
 144         CAIE    A,TCODE         ; EVALUATOR CALLING RSUBR ?\r
 145         JRST    SCHECK          ; NO\r
 146         MOVS    R,(C)           ; YES, SETUP R\r
 147         HRRI    R,(C)\r
 148         JRST    CALLR1          ; GO FINISH THE RSUBR CALL\r
 149 \r
 150 \r
 151 SCHECK: CAIE    A,TSUBR         ; RSUBR CALLING SUBR AS REFERENCE ?\r
 152         CAIN    A,TFSUBR\r
 153         SKIPA   C,(C)+1         ; SKIP AND GET ROUTINE'S ADDRESS\r
 154         JRST    ECHECK\r
 155         HRRM    C,FSAV+1(TB)    ; FIXUP THE PROPER FSAV\r
 156         JRST    CALLS           ; GO FINISH THE SUBR CALL\r
 157 \r
 158 ECHECK: CAIE    A,TENTER        ; SKIP IF SUB ENTRY OF RSUBR\r
 159         JRST    ACHECK          ; COULD BE EVAL CALLING ONE\r
 160         MOVE    C,1(C)          ; POINT TO SUB ENTRY BLOCK\r
 161 ECHCK3: GETYP   A,(C)           ; SEE IF LINKED TO ITS MAIN ENTRY\r
 162         MOVE    B,1(C)\r
 163         CAIN    A,TRSUBR\r
 164         JRST    ECHCK2\r
 165 \r
 166 ; CHECK IF CAN LINK ATOM\r
 167 \r
 168         CAIE    A,TATOM\r
 169         JRST    BENTRY          ; LOSER , COMPLAIN\r
 170 ECHCK4: MOVE    B,1(C)          ; GET ATOM\r
 171         PUSH    TP,$TVEC\r
 172         PUSH    TP,C\r
 173         PUSHJ   P,IGVAL         ; TRY GLOBAL VALUE\r
 174         MOVE    C,(TP)\r
 175         SUB     TP,[2,,2]\r
 176         CAMN    A,$TUNBOU\r
 177         JRST    BADVAL\r
 178         CAME    A,$TRSUBR       ; IS IT A WINNER\r
 179         JRST    BENTRY\r
 180         SKIPE   NOLINK\r
 181         JRST    ECHCK2\r
 182         HLLM    A,(C)           ; FIXUP LINKAGE\r
 183         MOVEM   B,1(C)\r
 184         JRST    ECHCK2\r
 185 \r
 186 EVCALL: CAIN    A,TATOM         ; EVAL CALLING ENTRY?\r
 187         JRST    ECHCK4          ; COULD BE MUST FIXUP\r
 188         CAIE    A,TRSUBR        ; YES THIS IS ONE\r
 189         JRST    BENTRY\r
 190         MOVE    B,1(C)\r
 191 ECHCK2: MOVE    R,B             ; SET UP R\r
 192         HRRM    C,FSAV+1(TB)    ; SET POINTER INTO FRAME\r
 193         HRRZ    C,2(C)          ; FIND OFFSET INTO SAME\r
 194         SKIPL   M,1(R)          ; POINT TO START OF RSUBR\r
 195         JRST    STUPM1          ; JUMP IF A LOSER\r
 196         HRLI    C,M\r
 197         JRST    CALLS           ; GO TO SR\r
 198 \r
 199 ACHECK: CAIE    A,TATOM         ; RSUBR CALLING THROUGH REFERENCE ATOM ?\r
 200         JRST    DOAPP3          ; TRY APPLYING IT\r
 201         MOVE    A,(C)\r
 202         MOVE    B,(C)+1\r
 203         PUSHJ   P,IGVAL\r
 204         HRRZ    C,40            ; REGOBBLE POINTER TO SLOT\r
 205         GETYP   0,A             ; GET TYPE\r
 206         CAIN    0,TUNBOUND\r
 207         JRST    TRYLCL\r
 208 SAVEIT: CAIE    0,TRSUBR\r
 209         CAIN    0,TENTER\r
 210         JRST    SAVEI1          ; WINNER\r
 211         CAIE    0,TSUBR\r
 212         CAIN    0,TFSUBR\r
 213         JRST    SUBRIT\r
 214         JRST    BADVAL          ; SOMETHING STRANGE\r
 215 SAVEI1: SKIPE   NOLINK\r
 216         JRST    .+3\r
 217         MOVEM   A,(C)           ; CLOBBER NEW VALUE\r
 218         MOVEM   B,(C)+1\r
 219         CAIN    0,TENTER\r
 220         JRST    ENTRIT          ; HACK ENTRY TO SUB RSUBR\r
 221         MOVE    R,B             ; SETUP R\r
 222         JRST    CALLR0          ; GO FINISH THE RSUBR CALL\r
 223 \r
 224 ENTRIT: MOVE    C,B\r
 225         JRST    ECHCK3\r
 226 \r
 227 SUBRIT: SKIPE   NOLINK\r
 228         JRST    .+3\r
 229         MOVEM   A,(C)\r
 230         MOVEM   B,1(C)\r
 231         HRRM    B,FSAV+1(TB)    ; FIXUP THE PROPER FSAV\r
 232         MOVEI   C,(B)\r
 233         JRST    CALLS           ; GO FINISH THE SUBR CALL\r
 234 \r
 235 TRYLCL: MOVE    A,(C)\r
 236         MOVE    B,(C)+1\r
 237         PUSHJ   P,ILVAL\r
 238         GETYP   0,A\r
 239         CAIE    0,TUNBOUND\r
 240         JRST    SAVEIT\r
 241         SKIPA   D,EQUOTE UNBOUND-VARIABLE\r
 242 BADVAL: MOVEI   D,0\r
 243 ERCAL:  AOBJP   TB,.+1          ; MAKE TB A LIGIT FRAME PNTR\r
 244         MOVEI   E,CALLER\r
 245         HRRM    E,FSAV(TB)      ; SET A WINNING FSAV\r
 246         HRRZ    C,40            ; REGOBBLE POINTER TO SLOT\r
 247         JUMPE   D,DOAPPL\r
 248         SUBI    C,(R)           ; CALCULATE OFFSET\r
 249         HRLS    C\r
 250         ADD     C,R             ; MAKE INTO REAL RSUBR POINTER\r
 251         PUSH    TP,$TRSUBR      ; SAVE\r
 252         PUSH    TP,C\r
 253         HRRZ    C,40            ; REGOBBLE POINTER TO SLOT\r
 254         PUSH    TP,$TATOM\r
 255         PUSH    TP,D\r
 256         PUSH    TP,(C)\r
 257         PUSH    TP,(C)+1\r
 258         PUSH    TP,$TATOM\r
 259         PUSH    TP,MQUOTE CALLER\r
 260         MCALL   3,ERROR\r
 261         MOVE    C,(TP)          ; GET SAVED RSUBR POINTER\r
 262         SUB     TP,[2,,2]               ; POP STACK\r
 263         GETYP   0,A\r
 264         HRRM    C,40\r
 265         SOJA    TB,SAVEIT\r
 266 \r
 267 BENTRY: MOVE    D,EQUOTE BAD-ENTRY-BLOCK\r
 268         JRST    ERCAL\r
 269 \r
 270 ;HANDLER FOR CALL WHERE SPECIFIES NUMBER OF ARGS\r
 271 \r
 272 DACALL":\r
 273         LDB     C,[270400,,40]  ; GOBBLE THE AC LOCN INTO C\r
 274         EXCH    C,SAVEC         ; C TO SAVE LOC RESTORE C\r
 275         MOVE    C,@SAVEC        ; C NOW HAS NUMBER OF ARGS\r
 276         MOVEI   D,0             ; FLAG NOT E CALL\r
 277         JRST    COMCAL          ; JOIN MCALL\r
 278 \r
 279 ; CALL TO ENTRY FROM EVAL (LIKE ACALL)\r
 280 \r
 281 DECALL:         LDB     C,[270400,,40]  ; GET NAME OF AC\r
 282         EXCH    C,SAVEC         ; STORE NAME\r
 283         MOVE    C,@SAVEC        ; C NOW HAS NUM OF ARGS\r
 284         MOVEI   D,1             ; FLAG THIS\r
 285         JRST    COMCAL\r
 286 \r
 287 ;HANDLE OVERFLOW IN THE TP\r
 288 \r
 289 TPLOSE: PUSHJ   P,TPOVFL\r
 290         JRST    CALDON\r
 291 \r
 292 ; RSUBR HAS POSSIBLY BEEN REPLACED BY A FUNCTION OR WHATEVER, DO AN APPLY\r
 293 \r
 294 DOAPPL: PUSH    TP,A            ; PUSH THE THING TO APPLY\r
 295         PUSH    TP,B\r
 296         MOVEI   A,1\r
 297 DOAPP2: JUMPGE  AB,DOAPP1       ; ARGS DONE\r
 298 \r
 299         PUSH    TP,(AB)\r
 300         PUSH    TP,1(AB)\r
 301         ADD     AB,[2,,2]\r
 302         AOJA    A,DOAPP2\r
 303 \r
 304 DOAPP1: ACALL   A,APPLY         ; APPLY THE LOSER\r
 305         JRST    FINIS\r
 306 \r
 307 DOAPP3: MOVE    A,(C)           ; GET VAL\r
 308         MOVE    B,1(C)\r
 309         JRST    BADVAL          ; GET SETUP FOR APPLY CALL\r
 310 \f\r
 311 ; ENTRY TO BUILD A FRAME (USED BY SOME COMPILED PROG/REPEAT)\r
 312 \r
 313 BFRAME: HRLI    A,M             ; RELATIVIZE PC\r
 314         MOVEM   A,PCSAV(TB)     ; CLOBBER PC IN\r
 315         MOVEM   TP,TPSAV(TB)    ; SAVE STATE\r
 316         MOVEM   SP,SPSAV(TB)\r
 317         ADD     TP,[FRAMLN,,FRAMLN]\r
 318         SKIPL   TP\r
 319         PUSHJ   TPOVFL  ; HACK BLOWN PDL\r
 320         MOVSI   A,TCBLK         ; FUNNY FRAME\r
 321         HRRI    A,(R)\r
 322         MOVEM   A,FSAV+1(TP)    ; CLOBBER\r
 323         MOVEM   TB,OTBSAV+1(TP)\r
 324         MOVEM   AB,ABSAV+1(TP)\r
 325         POP     P,A             ; RET ADDR TO A\r
 326         MOVEM   P,PSAV(TB)\r
 327         HRRI    TB,(TP)\r
 328         AOBJN   TB,.+1\r
 329         JRST    (A)\r
 330 \f;SUBROUTINE TERMINATION CODE (NOT A UUO BUT HERE FOR COMPLETENENSS)\r
 331 \r
 332 FINIS:\r
 333 CNTIN1: HRRZS   C,OTBSAV(TB)    ; RESTORE BASE\r
 334         HRRI    TB,(C)\r
 335 CONTIN: MOVE    TP,TPSAV(TB)    ; START HERE FOR FUNNY RESTART\r
 336         MOVE    P,PSAV(TB)\r
 337         CAME    SP,SPSAV(TB)    ; ANY RESTORATION NEEDED\r
 338         PUSHJ   P,SPECSTO       ; YES, GO UNRAVEL THE WORLDS BINDINGS\r
 339         MOVE    AB,ABSAV(TB)    ; AND GET OLD ARG POINTER\r
 340         HRRZ    C,FSAV(TB)      ; CHECK FOR RSUBR\r
 341         MOVEI   M,0             ; UNSETUP M FOR GC WINNAGE\r
 342         CAMG    C,VECTOP\r
 343         CAMGE   C,VECBOT\r
 344         JRST    @PCSAV(TB)      ; AND RETURN\r
 345         GETYP   0,(C)           ; RETURN TO MAIN OR SUB ENTRY?\r
 346         CAIN    0,TCODE\r
 347         JRST    .+3\r
 348         CAIE    0,TPCODE\r
 349         JRST    FINIS1\r
 350         MOVS    R,(C)\r
 351         HRRI    R,(C)           ; RESET R\r
 352         SKIPGE  M,1(R)          ; GET LOC OF REAL SUBR\r
 353         JRST    @PCSAV(TB)\r
 354         JRST    FINIS2\r
 355 \r
 356 FINIS1: CAIE    0,TRSUBR\r
 357         JRST    FINISA          ; MAY HAVE BEEN PUT BACK TO ATOM\r
 358         MOVE    R,1(C)\r
 359         SKIPGE  M,1(R)\r
 360         JRST    @PCSAV(TB)\r
 361 \r
 362 FINIS2: MOVEI   C,(M)           ; COMPUTE REAL M FOR PURE RSUBR\r
 363         HLRS    M\r
 364         ADD     M,PURVEC+1(TVP)\r
 365         SKIPN   M,1(M)          ; SKIP IF LOADED\r
 366         JRST    FINIS3\r
 367         ADDI    M,(C)           ; POINT TO SUB PART\r
 368         JRST    @PCSAV(TB)\r
 369 \r
 370 FINIS3: PUSH    TP,A\r
 371         PUSH    TP,B\r
 372         HLRZ    A,1(R)          ; RELOAD IT\r
 373         PUSHJ   P,PLOAD\r
 374         JRST    PCANT\r
 375         POP     TP,B\r
 376         POP     TP,A\r
 377         MOVE    M,1(R)\r
 378         JRST    FINIS2\r
 379 \r
 380 FINISA: CAIE    0,TATOM\r
 381         JRST    BADENT\r
 382         PUSH    TP,A\r
 383         PUSH    TP,B\r
 384         PUSH    TP,$TENTER\r
 385         HRL     C,(C)\r
 386         PUSH    TP,C\r
 387         MOVE    B,1(C)          ; GET ATOM\r
 388         PUSHJ   P,IGVAL         ; GET VAL\r
 389         GETYP   0,A\r
 390         CAIE    0,TRSUBR\r
 391         JRST    BADENT\r
 392         MOVE    C,(TP)\r
 393         HLLM    A,(C)\r
 394         MOVEM   B,1(C)\r
 395         MOVE    A,-3(TP)\r
 396         MOVE    B,-2(TP)\r
 397         SUB     TP,[4,,4]\r
 398         JRST    FINIS1\r
 399 \r
 400 BADENT: PUSH    TP,$TATOM\r
 401         PUSH    TP,EQUOTE RSUBR-ENTRY-UNLINKED\r
 402         JRST    CALER1\r
 403 \r
 404 PCANT1: ADD     TB,[1,,]\r
 405 PCANT:  PUSH    TP,$TATOM\r
 406         PUSH    TP,EQUOTE PURE-LOAD-FAILURE\r
 407         JRST    CALER1\r
 408         \r
 409 REPEAT 0,[\r
 410 BCKTR1: PUSH    TP,A            ; SAVE VALUE TO BE RETURNED\r
 411         PUSH    TP,B            ; SAVE FRAME ON PP\r
 412         PUSHJ   P,BCKTRK\r
 413         POP     TP,B\r
 414         POP     TP,A\r
 415         JRST    CNTIN1\r
 416 ]\r
 417 \f\r
 418 ; SUBR TO ENABLE AND DISABLE LINKING OF RSUBRS AT RUN TIME\r
 419 \r
 420 MFUNCTION %RLINK,SUBR,[RSUBR-LINK]\r
 421 \r
 422         ENTRY   1\r
 423 \r
 424         GETYP   0,(AB)\r
 425         SETZM   NOLINK\r
 426         CAIN    0,TFALSE\r
 427         SETOM   NOLINK\r
 428         MOVE    A,(AB)\r
 429         MOVE    B,1(AB)\r
 430         JRST    FINIS\r
 431 \r
 432 ;HANDLER FOR DEBUGGING CALL TO PRINT\r
 433 \r
 434 DODP":\r
 435         PUSH    TP, @40\r
 436         AOS     40\r
 437         PUSH    TP,@40\r
 438         PUSH P,0\r
 439         PUSH P,1\r
 440         PUSH    P,2\r
 441         PUSH    P,SAVEC\r
 442         PUSH P,4\r
 443         PUSH P,5\r
 444         PUSH P,40\r
 445         PUSH    P,UUOH\r
 446         MCALL   1,PRINT\r
 447         POP     P,UUOH\r
 448         POP P,40\r
 449         POP P,5\r
 450         POP P,4\r
 451         POP P,3\r
 452         POP P,2\r
 453         POP P,1\r
 454         POP P,0\r
 455         JRST    2,@UUOH\r
 456 \r
 457 \r
 458 DFATAL: MOVEM   A,20\r
 459         MOVEM   B,21\r
 460         MOVE    B,40\r
 461         HRLI    B,440700\r
 462         PUSHJ   P,MSGTYP\r
 463         JRST    4,.\r
 464 END\r
 465 \f\ 3\ 3\ 3