TITLE INTERP - PPL INTERPRETER TAS/EAT/ 28-MAY-72 HISEG SEARCH PPL ;TEMPORARY ACCUMULATOR CONVENTIONS: CPM==AC3 ;CURRENT POSITION MARKER CL==AC4 ;CURRENT LINE (DZADR) TOP==AC5 ;TEMPORARY TOP POINTER OF CAR J==AC6 ;TEMPORARY ACCUMULATOR I==AC7 ;TEMPORARY ACCUMULATOR ARGP==AC10 ;ARGUMENT POINTER CAR==AC11 ;CURRENT ACTIVATION RECORD PZADR S==AC12 ;TEMPORARY L==AC13 ;CURRENT LEXEME OR PZWORD B==AC14 ;DZADR OF CURRENT BLOCK ;THERE ARE FOUR ENTRY POINTS TO THE INTERPRETER. FOR TWO OF THEM, ;INTERP AND RESUM1, THE ONLY ASSUMPTION UPON ENTRY IS THAT CAR ;CONTAINS THE PZADR OF THE CURRENT ACTIVATION RECORD. ; INTERP: SETS UP ACCUMULATORS AND POINTERS BUT DOES NOT ; INCREMENT THE CPM TO POINT TO THE NEXT LEXEME. ; RESUM1: SETS UP ACCUMULATORS AND POINTERS AND INCREMENTS ; THE CPM TO POINT TO THE NEXT LEXEME. ;THE TWO OTHER ENTRY POINTS, BACK AND RESUME, ASSUME THAT ALL POINTERS ;AND ACCUMULATORS ARE SET UP. ; BACK: DOES NOT SEQUENCE TO THE NEXT LEXEME, BUT ; RESUME: SEQUENCES TO THE NEXT LEXEME. ;NOTE: WHENEVER THE CPM OR THE TOP POINTERS ARE INCREMENTED OR ;DECREMENTED, THE PMF AND TOPF FIELDS OF THE CURRENT ACTIVATION RECORD ;ARE UPDATED ACCORDINGLY WHEN A CALL IS TO BE MADE FROM WHICH ;THE RETURN ASSUMES ONLY A KNOWLEDGE OF THE PZADR OF THE CAR. SUBTTL ENTRY POINTS FOR THE INTERPRETER RESUME: ADDI CPM,1 ;CPM_CPM+1 RESUM0: SET CPM,PMF ;RESET PMF IN CAR JRST BACK ;RESUME INTERPRETATION RESUM1: HRRZ B,(CAR) ;B_DZADR OF CAR GET CPM,PMF ;CPM_CONTENTS OF POSITION MARKER FIELD ADDI CPM,1 ;INCREMENT CURRENT POSITION MARKER SET CPM,PMF ;RESET POSITION MARKER FIELD JRST INTP1 ;JOIN CODE DOWNSTREAM INTERP: HRRZ B,(CAR) ;B_DZADR OF CAR INTP1: GET CL,LPF ;CL_PZADR OF LINE POINTER HRRZ CL,(CL) ;CL_DZADR OF CURRENT LINE HRLI CL,CPM ;INDEX FIELD OF CL SET TO CPM GET CPM,PMF ;SET UP CURRENT POSITION MARKER GET TOP,TOPF ;SET UP TOP POINTER HRLI TOP,B ;TOP POINTER INDEXED BY B BACK: SETZM CFNAM ;CLEAR CURRENT FUNCTION NAME MOVE L,@CL ;L_CURRENT LEXEME LGET J,IACTF ;J_INTERPRETER ACTION OF CURRENT LEXEME SKIPGE J,INTTB(J) ;SKIP IF NOT MARKED FOR PRINTING IORI FF,PIR ;SET PRINT-IF-REQU'D FLAG JRST (J) ;DISPATCH ON INTERPRETER ACTION ;DISPATCH TABLE OF INTERPRETER ACTIONS ;THE LEFT HALF IS NEGATIVE FOR THOSE ACTIONS THAT SET THE PIR FLAG. INTTB: XWD -1, ISTAK ;GO STACK LEXEME XWD -1, IBINOP ;GO DO BINARY OPERATION XWD -1, IUNOP ;GO DO UNARY OPERATION EXP IUNSTAK ;UNSTACK A LEXEME XWD -1, IFNAPP ;APPLY A FUNCTION TO ITS ARGUMENTS XWD -1, ISELAPP ;APPLY SELECTORS TO SELECTAND EXP IFORSCP ;FOR SCOPE EXP IENDFOR ;END FOR SCOPE EXP ITHNS1 ;THEN SCOPE (NO ELSE CLAUSE) EXP ITHNS2 ;THEN SCOPE (WITH ELSE CLAUSE) EXP IELSSCP ;ELSE SCOPE XWD -1, IMAKTUP ;MAKE A TUPLE EXP IFORST ;FOR STATEMENT EXP IFORASS ;FOR ASSIGNMENT EXP RPADX ;RIGHT PAD- END OF LINE EXP IWHLSC ;WHILE DO EXP IENDWH ;END WHILE SCOPE EXP IRPTSC ;REPEAT UNTIL EXP IENDRP ;END REPEAT SCOPE SUBTTL INTERPRETER ACTIONS ISTAK: LGET J,LTYPF ;GET LEXEME TYPE IN J CAIN J,DEMAND ;SKIP IF WASN'T DEMAND JRST DMDX ;ELSE GO TO DEMAND EXIT MOVE AC1,L ;AC1_LEXEME TO BE STACKED PUSHJ P,STACK ;STACK LEXEME ON CAR STACK CAIN J,ID ;SEE IF LEXEME WAS ID JRST PPCHK ;IF SO GO CHECK FOR PARAMETERLESS PROCEDURE CAMN L,NULLL ;NO. WAS STACKED OBJECT THE NULL LEXEME? TRZ FF,PIR ;YES, WE NORMALLY DON'T PRINT IT JRST RESUME ;RESUME INTERPRETATION ;DEMAND EXIT ( TO SUPERVISOR ) DMDX: ADDI CPM,1 ;SET POSITION MARKER TO NEXT LEXEME SET CPM,PMF ;UPDATE POSITION MARKER FIELD OF CAR JRST DMND ;GO TO DEMAND EXIT IN SUPVSR ;CHECK FOR PARAMETERLESS PROCEDURES ;BY CONVENTION IF YOU ARE INSIDE A PARAMETERLESS PROCEDURE AND ;YOU ENCOUNTER AN INSTANCE OF THE PROCEDURE IDENTIFIER NOT ;FOLLOWED BY AN EMPTY PAIR OF PARENTHESES, YOU INTEND TO ;SIGNIFY THE CURRENT VALUE OF THE PROCEDURE IDENTIFIER AND NOT ;A RECURSIVE CALL ON IT. HOWEVER, A GLOBAL IDENTIFIER ;SIGNIFYING A PARAMETERLSS PROCEDURE WILL BE EXECUTED. TO FORCE ;EXECUTION OF A PARAMETERLESS PROCEDURE RECURSIVELY, USE THE ;PROCEDURE IDENTIFIER FOLLOWED BY AN EMPTY PAIR OF PARENTHESES. ;E.G. F() +2 OR F()_ZOT(A,"NOOSE"). ;HERE THE CODE FOR PPCHK EXTRACTS THE FN BLOCK AND ;THENCE THE NUMBER OF FORMLS FROM LINE0. IF THE NUMBER ;OF FORMLS WAS 0,YOU SET UP A FUNCTION CALL ON THE ;PARAMETERLESS PROCEDURE. IF THE NUMBER OF FORMLS WAS >0 ;YOU RESUME SYNTAX ANALYSIS. PPCHK: ADDI CPM,1 ;CHECK NEXT LEXEME MOVS R,@CL ;R_NEXT LEXEME CAIN R,(LXM(FNAPP,0,0)) ;SKIP IF NOT FNAPP(0) LEXEME JRST FWD21 ;GO DO PARAMETERLESS PROCEDURE HRRZ AC1,@IDTP ;AC1_DZADR OF IDT HRLI AC1,L ;MAKE L AN INDEX FIELD OF AC1 HRRZM L,CFNAM ;STORE INTERNAL NAME IN CASE OF ERROR MOVE S,@AC1 ;S_SYMBOL TABLE ENTRY HLRZ AC2,S ;AC2_IDENTIFIER CLASS CAIN AC2,I.SFN ;A SYSTEM FUNCTION? JRST FWD20 ;YES, GO SEE IF IT IS PARAMETERLESS CAIE AC2,I.FN ;A USER-DEFINED FUNCTION? JRST RESUM0 ;NO, RESUME INTERPRETATION ;COMMENT: IF WE HAD A FN OR SFN, THEN, IF IT IS PARAMETERLESS ;WE IMMEDIATELY MAKE A PARAMETERLESS PROCEDURE CALL. OTHERWISE, WE ;SIMPLY STACK THE LEXEME AND CONTINUE. WE CAN DETERMINE ;THE NUMBER OF ARGS REQUIRED FOR A USER-DEFINED FUNCTION BY EXAMINING ;THE FORMLS FIELD OF THE LINE0 BLOCK OF THE CALLE; FOR A SYSTEM FUNCTION, ;FROM THE RH OF THE FIRST WORD OF THE FUNCTION. FWD19: HRRZ B,(S) ;B_DZADR OF FN BLOCK HLRZ B,3(B) ;B_PZADR OF LINE 0 HRRZ B,(B) ;B_DZADR OF LINE0 GET AC2,FRMLF ;AC2_NO OF FORMAL PARAMETERS HRRZ B,(CAR) ;RECOMPUTE B AS DZADR OF CAR FWD19A: JUMPN AC2,RESUM0 ;IF NOT PARAMETERLESS,RESUME INTERPRETATION FWD19B: SETZM ARGP ;ARGP=0 MEANS FN HAS NO PARAMETERS MOVSI L,(LXM(FNAPP,0,0)) ;SET L TO FNAPP(0) JRST IFNAPP ;GO CALL FUNCTION FWD20: HRRE AC2,(S) ;GET # OF FORMLS REQUIRED FOR SFN JRST FWD19A ;GO TO TEST FOR 0 AND CALL IF SO. FWD21: SET CPM,PMF ;RESET POSITION MARKER JRST FWD19B ;AND GO TO FWD19B ;COME HERE TO PERFORM A BINARY OPERATION. ;THE CODE CONVERTS X2 X1 BINOP INTO X1 X2 FN-ID FNAPP(2) ;AND CALLS THE CODE FOR FUNCTION APPLICATION TO TWO ARGUMENTS. IBINOP: MOVEI J,@TOP ;COMPUTE ABS ADR OF TOP OF STACK MOVE I,(J) ;FETCH TOP LEXEME (LH OPERAND) EXCH I,-1(J) ;SWAP WITH LEXEME ONE DOWN (RH OPERAND) MOVEM I,(J) HRRZ S,@OPTP ;S_DZADR OF OPT ADDI S,1(L) ;POINT TO OPERATOR DEFINITION HRRZ AC1,(S) ;GET BINARY DEFINITION OF OP IN IDT JUMPE AC1,BOPUND ;BINARY OPERATOR UNDEFINED IF ZERO HRLI AC1,(LXM(STAK,ID,0)) ;SET LEFT HALF TO BE STAK-ID LEXEME PUSHJ P,STACK ;STACK IT ON CAR STACK MOVE L,[LXM(FNAPP,0,2)] ;L_FNAPP(2) LEXEME JRST IFNAPP ;GO APPLY THE FUNCTION ;CODE FOR PERFORMING UNARY OPERATIONS. WE CONVERT X1 UNOP INTO ;X1 FN-ID FNAPP(1) AND THEN CALL THE CODE FOR FUNCTION APPLICATION. IUNOP: HRRZ S,@OPTP ;S_DZADR OF OPT ADDI S,1(L) ;POINT TO OP DEFINITION HLRZ AC1,(S) ;GET UNARY DEFINITION OF OP IN IDT JUMPE AC1,UOPUND ;UNARY OPERATOR UNDEFINED IF ZERO HRLI AC1,(LXM(STAK,ID,0)) ;SET LEFT HALF TO BE STACK-ID LEXEME PUSHJ P,STACK ;STACK IT ON CAR MOVE L,[LXM(FNAPP,0,1)] ;L_FNAPP(1) LEXEME JRST IFNAPP ;GO APPLY THE FUNCTION ;HERE IF WE ATTEMPTED TO EXECUTE AN UNDEFINED OPERATOR BOPUND: TLOA AC1,(SIXBIT/BI!/) ;BINARY OPERATOR UNDEFINED UOPUND: MOVSI AC1,(SIXBIT/ U!/) ;UNARY OPERATOR UNDEFINED CALL KILLIO ;RESET FILE I/O TTOS [SIXBIT/EXECUTION ERROR: !/] TTOS AC1 ;PRINT 'BI' OR 'U' TTOS [SIXBIT/NARY OPERATOR UNDEFINED - !/] MOVEI AC1,(L) ;FETCH REL ADR OF OP NAME CALL OPPR ;OUTPUT PRINTNAME TTOS [SIXBIT/#/] ;CRLF JRST RESTRT ;PERFORM NORMAL ERROR RECOVERY ;UNSTACK A LEXEME IUNSTAK:CALL PNTIRQ ;PRINT VALUE OF TOP LEXEME IF REQUIRED SUBI TOP,1 ;DECREMENT TOP POINTER BY ONE SET TOP,TOPF ;RESET TOPF IN CAR SKIPN SUSPND ;SKIP IF SUSPEND SET NON ZERO BY USER JRST RESUME ;RESUME INTERPRETATION ADDI CPM,1 ;SEQUENCE TO NEXT LEXEME IN LINE SET CPM,PMF ;FOR USER RESUMPTION AFTER SUSPENSION JRST USRSUS ;GO DO USER SUSPENSION (IN SUPVSR) ; FUNCTION APPLICATION ;CALLING CONVENTIONS: ; THE FUNCTION CALL F(X1,X2,...,XN) APPEARS ON THE CAR STACK AS ; X1 X2 ... XN F WITH FNAPP(N) IN L. S CONTAINS TWO HALF ; WORDS: LHS(S)=NUMBER OF ARGUMENTS , RHS(S)=RHS(SYMBOL TABLE ENTRY OF F IN IDT). ; ARGP CONTAINS 0 IN THE CASE OF PARAMETERLESS PROCEDURES AND ; CONTAINS A POINTER (INDEXED BY B) TO THE FIRST ARGUMENT X1 OTHERWISE. ; TOP AND THE TOPF OF THE CAR POINT TO X1 (WHERE THE RESULT OF THE FUNTION ; WILL LATER BE STORED). THE CELL CFNAM IS SET TO CONTAIN THE RELATIVE ; ADDRESS OF THE FUNCTION IDENTIFIER F IN THE IDT IN CERTAIN CASES (ALLOWING ; PROPER ERROR MESSAGES TO BE PRINTED AMONG OTHER THINGS). ;AT ENTRY TO THE FOLLOWING CODE, L CONTAINS FNAPP(N) AND TOP POINTS TO ;F IN X1 X2 ... XN F ON THE CAR STACK. IFNAPP: IORI FF,PIR ;SET PRINT IF REQUIRED FLAG ON EXCH ARGP,TOP ;MAKE ARGP POINT TO FUNCTION NAME CALL EVALID ;EVAL TO AN ID JRST FAPTBL ;NOT POSSIBLE, ERROR EXCH ARGP,TOP ;OK, RESTORE POINTERS MOVE S,@TOP ;FETCH ID FOR FUNCTION TO BE CALLED TRNN FF,TUPARG ;IS THIS A TUPARG PROCESS MOVEM S,TPSVUF ;NO, SAVE THE VALUE IN CASE IT LATER IS HRRZM S,CFNAM ;STORE INTERNAL NAME OF FN TO BE CALLED ADD S,@IDTP ;POINT TO STE IN IDT MOVE S,(S) ;GET STE FOR THAT FN HLRZ R,S ;R_SYMBOL TABLE ENTRY TYPE JRST FAPTBL(R) ;DISPATCH ON TYPE FAPTBL: EXERR MSG(IMPFN) ;IMPROPER FUNCTION CALL JRST FAPTBL ;VARIABLE - ERROR JRST DOUFN ;CALL A USER FUNCTION JRST DODATA ;DDEF - DO A CONSTRUCTOR OR PREDICATE JRST DOSEL ;SEL - DO A SELECTION JRST FAPTBL ;CEV - ERROR JRST DOSFN ;ATOM - DO THE CONVERSION JRST DOSFN ;SFN - CALL SYSTEM FUNCTION JRST FAPTBL ;RESW - ERROR ;COME HERE TO DO A USER FUNCTION DOUFN: HLRZ R,(S) ;CHECK THAT THIS BLOCK IS REALLY A FN CAIE R,B.FN(SYSBIT) ;A TRANSLATION ERROR LEAVES THE IDT ENTRY JRST CANTEX ; POINTING AT THE LSB ;HERE TO PERFORM NECESSARY ARGUMENT SUBSTITUTIONS WHEN CALLING A USER FN ARGSUB: HRRZ AC2,L ;PUT NUMBER OF ARGS IN AC2 MOVEM B,TPSVAP ;SAVE B IN CASE MUST DO ARG TUPLE HRRZ B,(S) ;GET DZ ADR OF FN BLOCK HLRZ AC7,3(B) ;SAVE PZ ADR OF LINE0 BLOCK HRRZ B,(AC7) ;GET DZ ADR OF LINE0 BLOCK GET R,ATRSF ;EXTRACT ATTRIBUTE FIELD GET R2,FRMLF ;EXTRACT NUMBER OF FORMALS TRNN R,TUPATR ;IS THIS A VARIABLE ARG FUNCTION? JRST .+3 ;NO, DO NORMAL COMPARISON TRZN FF,TUPARG ;IS THIS THE SECOND TIME AROUND JRST TUPGET ;NO, EXTRACT TUPLE CAME AC2,R2 ;SAME AS NUMBER OF ARGS? EXERR MSG(WARGU) ;CALLED USER FN WITH WRONG NO. OF ARGS MOVEI AC4,5 ;YES. SET UP POINTER TO FIRST FORML HRLI AC4,R2 ; FIELD IN LINE0 BLOCK MOVEI AC3,CBRBIT ;SETUP CALL-BY-REF BIT FOR TEST MOVEI AC1,ARGSB1 ;ADR OF ROUTINE TO SUBSTITUTE ONE ARG SETZM ARGP ;SET ARGP TO ZERO JUMPE AC2,MAKAR ;JUMP IF NO PARAMETERS MOVE ARGP,TOP ;ELSE MAKE ARGP POINT SUBI ARGP,(L) ;TO FIRST ARGUMENT CALL ARGENU ;SEQUENCE DOWN ARGLIST (LENGTH IN AC2) ;CONSTRUCT A NEW ACTIVATION RECORD MAKAR: HRRZ B,(S) ;GET DZADR OF CALLE FN BLOCK GET R2,LCLSF ;FETCH # OF FORMALS AND LOCALS CALL MKBLK ;CONSTRUCT AN AR OF THE REQUIRED LENGTH BLKARG SYSBIT+B.AR,ARBASE+ISTKL(R2) HRRZ AC1,R ;AC1_PZADR OF NEW AR MOVE AC3,AC2 ;REMEMBER NUMBER OF ARGS MOVEI AC2,RAF ;POINT TO RING OF ACTIVE FNS CALL INSIRT ;PLACE NEW AR INTO RING OF ACTIVE FNS ;PERFORM PARAMETER TRANSMISSION PARTRN: HRRZ B,(CAR) ;RESTORE DZADR OF CALLER AR JUMPE AC3,NACTLS ;SKIP ALL THIS IF NO PARAMETERS SET ARGP,TOPF ;STORE POSITION WHERE RESULT IS TO BE RETURNED MOVEI AC2,ARBASE+1(R2) ;AC2_ABSOLUTE ADR OF BASE OF PARAMETER REGION HRLI AC2,@ARGP ;LH_ABS ADR OF FIRST ACTUAL PARAMETER ADDI AC3,(AC2) ;COMPUTE LAST DESTINATION ADR+1 BLT AC2,-1(AC3) ;TRANSFER PARAMETERS TO CALLEE ;DO THE ASSIGNMENTS IF THERE ARE ANY NACTLS: HRRZ B,(AC7) ;GET DZADR OF LINE0 BLOCK GET AC4,ATRSF ;GET ATTRIBUTES OF CALLEE FN GET AC5,ASGNSF ;GET NUMBER OF ASSIGNMENTS TO DO MOVE AC6,B ;SAVE DZADR OF LINE0 BLOCK HRRZ B,(S) ;GET DZADR OF FN BLOCK OF CALLEE GET AC3,LCLSF ;EXTRACT NUMBER OF LOCALS HRRZ B,(AC1) ;GET DZADR OF NEW AR JUMPE AC5,FIXPS ;JUMP IF NO ASSIGNMENTS ADDI AC6,4(AC3) ;AC6-->FIRST ASSIGNMENT MOVSI R,(LXM(STAK,RELOC,0)) ;SET UP LH OF LEXEME TO ASSIGN DOASGN: HRR R,(AC6) ;LOAD TARGET FOR ASSIGNMENT HLRZ AC2,(AC6) ;GET FORMAL PARAMETER NUMBER ADDI AC2,ARBASE(B) ;POINT TO CORRECT SLOT IN CALLEE MOVEM R,(AC2) ;STORE ASSIGNMENT LEXEME ADDI AC6,1 ;SEQUENCE TO NEXT ASSIGNMENT SOJG AC5,DOASGN ;GO BACK FOR MORE ASSIGNMENTS ;INITIALIZE ASSORTED POINTERS AND FIELDS FIXPS: SET AC4,ATRF ;SET ATTRIBUTE FIELD SET S,FNF ;SET FUNCTION FIELD SET CAR,CRF ;SET CALLER FIELD ADDI AC3,ARBASE ;COMPUTE REL ADR OF BASE OF AR STACK HRLI AC3,B ;INDEX BY B MOVSI R,(LXM(CXTWD,BOTCWD)) ;SETUP BOTTOM CONTEXT WORD LEXEME MOVEM R,@AC3 ;STORE IT AS BOTTOM WORD OF STACK SET AC3,TOPF ;SET STACK PTR MOVEI AC3,1 ;SET LINE NUMBER FIELD TO ONE SET AC3,LNF HRRZ B,(CAR) ;RESTORE BASE ADR OF CAR GET CPM,PMF ;FETCH CURRENT POSITION MARKER ADDI CPM,1 ;POINT TO LEXEME AFTER FN CALL SET CPM,PMF ;STORE IN CALLER FUNCTION ;SEE IF CALLEE WAS PARALLEL TRNE AC4,PARATR ;PARALLEL? JRST PAREX ;YES, DON'T SUSPEND CAR JRST FNCALX ;GO TO FUNCTION CALL EXIT IN SUPVSR ;HERE IF CALLEE WAS PARALLEL. CONTINUE EXECUTION OF CAR PAREX: GET R,TOPF ;DETERMINE TOP OF CAR ADDI R,-1(B) ;DETERMINE ABS ADR -1 OF WHERE TO PUT RESULT PUSH R,NULLL ;STACK NULL LEXEME JRST RESUM1 ;GO RESUME SYNTAX ANALYSIS ;COME HERE IF FUNCTION IS UNEXECUTABLE (BECAUSE IT WAS NEVER TRANSLATED) CANTEX: CALL KILLIO ;TERMINATE I/O OPERATIONS TTOS [SIXBIT/EXECUTION ERROR: !/] MOVE AC1,CFNAM ;GET CURRENT FUNCTION NAME CALL IDPR ;PRINT ITS NAME TTOS [SIXBIT/ IS UNEXECUTABLE#/] JRST RESTRT ;GO PERFORM ERROR RECOVERY ;HERE IF TUPLE ARGUMENTS ARE BEING USED IN THIS FN TUPGET: MOVE B,TPSVAP ;RESTORE OLD VALUE OF B MOVEM R2,TPSVAP ;SAVE NUMBER OF REAL ARGS FOR LATER SUBI R2,1 ;GET NUMBER OF NON TUP ARGUMENTS CAMLE R2,AC2 ;AT LEAST AS MANY ARGS? EXERR MSG(WARGU) ;CALLED UFN WITH WRONG NO OF ARGS MOVE AC1,[LXM(STAK,ID,U.TUPLE)];MAKE TUPLE LEXEME MOVEM AC1,@TOP ;MOVE IT TO SAVE USER FN SUB AC2,R2 ;COMPUTE NUMBER OF SURPLUS AGRS MOVEM AC2,TPSVNS ;SAVE SURPLUS NUMBER OF ARGS HRR L,AC2 ;MAKE A FNAPP(# SURPLUS) TRO FF,TUPARG ;SET TUPARG FLAG SETZM ARGP ;IN CASE OF ZERO TUPLE JRST IFNAPP ;GO CALL TUPLE FUNCTION ; CODE RETURNS HERE FROM DATA AFTER TUPLE IS CONSTRUCTED TUPRET: MOVE AC1,TPSVUF ;GET OLD USER FN PUSHJ P,STACK ;STACK IT ON THE CAR STACK MOVE L,TPSVAP ;RESTORE CORRECT NUMBER OF ARGS HRLI L,(LXM(FNAPP,0,0));MAKE A FNAPP LEXEME JRST IFNAPP ;GO REPEAT EVALUATION ;ROUTINE TO PERFORM SUBSTITUTION ON ONE ARG ;ASSUMPTIONS: ; ARGP-->ARG BEING SUSBTITUTED FOR ; AC7 HAS PZADR OF LINE0 BLOCK OF CALLEE ; AC4 HAS XWD R2,REL ADR OF CURRENT FORML ENTRY IN LINE0 ; AC3 HAS CBRBIT IN RH ; B CONTAINS DZADR OF CAR ; L CONTAINS LEXEME POINTED TO BY ARGP ; R CONTAINS LEXEME TYPE ;DETERMINES WHETHER PASS BY REFERENCE OR BY VALUE IS REQUIRED, AND PER- ;FORMS THE SUBSTITUTION ARGSB1: HRRZ R2,(AC7) ;GET DZADR OF LINE0 BLOCK OF CALLEE TDNE AC3,@AC4 ;CBR BIT SET FOR THIS FORML? AOJA AC4,CBRSUB ;YES. GO PERFORM CALL BY REFERENCE CALL MKCNST ;NO. COERCE ARG TO A CONSTANT EXERR MSG(IARGU) ;IMPROPER ARG TO USER FUNCTION (CALL BY VALUE) HRRZ AC1,@ARGP ;GET RESULT CALL COPY ;MAKE A COPY IF NECESSARY HRRZ B,(CAR) ;RESTORE CURRENT DZ ADDR HRRM R,@ARGP ;PLACE PZ ADR OF COPY ON STACK AOJA AC4,CPOPJ ;SEQUENCE TO NEXT LINE0 ENTRY AND RETURN ;HERE TO PERFORM A CALL-BY-REFERENCE SUBSTITUTION CBRSUB: MOVE R,RFSUBT(R) ;FETCH RH ENTRY FOR LEXEME TYPE JRST (R) ;DISPATCH PPERR: ERROR MSG(LXTER) ;BAD LXTYP IN ARGSUB ;SUBSTITUTE FOR AN ARG THAT IS LOCAL. SWITCH ON PRESENT CONTENTS ;OF LCL RFLCL: ADDI L,ARBASE(B) ;COMPUTE ABS ADR OF LOCAL ENTRY SKIPN L,(L) ;GET PRESENT CONTENTS OF LOCAL JRST MKDUMR ;IF UNDEFINED, MAKE DUMMY REFERENCE LGET R,LTYPF ;EXTRACT LEXEME TYPE FIELD MOVS R,RFSUBT(R) ;FETCH LH ENTRY FOR CURRENT LEXEME TYPE JRST (R) ;DISPATCH ;HERE WHEN THE PRESENT CONTENTS OF A LOCAL VARIABLE IS A CONST OR A RELOC. ;MAKE A DUMMY REFERENCE (DUMREF) TO THE LOCAL VARIABLE SLOT IN THE AR. MKDUMR: HRRZ L,@ARGP ;FETCH LOCAL PARAMETER NUMBER AGAIN HRLI L,(LXM(STAK,DUMREF)) ;LH_LEXEME TYPE STORE (L,L,FCHNF) ;STORE PARAMETER NUMBER IN FWD CHAIN FIELD HRRI L,(CAR) ;STORE PZADR OF CAR IN RH ;HERE TO SUBSTITUTE THE CONTENTS OF A LOCAL VARIABLE RFPASD: MOVEM L,@ARGP ;REPLACE ARG RETURN ;TABLE FOR ARGUMENT SUBSTITUTION PROCESSING RFSUBT: PPERR ,, PPERR ;OP PPERR ,, RFLCL ;PROCID PPERR ,, RFLCL ;FORML PPERR ,, RFLCL ;LCL RFPASD ,, CPOPJ ;ID MKDUMR ,, CPOPJ ;CONST MKDUMR ,, RLCINT ;RELOC PPERR ,, PPERR ;DEMAND RFPASD ,, CPOPJ ;SELX RFPASD ,, CPOPJ ;$ID RFPASD ,, CPOPJ ;DUMREF ;ROUTINE TO CONVERT A RELOC TO AN INT. IT IS ASSUMED THAT ARGP-->RELOC ;THE RESULT IS RETURNED AS A CONST IN THE SAME PLACE RLCINT: CALL MKBLK ;CONSTRUCT AN INT BLKARG U.INT,2 HRRZ B,(CAR) ;RESTORE BASE ADR OF CAR HRLI R,(LXM(STAK,CONST,0)) ;CONSTRUCT CONST EXCH R,@ARGP ;SAVE CONST AND GET RELOC LEXEME HRRZM R,1(R2) ;STORE RELOC VALUE IN INT BLOCK RETURN ;DATA OPERATIONS ARE FOUND IN DATA.MAC ;IN PARTICULAR, DODOP IS FOUND IN DATA.MAC ;PREPARATION FOR CALLING CONSTRUCTORS OR PREDICATES IN DATA.MAC DODATA: HRL S,L ;SET LEFT HALF OF S TO # OF ARGS. SUBI TOP,(L) ;MAKE TOP POINT TO FIRST ARG SET TOP,TOPF ;RESET TOP FIELD IN CAR DODAT2: HRRZ AC1,L ;AC1_NUMBER OF ARGUMENTS SKIPE ARGP,AC1 ;SKIP IF # ARGS = 0 MOVE ARGP,TOP ;ARGP_POINTER TO FIRST ARG JRST DODOP ;DO CONSTRUCTOR OR PREDICATE ;HERE WE SET UP A SELECTION IN THE FORM S X SELAPP(1) WHEN WE ;ARE GIVEN A SELECTOR IN FUNCTIONAL FORM S(X) THAT APPEARS ;ON THE CAR STACK IN THE FORM X S FNAPP(1). THEN WE CALL NORMAL ;SELECTION AS IN ISELAPP. DOSEL: MOVE ARGP,TOP ;SET ARGP TO POINT TO TOP-1 SUBI ARGP,1 MOVE I,@ARGP ;SWITCH POSITION OF X AND S ON CAR STACK MOVE J,@TOP MOVEM I,@TOP MOVEM J,@ARGP MOVE L,[LXM(SELAPP,0,1)] ;SET L TO CONTAIN SELAPP(1) JRST CSELCT ;AND CALL CODE TO DO SELECTION ;CODE TO PERFORM A SYSTEM FUNCTION DOSFN: HRL S,L ;SET LEFT HALF OF S SUBI TOP,(L) ;CONTAIN THE NUMBER OF ARGUMENTS SET TOP,TOPF ;SET TOPF IN CAR HRRZ AC1,L ;AC1 _ NUMBER OF ARGUMENTS SKIPE ARGP,AC1 ;SKIP IF WAS 0, ELSE SET MOVE ARGP,TOP ;ARGP TO POINT TO FIRST ARGUMENT HRRE AC1,(S) ;GET NO. OF ARGS IN THE ROUTINE CAIE AC1,(L) ;DOES IT MATCH NO. OF CALLING PARAMETERS? JUMPGE AC1,WRNGNB ;NO,ERROR IF FUNCTION NOT VARIADIC PUSHJ P,1(S) ;CALL FUNCTION WHOSE ADDRESS IS =RHS(S) HRRZ B,(CAR) ;RECOMPUTE DZADR OF CAR GET TOP,TOPF ;GET TOP OF STACK WHERE HRLI TOP,B ;RESULT IS TO BE STORED MOVEM R,@TOP ;AND STORE RESULT THERE JRST RESUM1 ;GO RESUME INTERPRETATION ;CODE FOR SELECTION APPLICATION ;CALLING CONVENTIONS ; POINT ARGP AT S1 AND TOP AT X IN S1 S2 ... SN X, WHERE ; SELAPP(N) IS IN L. SELECTION ( PERFORMED BY CSELCT IN DATA.MAC) ; KEEPS REPLACING X BY THE SEQUENCE OF SELECTION EXPRESSIONS ; X[S1], X[S1,S2], ...,X[S1,...,SN]. FINALLY, IT PUTS ; THE RESULT IN THE S1 POSITION AND RESETS TOP TO POINT TO IT. ISELAPP:MOVE ARGP,TOP ;CONSTRUCT ARGUMENT POINTER SUBI ARGP,(L) ;ARGP POINTS TO FIRST SELECTOR JRST CSELCT ;GO PERFORM SELECTION ;FOR SCOPES AND END SCOPES ;ASSUME FORSCP(N) OR ENDSCP(N) LEXEME IS IN L. WE HAVE A ;FOR FORM (FOR I _ L:S:U DO G) IN WHICH I IS THE CONTROLLED ;VARIABLE, L IS THE LOWER LIMIT, S IS THE STEP ELEMENT , U IS THE ;UPPER LIMIT, AND G IS THE BODY. ;FOR SCOPES - IN "FOR" FORMS IFORSCP:MOVE ARGP,TOP ;SET ARGP TO POINT TO CONTROLLED SUBI ARGP,2 ;VARIABLE CALL FORLCK ;CHECK "FOR" ELEMENTS ARITHMETIC & CONSTANT CALL RNGCHK ;SEE IF CONTROLLED VARIABLE IN RANGE JRST RESUM1 ;IF SO, RESUME INTERPRETATION ADDI CPM,(L) ;ELSE INCREMENT CPM BY VALUE(FORSCP(N)) SET CPM,PMF ;RESET POSITION MARKER FIELD SUBI TOP,3 ;UNSTACK "FOR" CONTROL ELEMENTS SET TOP,TOPF ;RESET TOP FIELD TRZ FF,PIR ;FORM FORMS DON'T PRINT JRST INTP1 ;CONTINUE INTERPRETATION AFTER FOR BODY ;END OF FOR SCOPE - IN "FOR" FORMS IENDFOR:CALL PNTIRQ ;PRINT VALUE OF FOR IF REQUIRED SOS ARGP,TOP ;UNSTACK THE VALUE AND MAKE ARGP SUBI ARGP,2 ; POINT TO THE CONTROLLED VAR CALL INCVAR ;INCREMENT CONTROLLED VARIABLE CALL SETUP ;RESTORE INTERP'S POINTERS CALL RNGCHK ;SEE IF CONTROLLED VARIABLE IN RANGE JRST INRNG ;IF WAS IN RANGE, GO TO INRNG SUBI TOP,3 ;POP CONTROL ELEMENTS OFF STACK SET TOP,TOPF ;RESET TOP FIELD IN CAR TRZ FF,PIR ;FORM FORMS DON'T PRINT JRST RESUME ;RESUME INTERPRETATION AFTER "FOR" BODY INRNG: HRRE L,@CL ;EXTEND SIGN OF RIGHT HALF OF ADD CPM,L ;ENDSCP LEXEME, AND ADD IT TO CPM SET CPM,PMF ;RESET POSITION MARKER FIELD IN CAR TRZ FF,PIR ;ORDINARILY DON'T PRINT SKIPE SUSPND ;SKIP IF USER DOESN'T WANT TO SUSPEND JRST USRSUS ;ELSE GO DO USER SUSPENSION (IN SUPVSR) JRST BACK ;EXECUTE SYSTEM FUNCTION ON TOP TWO STACK ELEMENTS ;WHOSE INTERNAL IDT RELATIVE ADDRESS IS IN S EXCT: MOVEM S,CFNAM ;CFNAM GETS NAME OFS MOVE AC1,IDTP ;COMPOSE SYMBOL TABLE ENTRY IN S HRRZ AC1,(AC1) ;AC1_DZADR OF IDT ADD AC1,S ;AC1_RHS(STE)=ADDRESS OF ROUTINE TO EXECUTE HRRZ AC1,(AC1) HRLI S,2 ;LHS(S)= NO. OF ARGS,RHS(S)=RELADR IN IDT SUBI TOP,1 ;MAKE TOP AND ARGP POINT TO FIRST ARGUMENT SET TOP,TOPF ;RESET TOPF OF CAR MOVE ARGP,TOP PUSHJ P,1(AC1) ;CALL SYSTEM FUNCTION PUSHJ P,SETUP ;RESTORE POINTERS MOVEM R,@TOP ;MOVE RESULT TO STACK AT TOP POPJ P, ;AND EXIT ;THEN SCOPES ; THENSC1 HAS NO ELSE CLAUSE, SO ONE PLACES A NULL LEXEME ; OVER THE BOOLEAN ON THE STACK ( THAT WAS USED IN THE IF CLAUSE ; OF THE CONDITION) IN THE EVENT THE CONDITION WAS FALSE BEFORE ; INCREMENTING THE CPM. OTHERWISE, IF THE CONDITION IS TRUE, YOU ; POP THE STACK AND PROCEED WITHOUT INCREMENTING THE CPM. ; IN THE CASE OF THNSC2'S, AN ELSE CLAUSE IS ASSUMED AND ; YOU CAN POP THE STACK IN ANY CASE. IF THE BOOLEAN IN THE IF ; CLAUSE IS FALSE, YOU INCREMENT THE CPM TO ADVANCE TO THE ; ELSE CLAUSE. ITHNS1: MOVE ARGP,TOP ;SET ARGP TO POINT TO TOP OF STACK PUSHJ P,ARGPRP ;COERCE TO CONSTANT IN R, TYPE IN T JRST .+2 ;ERROR IF NON-ATOMIC CAIE T,U.BOOL/2 ;SEE IF WAS BOOLEAN EXERR MSG(IFNBL) ;"IF" EXPRESSION WAS NOT BOOLEAN PUSHJ P,SETUP ;ELSE SET UP POINTERS JUMPE R,THNS1A ;IF FALSE GO TO THNS1A SUBI TOP,1 ;DECREMENT TOP TO POP SET TOP,TOPF ;RESET TOPF IN CAR JRST RESUME ;AND RESUME INTERPRETATION THNS1A: MOVE AC1,NULLL ;AC1_NULL LEXEME MOVEM AC1,@TOP ;PUT IT ON CAR STACK OVER BOOL TRZ FF,PIR ;TURN OFF PRINT IF REQUIRED FLAG JRST IELSSCP ;INCREMENT CPM BY VALUE OF THNSCP(N) ITHNS2: MOVE ARGP,TOP ;SET ARGP TO POINT TO TOP OF STACK PUSHJ P,ARGPRP ;COERCE TO CONSTANT IN R,R2, TYPE IN T JRST .+2 ;ERROR IF NOT ATOMIC CAIE T,U.BOOL/2 ;IF NOT BOOLEAN THEN ERROR EXERR MSG(IFNBL) ;"IF" EXPRESSION WAS NOT BOOLEAN PUSHJ P,SETUP ;RESTORE POINTERS SUBI TOP,1 ;POP TOP OF STACK SET TOP,TOPF ;RESET TOP FIELD OF CAR JUMPE R,IELSSCP ;IF FALSE FOLLOW SCOPE POINTER JRST RESUME ;RESUM INTERPRETATION ;ROUTINE TO SET UP POINTERS IN CAR. ONLY ASSUMPTION ON ENTRY IS THAT ;CAR CONTAINS PZADR OF CURRENT ACTIVATION RECORD. SETUP: HRRZ B,(CAR) ;B_DZADR OF CAR GET TOP,TOPF ;TOP_RELATIVE POINTER TO TOP OF STACK HRLI TOP,B ;INDEXED BY B GET CL,LPF ;CL_POINTER TO DZADR OF HRRZ CL,(CL) ;CURRENT LINE HRLI CL,CPM ;INDEXED BY CPM GET CPM,PMF ;SET CPM TO PMF POPJ P, ;AND EXIT ;ELSE SCOPE (AND ALSO TAIL ENDS OF THEN SCOPE CODE) IELSSCP:ADDI CPM,(L) ;INCREMENT CPM BY VALUE OF SCOPE LEXEME SET CPM,PMF ;RESET PMF JRST BACK ;AND RESUME INTERPRETATION ;CODE TO MAKE A TUPLE (INCLUDING A 0-TUPLE) FROM ;X1 X2 ... XN WITH MAKTUP(N) IN L. A CONVERSION IS ;PERFORMED TO THE FORM X1 X2 ... XN TUPLE WITH ;FNAPP(N) IN L AND A CALL ON IFNAPP IS MADE. IMAKTUP:MOVE AC1,[LXM(STAK,ID,U.TUPLE)];MAKE TUPLE LEXEME PUSHJ P,STACK ;STACK IT ON CAR STACK HRLI L,(LXM(FNAPP,0,0)) ;CHANGE MAKTUP(N) LEXEME TO FNAPP(N) LEXEME SETZM ARGP ;ZERO ARGP IN CASE WAS 0-TUPLE JRST IFNAPP ;GO CALL FUNCTION APPLICATION CODE ;FOR STATEMENTS ;THE SOURCE STRING OF THE FORM (FOR I_L:S:U DOTHRU K) , WHOSE ;POSTFIX STRING IS L I FORASS S U K FORST RPAD, IS EXECUTED ;LEFT TO RIGHT TO YIELD I S U K WITH FORST LEXEME IN L ;AT THE TIME OF ENTRY. WE COERCE THE "FOR" CONTROL ELEMENTS TO ;CONSTANTS, EXCEPT FOR THE CONTROLLED VARIABLE, AND WE VERIFY ;THAT THEY ARE ARITHMETIC. THEN WE COERCE THE TARGET LINE ;NUMBER K TO A RELOC AND CALL THE FOR STATEMENT CODE IN SUPERVISOR. IFORST: MOVE ARGP,TOP ;MAKE ARGP POINT TO CONTROLLED VARIABLE SUBI ARGP,3 CALL FORLCK ;COERCE AND CHECK "FOR" CONTROL ELEMENTS MOVE ARGP,TOP ;MAKE ARGP POINT TO TARGET K CALL ARGPRP ;COERCE TO CONSTANT AND MAKE RELOC EXERR MSG(SCFNI) ;SCOPE OF "FOR" WAS NOT INTEGER CAIE T,U.INT/2 ;ERROR IF WAS NOT INTEGER JRST .-2 CAILE R,777777 ;SEE IF K> 2^18-1 MOVEI R,377777 ;IF SO, SET LINE NUMBER TO 2^17 HRLI R,(LXM(STAK,RELOC,0)) ;SET LEFT HALF TO MAKE RELOC LEXEME MOVEM R,@TOP ;STACK ON TOP OF CAR STACK JRST FORSTX ;AND GO TO FOR STATEMENT EXIT IN SUPVSR ;FOR ASSIGNMENTS CONSIST OF NORMAL ASSIGNMENTS IN WHICH WE ;REPLACE THE RESULT IN THE CAR STACK WITH THE L-VALUE, WHICH ;HAS BEEN SAVED PRIOR TO CALLING THE ASSIGNMENT. IFORASS:MOVE AC1,@TOP ;SAVE L-VALUE FOR SAVE ;LATER RESTORATION MOVE I,@TOP ;SWITCH TOP TWO ARGUMENTS SUBI TOP,1 MOVE J,@TOP MOVEM I,@TOP ADDI TOP,1 MOVEM J,@TOP HRRZ S,IDTP ;S_DZADR OF IDT HRRZ S,(S) ;GET DEFINITION OF ASSIGNMENT ADDI S,%ASSIGN ;GET BINARY DEFINITION OF _ IN IDT MOVE S,(S) ;S_STE FOR SYSTEM ASSIGNMENT HLRZ L,S ;L_LEFT HALF OF STE CAIE L,I.SFN ;IF ASSIGNMENT NOT SYSTEM FUNCTION THEN ERROR EXERR MSG(ASGDL) ;SYSTEM FUNCTION ASSIGN NEEDED IN FOR, BUT HAS BEEN DELETED HRLI S,2 ;SET LEFT HALF OF S TO NUMBER OF ARGUMENTS SUBI TOP,1 ;SET ARGP TO POINT TO FIRST ARGUMENT,AND SET TOP,TOPF ;SET TOPF AND ARGP TO SAME. MOVE ARGP,TOP PUSHJ P,1(S) ;CALL SYSTEM FUNCTION RESTOR ;RESTORE L-VALUE IN AC1 HRRZ B,(CAR) ;RECOMPUTE DZADR OF CAR GET TOP,TOPF ;RESTORE TOP POINTER HRLI TOP,B ;INDEXED BY B MOVEM AC1,@TOP ;RESTORE L-VALUE TO STACK IN TOP POSITION JRST RESUM1 ;AND RESUME INTERPRETATON ;WHILE EXP DO FORM ;CHECKS THE VALUE OF THE EXPRESSION. IF TRUE, THE BODY ;IS EXECUTED, AFTER FLUSHING THE PREVIOUS RESULT, AND ;CHECKING FOR USER-SUSPENSION. IF FALSE, JUMP AROUND BODY. IWHLSC: MOVE ARGP,TOP ;SET ARGP TO TOP OF STACK CALL ARGPRP ;PREPARE THE ARGS CAIA ;ERROR IF NOT ATOMIC CAIE T,U.BOOL/2 ;OR IF NOT BOOLEAN EXERR MSG(WHNBL) ;WHILE NOT BOOLEAN CALL SETUP ;SETUP POINTERS SUBI TOP,1 ;FLUSH THE EXPRESSION SET TOP,TOPF ;SET THE TOP FIELD TRZ FF,PIR ;ORDINARILY DON'T PRINT JUMPE R,IELSSCP ;JUMP AROUND BODY SKIPN SUSPND ;HAS SUSPENSION BEEN REQUESTED (^C) JRST RESUME ;RESUME INTERPRETATION ADDI CPM,1 ;FUDGE THE CURRENT POSITION SET CPM,PMF ;AND THE POSITION MARKER FIELD JRST USRSUS ;GO SUSPEND ;END WHILE SCOPE IENDWHL: ADDI CPM,(L) ;INCREMENT CPM BY VALUE OF LEXEME SET CPM,PMF ;RESET POSITION MARKER CALL PNTIRQ ;PRINT VALUE OF FORM, IF REQUIRED SUBI TOP,1 ;POP OF VALUE OF FORM SET TOP,TOPF ;RESET TOP FIELD OF CAR JRST BACK ;RESUME INTERPRETATION ;REPEAT FORM UNTIL EXP ;CHECKS AND POPS THE VALUE OF THE EXPRESSION. IF FALSE, ;POP OFF OLD FORM AND JUMP BACK TO BEGINNING. IRPTSCP:CALL PNTIRQ ;PRINT VALUE OF FORM, IF REQUIRED SUBI TOP,1 ;POP OF VALUE OF FORM SET TOP,TOPF ;RESET TOP FIELD OF CAR JRST RESUME ;CONTINUE WITH REPEAT EXPR IENDRPT:MOVE ARGP,TOP ;POINT TO TOP OF STACK CALL ARGPRP ;PREPARE ARGS CAIA ;ERROR IN NOT ATOMIC CAIE T,U.BOOL/2 ;OR NOT BOOLEAN EXERR MSG(RPNBL) ;REPEAT NOT BOOLEAN CALL SETUP ;SETUP POINTERS SUBI TOP,1 ;FLUSH THE EXPRESSION SET TOP,TOPF ;SET THE TOP FIELD TRZ FF,PIR ;ORDINARILY DON'T PRINT JUMPN R,RESUME ;RESUME INTERPRETATION IF TRUE SUBI CPM,(L) ;GO BACK TO THE BEGINNING SET CPM,PMF ;SET APPROPRIATE FIELD SKIPE SUSPND ;CHECK FOR SUSPEND REQUEST JRST USRSUS ;SUSPEND JRST BACK ;GO BACK TO BEGINNING LIT END