1 TITLE UUO HANDLER FOR MUDDLE AND HYDRA
\r
5 ;GLOBALS FOR THIS PROGRAM
\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
11 ;SETUP UUO DISPATCH TABLE HERE
\r
15 IRP UUOS,,[[DP,DODP],[.MCALL,DMCALL],[.ACALL,DACALL],[.ECALL,DECALL],[.FATAL,DFATAL]]
\r
25 REPEAT 100-UUFOO,[ILLUUO
\r
37 JRST UUOPUR ;GO TO PURE CODE FOR THIS
\r
39 SAVEC: 0 ; USED TO SAVE WORKING AC
\r
45 ;SEPARATION OF PURE FROM IMPURE CODE HERE
\r
47 UUOPUR: MOVEM C,SAVEC ; SAVE AC
\r
49 JRST @UUOTBL(C) ;DISPATCH BASED ON THE UUO
\r
53 ILLUUO: FATAL ILLEGAL UUO
\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
73 SUBI C,(M) ; RELATIVIZE THE PC
\r
74 HRLI C,M ; FOR RETURNER TO WIN
\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
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
85 HRRI TB,(TP) ; SETUP NEW TB
\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
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
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
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
107 COUNT1: SOS 2(R) ; UNDO OVERFLOW
\r
111 CALLS: AOBJP TB,.+1 ; GO TO CALLED SUBR
\r
112 INTGO ; CHECK FOR INTERRUPTS
\r
115 ; HERE TO HANDLE A PURE RSUBR (LOAD IF PUNTED OR OTHERWISE FLUSHED)
\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
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
132 STUPM2: HLRZ A,1(R) ; SET UP TO CALL LOADER
\r
135 PUSHJ P,PLOAD ; LOAD IT
\r
139 MOVE M,B ; GET LOCATION
\r
142 RCHECK: CAIN A,TPCODE ; PURE RSUBR?
\r
144 CAIE A,TCODE ; EVALUATOR CALLING RSUBR ?
\r
146 MOVS R,(C) ; YES, SETUP R
\r
148 JRST CALLR1 ; GO FINISH THE RSUBR CALL
\r
151 SCHECK: CAIE A,TSUBR ; RSUBR CALLING SUBR AS REFERENCE ?
\r
153 SKIPA C,(C)+1 ; SKIP AND GET ROUTINE'S ADDRESS
\r
155 HRRM C,FSAV+1(TB) ; FIXUP THE PROPER FSAV
\r
156 JRST CALLS ; GO FINISH THE SUBR CALL
\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
166 ; CHECK IF CAN LINK ATOM
\r
169 JRST BENTRY ; LOSER , COMPLAIN
\r
170 ECHCK4: MOVE B,1(C) ; GET ATOM
\r
173 PUSHJ P,IGVAL ; TRY GLOBAL VALUE
\r
178 CAME A,$TRSUBR ; IS IT A WINNER
\r
182 HLLM A,(C) ; FIXUP LINKAGE
\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
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
197 JRST CALLS ; GO TO SR
\r
199 ACHECK: CAIE A,TATOM ; RSUBR CALLING THROUGH REFERENCE ATOM ?
\r
200 JRST DOAPP3 ; TRY APPLYING IT
\r
204 HRRZ C,40 ; REGOBBLE POINTER TO SLOT
\r
205 GETYP 0,A ; GET TYPE
\r
208 SAVEIT: CAIE 0,TRSUBR
\r
210 JRST SAVEI1 ; WINNER
\r
214 JRST BADVAL ; SOMETHING STRANGE
\r
215 SAVEI1: SKIPE NOLINK
\r
217 MOVEM A,(C) ; CLOBBER NEW VALUE
\r
220 JRST ENTRIT ; HACK ENTRY TO SUB RSUBR
\r
222 JRST CALLR0 ; GO FINISH THE RSUBR CALL
\r
227 SUBRIT: SKIPE NOLINK
\r
231 HRRM B,FSAV+1(TB) ; FIXUP THE PROPER FSAV
\r
233 JRST CALLS ; GO FINISH THE SUBR CALL
\r
241 SKIPA D,EQUOTE UNBOUND-VARIABLE
\r
243 ERCAL: AOBJP TB,.+1 ; MAKE TB A LIGIT FRAME PNTR
\r
245 HRRM E,FSAV(TB) ; SET A WINNING FSAV
\r
246 HRRZ C,40 ; REGOBBLE POINTER TO SLOT
\r
248 SUBI C,(R) ; CALCULATE OFFSET
\r
250 ADD C,R ; MAKE INTO REAL RSUBR POINTER
\r
251 PUSH TP,$TRSUBR ; SAVE
\r
253 HRRZ C,40 ; REGOBBLE POINTER TO SLOT
\r
259 PUSH TP,MQUOTE CALLER
\r
261 MOVE C,(TP) ; GET SAVED RSUBR POINTER
\r
262 SUB TP,[2,,2] ; POP STACK
\r
267 BENTRY: MOVE D,EQUOTE BAD-ENTRY-BLOCK
\r
270 ;HANDLER FOR CALL WHERE SPECIFIES NUMBER OF ARGS
\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
279 ; CALL TO ENTRY FROM EVAL (LIKE ACALL)
\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
287 ;HANDLE OVERFLOW IN THE TP
\r
289 TPLOSE: PUSHJ P,TPOVFL
\r
292 ; RSUBR HAS POSSIBLY BEEN REPLACED BY A FUNCTION OR WHATEVER, DO AN APPLY
\r
294 DOAPPL: PUSH TP,A ; PUSH THE THING TO APPLY
\r
297 DOAPP2: JUMPGE AB,DOAPP1 ; ARGS DONE
\r
304 DOAPP1: ACALL A,APPLY ; APPLY THE LOSER
\r
307 DOAPP3: MOVE A,(C) ; GET VAL
\r
309 JRST BADVAL ; GET SETUP FOR APPLY CALL
\r
311 ; ENTRY TO BUILD A FRAME (USED BY SOME COMPILED PROG/REPEAT)
\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
317 ADD TP,[FRAMLN,,FRAMLN]
\r
319 PUSHJ TPOVFL ; HACK BLOWN PDL
\r
320 MOVSI A,TCBLK ; FUNNY FRAME
\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
330 \f;SUBROUTINE TERMINATION CODE (NOT A UUO BUT HERE FOR COMPLETENENSS)
\r
333 CNTIN1: HRRZS C,OTBSAV(TB) ; RESTORE BASE
\r
335 CONTIN: MOVE TP,TPSAV(TB) ; START HERE FOR FUNNY RESTART
\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
344 JRST @PCSAV(TB) ; AND RETURN
\r
345 GETYP 0,(C) ; RETURN TO MAIN OR SUB ENTRY?
\r
351 HRRI R,(C) ; RESET R
\r
352 SKIPGE M,1(R) ; GET LOC OF REAL SUBR
\r
356 FINIS1: CAIE 0,TRSUBR
\r
357 JRST FINISA ; MAY HAVE BEEN PUT BACK TO ATOM
\r
362 FINIS2: MOVEI C,(M) ; COMPUTE REAL M FOR PURE RSUBR
\r
364 ADD M,PURVEC+1(TVP)
\r
365 SKIPN M,1(M) ; SKIP IF LOADED
\r
367 ADDI M,(C) ; POINT TO SUB PART
\r
372 HLRZ A,1(R) ; RELOAD IT
\r
380 FINISA: CAIE 0,TATOM
\r
387 MOVE B,1(C) ; GET ATOM
\r
388 PUSHJ P,IGVAL ; GET VAL
\r
400 BADENT: PUSH TP,$TATOM
\r
401 PUSH TP,EQUOTE RSUBR-ENTRY-UNLINKED
\r
404 PCANT1: ADD TB,[1,,]
\r
405 PCANT: PUSH TP,$TATOM
\r
406 PUSH TP,EQUOTE PURE-LOAD-FAILURE
\r
410 BCKTR1: PUSH TP,A ; SAVE VALUE TO BE RETURNED
\r
411 PUSH TP,B ; SAVE FRAME ON PP
\r
418 ; SUBR TO ENABLE AND DISABLE LINKING OF RSUBRS AT RUN TIME
\r
420 MFUNCTION %RLINK,SUBR,[RSUBR-LINK]
\r
432 ;HANDLER FOR DEBUGGING CALL TO PRINT
\r