!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ! !COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754 !FILENAME: H1CNTR.BLI !%4.11% 10 SEPTEMBER 1974 MGM/FLD/KR/GJB %4.01,4.02,4.05,4.09,4.11% GLOBAL BIND H1CNV=18; !MODULE VERSION NUMBER ! REVISION HISTORY ! 9-21-77 ROUTINE GSE0 IS MODIFIED TO REMOVE CAI MACHINE ! FROM MACRO LISTING. IT IS A NOP. ! ! 7-15_77 ROUTINE GSE5 IS MODIFIED TO HAVE NO OPTIMIZATION ! IN SELECT EXPRESSION WHEN TESN IS PROCESSED. ! ! GENERAL DOCUMENTATION FOR CONTROL.BLI ! ! THIS MODULE IS CONCERNED WITH MANIPULATING THE LINKED-LISTS ! WHICH CONTAIN THE CODE AND WITH GENERATING THE CODE FOR CONTROL ! EXPRESSIONS. THE READER IS ADVISED TO READ THE MODULE LOLSTPKG ! BEFORE OR IN PARALLEL WITH THIS ONE. THE FORMATS OF THE LIST ! HEADERS AND ELEMENTS ARE EXPLAINED THERE. ! ! EACH CONTROL ENVIRONMENT GENERATES A SKELETON FROM WHICH ! THE CODE FOR THAT CONTROL EXPRESSION IS SUSPENDED. THE GLOBAL VARIABLE ! CODEPTR IS ALWAYS LEFT POINTING AT THE HEADER FROM WHICH SUBSEQUENT ! CODE IS TO BE GENERATED. IT IS THE RESPONSIBILITY OF THE ROUTINES IN ! THIS MODULE TO POSITION CODEPTR AT THE APPROPRIATE HEADER. ! ! IT IS PROBABLY EASIEST TO INDOCTRINATE THE READER INTO THE ! TYPICAL ACTIVITY OF THESE ROUTINES BY AN EXAMPLE: ! ! ... BEGIN LOCAL A,B; A_F(); ... ; .B END ... ! ! (WHILE READING THIS EXAMPLE YOU WILL NEED TO REFER TO THE FIRST THREE ! ROUTINES OF THIS MODULE.) ! ! WHEN SA(SYNTAX ANALYZER) ENCOUNTERS "BEGIN" FOLLOWED BY A ! DECLARATION IT CALLS GCE0 WITH A PARAMETER OF 1. GCE0 BEGINS BY CREATING ! A SKELETON CONSISTING OF A HEADER AND 4 SUBHEADERS: ! ! \ / ! \ / ! \----/ ! !BEC ! ! !0 ! ! /----\ ! / \ ! /-------------/ \-------------\ ! / \ ! /----\ /----\ /----\ /----\ ! !BEC !\----/!BEC !\----/!BEC !\----/!BEC ! ! !1 ! !2 ! !3 ! !4 ! ! ---- ---- ---- ---- ! ! ! ! THIS HAS THE SIDE-EFFECT OF LEAVING CODEPTR POINTING TO THE ! HEADER. (NOTE: THROUGHOUT THE MODULE THE POSITION OF CODEPTR IS INDICATED ! BY COMMENTS OF THE FORM: ! --> X WHERE X CORRESPONDS TO A POSITION ! ON THE RELEVANT SKELETON). CODEPTR IS THEN MOVED TO POINT TO SUBHEADER #1 ! AND FROM THERE A CODE-CLASS HEADER IS SUSPENDED. A NOOP IS GENERATED ! (GLICH TO AVOID BACKWARD JUMPS PASSING BEYOND A BLOCK). THEN CODEPTR ! IS MOVED TO SUBHEADER #2 (BODY OF THE BLOCK). AT THIS POINT ANY REGISTERS ! WHICH ARE IN USE ARE SAVED. THEN A HEADER OF TYPE CURRENTC IS ! GENERATED. THIS IS USED TO DISTINGUISH THE CODE FOR THE PRESENT EXPRESSION ! IN THE COMPOUND EXPRESSION FROM THE PRECEDING. FINALLY A CODEC HEADER ! IS CREATED FROM WHICH THE CODE OF THE FIRST EXPRESSION WILL BE SUSPENDED. ! ! NOW THE DECLARATION PROCESSOR PROCESSES THE DECLARATIONS OF THE ! BLOCK AND WHEN THE ";" FOLLOWING A_F() IS ENCOUNTERED, GCE1 IS CALLED ! WITH THE LEXEME FOR THE VALUE OF THE EXPRESSION. NOTE THAT CODE FOR ! THE ROUTINE CALL AND THE STORE HAS BEEN HUNG OFF THE CODEC HEADER ! GENERATED IN GCE0. GCE1 FIRST CLEARS THE TRCT LIST OF THE VALUE REGISTER ! IF IT IS INVOLVED IN THE VALUE LEXEME SINCE SIDE-EFFECTS POTENTIALLY ! OCCURED. NEXT THE USE OF ANY REGISTER INVOLVED IN THE VALUE LEXEME ! IS DECREASED (DULEX) SINCE THE FOLLOWING SEMICOLON MEANS THE VALUE WON'T ! BE USED. THE CODEPTR IS MOVED TO THE CURRENTC HEADER. THE LIST ! (POTENTIALLY) OF HEADERS SUSPENDED FROM THE CTC IS SCANNED FOR THOSE ! OF TYPE CONVEY WHICH ARE DISCARDED. A CONVEY HEADER IS ONE WHICH CONTAINS ! THE CODE NECESSARY TO LOAD VREG WITH THE RESULT OF A CONTROL EXPRESSION. IF ! THE VALUE OF THE CONTROL EXPRESSION IS NOT NEEDED, THEN THIS CODE IS ! DISCARDED BY LOSECONV. FOR EXAMPLE: ! ! ...; IF .A THEN C_.B; ... ! ! THE VALUE OF THE IF-EXPRESSION IS NOT USED. THERE MAY ALSO BE HEADERS OF TYPE ! RELC (RELATIONAL-EXPRESSION-CLASS: SEE GREL AND GBREL IN H2ARITH) HANGING ! FROM CTC. IF SO THESE ARE PROMOTED TO TYPE CODEC (SEE PROMOTE IN LOLSTPKG). ! THIS LEAVES CTC EMPTY AND WE CONCLUDE GCE1 BY CREATING A NEW CODEC HEADER ! BENEATH IT. ! ! WHEN SA ENCOUNTERS THE "END", IT CALLS GCE2 WITH THE VALUE ! LEXEME X AND -(# OF LOCALS + 1). FIRST GCE2 CONVEYS THE VALUE LEXEME. ! THAT IS IT GENERATES (IF NECESSARY) CODE TO LOAD VREG WITH X SUSPENDING ! THE CODE FROM A CONVEYC HEADER SO THAT IF THE VALUE IS NOT NEEDED (I.E. ! SEMI-COLON AFTER THE END) THIS CODE CAN BE DISCARDED. GCE2 NOW MIMICS ! GCE1 (PROMOTE-SYPHON) BUT THEN MOVES TO SUBHEADER #2 AND ERASES CTC. ! THEN IT SCANS SUBHEADER #2 FOR ANY XBLOCKC HEADERS AND PROMOTES THEM ! TO CONVEYS. THEN CODEPTR MOVES TO SUBHEADER #3 AND CLASSIFIES IT AS A ! LABEL. NOTE THAT ANY JUMP GENERATED INSIDE THE BODY TO EXIT THIS BLOCK ! WAS MADE TO THIS CELL. ALSO ANY EXIT OF THIS BLOCK TO SOME HIGHER ! CONTROL ENVIRONMENT GENERATED AN XCT OF THIS CELL WHICH SUBSEQUENTLY ! WILL CONTAIN (POTENTIALLY) THE SUBTRACT FROM THE STACK POINTER FOR ! LOCALS OF THE BLOCK. CLASSLAB HAS THE SIDE-EFFECT OF MOVING CODEPTR ! TO SUBHEADER #4. A CODEC CELL IS PUSHED AND THE SUBTRACT IS GENERATED. ! CODEPTR IS SET TO THE CODEC CELL SUPENDED FROM SUBHEADER #1 WHERE THE ! ADD IS GENERATED. THEN CODEPTR IS MOVED TO THE MAIN HEADER, BEC #0. ! THE SKELETON IS REMOVED (NOTE: HEADERS BEC #0, #1, #2, #4 DISAPPEAR BUT ! BEC #3 WHICH IS NOW LABELC REMAINS). THEN GCE2 RETURNS A LEXEME ! REPRESENTING VREG (FROM CONVEY) TO SA WHERE IT BECOMES THE VALUE OF SYM. ! ! HOPEFULLY THIS DISCUSSION BY EXAMPLE WILL GIVE THE READER ! AT LEAST A VAGUE FEELING FOR WHAT TRANSPIRES IN ALL THE CONTROL CLASSES. ! YOU WILL NOTE THAT IN MANY OF THE CLASSES THE MAIN HEADER (#0) IS A ! MULTI-WORD (>2) CELL WHICH CONTAINS INFORMATION NEEDED BY SEVERAL ! OF THE CONTROL ROUTINES OF THE CLASS BUT LOCAL TO THIS PARTICULAR ! INSTANCE OF THE CONTROL EXPRESSION. ! ! ! GLOBALS USED BY THIS MODULE: ! ! CODEPTR POINTS TO HEADER WHERE CODE IS BEING GENERATED ! SFORLABEL BOOLEAN SET WHEN SEARCH BACKWARDS FOR A LABELC ! CELL TO INSURE THAT A LABELC CELL IS FOUND ! NOSAVREG # OF REGISTERS SAVED IN GPROLOG (USED BY GEPILOG) ! PROGRAM INDEX OF CELL WHICH HOLDS CODE OF OUTER BLOCK FORWARD CONVEY,GCE0,GCE1,GCE2,GCOST0,GCOST1,GCOST2,GCOST3,GCOST4; FORWARD GCUJUMP,GDWU0,GDWU1,GDWU2,GESCAPE,GEXIT,GID0,GID1,GID2,GID3; FORWARD GITE0,GITE1,GITE2,GITE3,GRETURN,GUJUMP,GWUD0,GWUD1,GWUD2,LABLE; FORWARD PUSHMSET,PUSHNSET,PUSHSET; FORWARD SGC12,SGC34,SGSE12,SGSE3,SINGINSTP; % PARENTHESES ( E1 ; ... ; EN ) ^ ^ ^ ^ ^ ^ ^ ^ GCE0(0) ------------^ ^ ^ ^ ^ ^ ^ GCE1(E1) ----------------^-----^ ^ ^ GCE2(EN,0) -------------------------^ BEGIN E1 ; ... ; EN END ^ ^ ^ ^ ^ ^ ^ ^ GCE0(1) ------------^ ^ ^ ^ ^ ^ ^ GCE1(E1) ----------------^-----^ ^ ^ GCE2(EN,--) -------------------------^ SKELETON 0 BEC 0 CMPEXC 0.2 BOOLEAN: CMPEXC'S EXIT LABEL REF'D 1 LOCAL ADD 1 BODY 2 BODY 2 LABEL 3 LABEL 4 LOCAL SUB % GLOBAL ROUTINE GCE0(N)= % LEFT PARENTHESIS/BEGIN MET. % BEGIN IF .N THEN BEGIN LOCAL A; TEMPLATE(2,BEC,4); ! --> 0 ACPDT(); ! --> 1 PUSHCODE(); ! --> \1 CODE(JUMP,0,0,0); ACPR2(); ! --> 2 PUSHCODE(); ! --> \2 INCR I FROM 16 TO 31 DO IF .RT[.I] NEQ 0 AND NOT .RT[.I] THEN BEGIN DUMPREG(A_.RT[.I]); RELREG(.A,1) END; END ELSE BEGIN TEMPLATE(2,CMPEXC,2); ! --> 0 ACPDT(); ! --> 1 PUSHCODE() ! --> \1 END; FOLLCPH(0,CURRENTC,0); ! --> CTC CT[.CODEPTR,1]_#40; PUSHCODE() ! --> \CTC END; GLOBAL ROUTINE GCE1(X)= % SEMICOLON MET WITHIN PARENTHESES. % BEGIN IF .RT[.X] EQL .VREG THEN CLEARONE(RT[.X]); DULEX(.X); ACPR1(); ! --> CTC LOSECONV(); PROMOTE(1^RELC); SYPHON(.CODEPTR); PUSHCODE() ! --> \CTC END; GLOBAL ROUTINE GCE2(X,N)= ! RIGHT PARENTHESIS OR END MET ! N=0 COMPOUND EXPRESSION ! N=-1 LOCAL-LESS BLOCK ! N<-1 BLOCK WITH -(N+1) LOCALS ! BEGIN LOCAL B; ! BOOLEAN INDICATING THE LABEL (CMPEXC #2) HAS ! BEEN REFERENCED. IF THE LABEL HAS NOT BEEN ! REF'D, WE DISCARD IT AT THE END OF GCE2 TO ! FACILITATE OPTIMIZATIONS WHICH SEARCH BACKWARD ! AND WOULD OTHERWISE STOP AT A LABEL. ALSO ! DETERMINES WHETHER THE VALUE OF CMPEXC MUST ! BY CONVEYED IN VREG. IF .N LSS 0 OR (B_IF .N EQL 0 THEN .CT[LOCATE(CMPEXC,0),2]) THEN X_CONVEY(.X); IF .N LSS 0 THEN IF .CT[LOCATE(BEC,0),2] THEN SESTOG_.SESTOG OR 8; ACPR1(); ! --> CTC PROMOTE(1^RELC); SYPHON(.CODEPTR); ACPR1(); ! --> 2 ERASEBOT(.CODEPTR); PROMOTE(IF .N EQL 0 THEN 1^XCMPEXC ELSE 1^XBLOCKC); IF .N LSS -1 THEN BEGIN LOCAL C,L; ACPR1(); ! --> 3 CLASSLAB(); ! --> 4 C_.CODEPTR; PUSHCODE(); ! --> \4 CODE(SUB,.SREG,L_LITA(LITLEXEME(((-.N)-1)*#1000001)),0); CODEPTR_.CT[LOCATE(BEC,1),1]; ! --> \1 EMPTY(.CODEPTR); CODE(ADD,.SREG,.L,0); CODEPTR_.C; ! --> 4 ACPR1(); ! --> 0 END ELSE IF .N EQL -1 THEN BEGIN EMPTY(.CT[LOCATE(BEC,1),1]); ACPR1(); ! --> 3 CLASSLAB(); ! --> 4 PUSHCODE(); ! --> \4 CODE(#320,0,0,0); ACPR2(); ! --> 0 END ELSE BEGIN ACPR1(); ! --> 2 IF .B THEN CLASSLAB() ELSE ACPR1(); ! --> 0 IF NOT .B THEN ERASEBOT(.CODEPTR) ELSE SESTOG_.SESTOG OR 8 END; UNTEMPLATE(); IF .CT[.CODEPTR,0] NEQ CODEC THEN PUSHCODE(); .X END; % DO E1 WHILE E2 ^ ^ ^ ^ ^ ^ GDWU0() -------------^ ^ ^ ^ ^ GDWU1(E1) --------------^ ^ ^ GDWU2(E2,1) ---------------------^ DO E1 UNTIL E2 ^ ^ ^ ^ ^ ^ GDWU0() -------------^ ^ ^ ^ ^ GDWU1(E1) --------------^ ^ ^ GDWU2(E2,0) ---------------------^ SKELETON 0 DWU 0.3 INDEX AND SUBCLASS OF REAL LABEL 1 LABEL 2 DO 3 WHILE/UNTIL 4 LABEL % GLOBAL ROUTINE GDWU0= % DO HAS BEEN MET COMMENCING A DO-WHILE/UNTIL. % ! THE ROUTINE SWALABEL WHICH IS CALLED HERE AND IN GWUD0 SEARCHES ! BACK FROM THE DWU HEADER TO SEE IF THIS CELL IS PRECEDED BY A LABEL ! CELL WITH NO INTERVENING CODE. IF SO, THE LABEL (DWUC #1) IS ! DISCARDED. THE BACKWARD JUMP AT THE END OF DWUC #3 IS THEN BACK ! TO THIS LABEL. THIS INSURES TO THE LATER OPTIMIZING PASS IN FLATFUNC ! THAT ALL BACKWARD REFERENCES TO A LIST OF CONTIGUOUS LABELS ARE ! ALWAYS TO THE LAST SUCH LABEL. GWUD2 RESOTRES THE SUBCLASS NUMBER ! IF IT WAS CHANGED. BEGIN FREEVREG(); TEMPLATE(2,DWUC,4); ! --> 0 SWALABEL(); ! --> 2 PUSHCODE(); ! --> \2 END; GLOBAL ROUTINE GDWU1(X)= % DO CLAUSE COMPLETED WITHIN A DO-WHILE/UNTIL. % BEGIN IF .RT[.X] EQL .VREG THEN CLEARONE(RT[.X]); DULEX(.X); ACPR1(); ! --> 2 LOSECONV(); PROMOTE(1^RELC OR 1^XLOOPC); ACPR1(); ! --> 3 PUSHCODE(); ! --> \3 END; GLOBAL ROUTINE GDWU2(X,N)= % WHILE(N=1)/UNTIL(N=0) CLAUSE OF DO-WHILE/UNTIL COMPLETED. % BEGIN LOCAL C; SFORLABEL_1; GCUJUMP(.X,LOCATE(DWUC,1),.N,1); SFORLABEL_0; ACPR1(); ! --> 3 PROMOTE(1^CNVEYC OR 1^RELC); ACPDB(); ! --> \3 X_CONVEY(LITLEXEME(-1)); ACPR2(); ! --> 4 CLASSLAB(); ! --> 0 IF (C_.CT[.CODEPTR,3]) GTR 1 THEN (.CT[.CODEPTR,3]+1)_.C; UNTEMPLATE(); .X END; % WHILE/UNTIL-DO WHILE E1 DO E2 ^ ^ ^ ^ ^ ^ GWUD0() ----------------^ ^ ^ ^ ^ GWUD1(E1,0) ---------------^ ^ ^ GWUD2(E2) -----------------------^ UNTIL E1 DO E2 ^ ^ ^ ^ ^ ^ GWUD0() ----------------^ ^ ^ ^ ^ GWUD1(E1,1) ---------------^ ^ ^ GWUD2(E2) -----------------------^ SKELETON 0 WUD 0.2 VALUE RETURNED FROM GCUJUMP 1 LABEL 2 WHILE 3 DO 4 LABEL 5 -1 6 LABEL % GLOBAL ROUTINE GWUD0= % WHILE/UNTIL HAS BEEN MET COMMENCING A WHILE/UNTIL-DO. % BEGIN FREEVREG(); TEMPLATE(2,WUDC,6); ! --> 0 SWALABEL(); ! --> 2 PUSHCODE(); ! --> \2 END; GLOBAL ROUTINE GWUD1(X,N)= % WHILE(N=0)/UNTIL(N=1) CLAUSE COMPLETED WITHIN A WHILE/UNTIL-DO. % ! THE ROUTINE DROP (SEE LOLSTPKG) IS CALLED HERE TO DISCARD: ! (1) THE DO PORTION IF WE HAVE A WHILE 0 OR UNTIL 1 ! OR ! (2) THE CONVEY OF -1 IN THE CASES WHILE 1 OR UNTIL 0. ! NOTE THAT THIS DECISION IS DETERMINED BY THE VALUE RETURNED FROM ! GCUJUMP (LATER IN THIS MODULE BEGIN CT[LOCATE(WUDC,0),2]_GCUJUMP(.X,LOCATE(WUDC,4),.N,0); ACPR1(); ! --> 2 PROMOTE(1^CNVEYC OR 1^RELC); ACPR1(); ! --> 3 PUSHCODE(); ! --> \3 END; GLOBAL ROUTINE GWUD2(X)= % DO CLAUSE COMPLETED WITHIN A WHILE/UNTIL-DO. % BEGIN LOCAL C; SFORLABEL_1; GUJUMP(LOCATE(WUDC,1)); SFORLABEL_0; IF .RT[.X] EQL .VREG THEN CLEARONE(RT[.X]); DULEX(.X); ACPR1(); ! --> 3 LOSECONV(); PROMOTE(1^RELC OR 1^XLOOPC); ACPR1(); ! --> 4 CLASSLAB(); ! --> 5 PUSHCODE(); ! --> \5 X_CONVEY(LITLEXEME(-1)); ACPR2(); ! --> 6 CLASSLAB(); ! --> 0 DROP(CASE .CT[.CODEPTR,2] OF SET 1^4 OR 1^5; 1^3 OR 1^4 OR 1^6; 0 TES); IF (C_.CT[.CODEPTR,3]) GTR 1 THEN (.CT[.CODEPTR,3]+1)_.C; UNTEMPLATE(); .X END; % INCR/DECR-FROM-TO-DO INCR N FROM E1 TO E2 BY E3 DO E4 ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ GID0(N) --------------^ ^ ^ ^ ^ ^ ^ ^ ^ GID1(E1) ---------------------^ ^ ^ ^ ^ ^ ^ GID2(E2) ---------------------------^ ^ ^ ^ ^ GID3(E3,0) -------------------------------^ ^ ^ GID4(E4,0) -------------------------------------^ DECR N FROM E1 TO E2 BY E3 DO E4 ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ GID0(N) --------------^ ^ ^ ^ ^ ^ ^ ^ ^ GID1(E1) ---------------------^ ^ ^ ^ ^ ^ ^ GID2(E2) ---------------------------^ ^ ^ ^ ^ GID3(E3,1) -------------------------------^ ^ ^ GID4(E4,1) -------------------------------------^ SKELETON 0 IDFTD 0.2 INCR/DECR REGISTER LEXEME 0.3 TO-EXPRESSION LEXEME 0.4 BY-EXPRESSION LEXEME 0.5 BOOLEAN: LITERAL FROM-EXPRESSION 0.6 BOOLEAN: VALUE OF LITERAL FROM-EXPRESSION 0.7 BOOLEAN: BODY CAN BE DISCARDED 1 INITIAL 2 LABEL 3 DO 4 LABEL 5 SETO 6 LABEL % MACRO IDREGLEXEME=CT[.H,2]$, LITERALFROM=CT[.H,5]$, FROMVALUE=CT[.H,6]$, TOLEXEME=CT[.H,3]$, BYLEXEME=CT[.H,4]$, DROPBODY=CT[.H,7]$; GLOBAL ROUTINE GID0(X)= % INDEX OF INCR/DECR-FROM-TO-DO MET. % BEGIN FREEVREG(); TEMPLATE(4,IDFTDC,6); ! --> 0 CT[.CODEPTR,2]_.X; ACPDT(); ! --> 1 PUSHCODE(); ! --> \1 END; GLOBAL ROUTINE GID1(X)= % FROM CLAUSE OF INCR/DECR-FROM-TO-DO COMPLETED. % BEGIN REGISTER H; H_LOCATE(IDFTDC,0); DULEX(GSTO(.IDREGLEXEME,.X)); IF (LITERALFROM_LITP(.X)) THEN FROMVALUE_LITV(.X); ACPR1(); ! --> 1 PROMOTE(1^CNVEYC OR 1^RELC); ACPDB(); ! --> \1 END; GLOBAL ROUTINE GID2(X)= !THE TO-CLAUSE HAS BEEN COMPLETED IN AN INCR-DECR LOOP BEGIN REGISTER H; H_LOCATE(IDFTDC,0); IF LITP(.X) THEN TOLEXEME_.X ELSE DULEX(GSTO(TOLEXEME_GENLOCAL(),.X)); ACPR1(); ! --> 1 PROMOTE(1^CNVEYC OR 1^RELC); ACPDB() ! --> \1 END; GLOBAL ROUTINE GID3(X,N)= !BY CLAUSE IN AN INCR(N=0)/DECR(N=1) LOOP COMPLETED BEGIN REGISTER IDREG,TOVALUE,BYVALUE,H; LOCAL CPTRSAV,OPCODE; H_LOCATE(IDFTDC,0); IDREG_LITV(.IDREGLEXEME) AND #17; IF LITP(.X) THEN BYLEXEME_.X ELSE DULEX(GSTO(BYLEXEME_GENLOCAL(),.X)); ACPR1(); ! --> 1 PROMOTE(1^CNVEYC OR 1^RELC); ACPR1(); ! --> 2 CLASSLAB(); ! --> 3 PUSHCODE(); ! --> \3 IF LITP(.TOLEXEME) THEN BEGIN TOVALUE_LITV(.TOLEXEME); IF .LITERALFROM THEN DROPBODY_ CASE .N OF SET .FROMVALUE GTR .TOVALUE; .FROMVALUE LSS .TOVALUE TES; OPCODE_ IF LITP(.X) THEN BEGIN BYVALUE_LITV(.X); IF ABS(.BYVALUE) NEQ 1 THEN EXITCOMPOUND; IF ABS(.TOVALUE) GTR 1 THEN EXITCOMPOUND; IF .TOVALUE EQL 0 THEN IF ABS(.BYVALUE) EQL 1 THEN EXITCOMPOUND CASE .N OF SET JUMPG; JUMPL TES; IF .TOVALUE EQL 1 THEN EXITCOMPOUND IF (.BYVALUE EQL -1) EQL (.N EQL 0) THEN JUMPLE ELSE 0; IF (.BYVALUE EQL 1) EQL (.N EQL 0) THEN JUMPGE END ELSE 0; IF .OPCODE NEQ 0 THEN BEGIN IF NOT .LITERALFROM THEN BEGIN CPTRSAV_.CODEPTR; CODEPTR_.CT[.H,1]; PUSHCODE(); CODE(.OPCODE,.IDREG,LABLE(LOCATE(IDFTDC,4)),0); CODEPTR_.CPTRSAV END END ELSE IF SMPOSLITVP(.TOVALUE) THEN BEGIN CODE(CAILE+2*.N,.IDREG,.TOVALUE,0); GUJUMP(LOCATE(IDFTDC,4)) END ELSE BEGIN CODE(CAMLE+2*.N,.IDREG,LITA(.TOLEXEME),0); GUJUMP(LOCATE(IDFTDC,4)) END END ELSE BEGIN CODE(CAMLE+2*.N,.IDREG,GMA(GAT(.TOLEXEME)),0); GUJUMP(LOCATE(IDFTDC,4)) END END; GLOBAL ROUTINE GID4(X,N)= !DO CLAUSE COMPLETED IN AN INCR(N=0)/DECR(N=1) LOOP BEGIN LOCAL IDREG, !ADDRESS OF INCR REGISTER BYVALUE, !VALUE OF LITERAL BY-EXPRESSION OPCODE; !FUNCTION FOR BACKWARD JUMP AND INCR-DECR REGISTER R,H; MACRO ADDONECASE=R<0,1>$, !BY-EXPRESSION HAS LITERAL VALUE OF 1 LITERALBY=R<1,1>$, !LITERAL BY-EXPRESSION AOJSOJCASE=R<2,1>$; !CAN GENERATE AOJ-SOJ TYPE JUMP IF .RT[.X] EQL .VREG THEN CLEARONE(RT[.X]); DULEX(.X); H_LOCATE(IDFTDC,0); IDREG_LITV(.IDREGLEXEME) AND #17; AOJSOJCASE_ IF (LITERALBY_LITP(.BYLEXEME)) THEN BEGIN BYVALUE_LITV(.BYLEXEME); (ADDONECASE_.BYVALUE EQL 1) OR (.BYVALUE EQL -1) END; SFORLABEL_1; IF .LITERALBY THEN IF .AOJSOJCASE THEN (OPCODE_ BEGIN REGISTER TOVALUE; IF LITP(.TOLEXEME) THEN BEGIN TOVALUE_LITV(.TOLEXEME); IF .TOVALUE EQL 0 THEN EXITBLOCK IF .N EQL .ADDONECASE THEN SOJGE ELSE AOJLE; IF .TOVALUE EQL 1 THEN IF .N EQL .ADDONECASE THEN EXITBLOCK SOJG; IF .TOVALUE EQL -1 THEN IF .N NEQ .ADDONECASE THEN EXITBLOCK AOJL; END; IF .N EQL .ADDONECASE THEN SOJA ELSE AOJA END; CODE(.OPCODE,.IDREG,LABLE(LOCATE(IDFTDC,2)),0)) ELSE BEGIN IF SMPOSLITVP(.BYVALUE) THEN CODE(IF .N THEN SUBI ELSE ADDI,.IDREG,.BYVALUE,0) ELSE IF SMNEGLITVP(.BYVALUE) THEN CODE(IF .N THEN ADDI ELSE SUBI,.IDREG,-.BYVALUE,0) ELSE CODE(IF .N THEN SUB ELSE ADD,.IDREG,LITA(.BYLEXEME),0); GUJUMP(LOCATE(IDFTDC,2)) END ELSE BEGIN CODE(IF .N THEN SUB ELSE ADD,.IDREG,GMA(GAT(.BYLEXEME)),0); GUJUMP(LOCATE(IDFTDC,2)) END; SFORLABEL_0; ACPR1(); ! --> 3 LOSECONV(); PROMOTE(1^RELC OR 1^XLOOPC); ACPR1(); ! --> 4 CLASSLAB(); ! --> 5 PUSHCODE(); ! --> \5 X_CONVEY(LITLEXEME(-1)); ACPR2(); ! --> 6 CLASSLAB(); ! --> 0 IF .DROPBODY THEN DROP(1^2 OR 1^3 OR 1^4 OR 1^6); UNTEMPLATE(); .X END; % IF-THEN-ELSE IF E1 THEN E2 ELSE E3 ^ ^ ^ ^ ^ ^ ^ ^ GITE0() -------------^ ^ ^ ^ ^ ^ ^ GITE1(E1) --------------^ ^ ^ ^ ^ GITE2(E2) ----------------------^ ^ ^ GITE3(E3) ------------------------------^ SKELETON 0 ITE 1 IF 2 THEN 3 LABEL 4 ELSE 5 LABEL % GLOBAL ROUTINE GITE0= % IF HAS BEEN MET COMMENCING AN IF-THEN-ELSE. % BEGIN TEMPLATE(1,ITEC,5); ! --> 0 ACPDT(); ! --> 1 PUSHCODE(); ! --> \1 END; MACRO GCASEJMP(DEST)= CODE(JRST,0,(DEST) OR CASEJMPRELOC^30,0)$; ROUTINE GSUJUMP(X,J)= % THIS ROUTINE GENERATES A JRST INSTRUCTION FOLLOWING THE 'BOOLEAN' PART OF AN IFSKIP. CALL DULEX(.X) SINCE WE REALLY DON'T NEED THE VALUE OF THE EXPRESSION. THE JRST IS FLAGGED AS A CASE JUMP TO PREVENT FLATFUNC FROM OPTIMIZING IT AWAY. % BEGIN IF .FREEVHEADER LSS 0 THEN BEGIN FREEVHEADER_FOLLCPH(0,CODEC,0); FOLLCPH(0,CODEC,0) END; DULEX(.X); GCASEJMP(.J) END; GLOBAL ROUTINE GITE1(X,TOG)= % IF CLAUSE COMPLETED WITHIN IF-THEN-ELSE. % !TOG=0 --> IF, TOG=1 --> IFSKIP !THE MANIPULATION HERE FOR POSTPONING THE CALL ON FREEVREG IS !TO INSURE OPTIMAL CODE GENERATION FOR THE CASES "IF 0" AND "IF 1" BEGIN FREEVHEADER_-1; IF .TOG THEN GSUJUMP (.X,LOCATE(ITEC,3)) ELSE GCUJUMP (.X,LOCATE(ITEC,3),0,1); ACPR1(); ! --> 1 PROMOTE(1^CNVEYC OR 1^RELC); CODEPTR_.FREEVHEADER; FREEVREG(); CODEPTR_LOCATE(ITEC,2); ! --> 2 FREEVHEADER_0; PUSHCODE(); ! --> \2 END; GLOBAL ROUTINE GITE2(X)= % THEN CLAUSE COMPLETED WITHIN AN IF-THEN-ELSE. % BEGIN REGISTER CNVYIND,MUSTPROMOTE,I; CONVEY(.X); ACPR1(); ! --> 2 PROMOTE(1^RELC OR 1^XCONDC); !!!THE FOLLOWING 9 LINES OF CODE ARE NECESSARY TO INSURE THAT WE !!!DO NOT BUILD A EMPTY THEN CLAUSE. I_.CT[.CODEPTR,1]; MUSTPROMOTE_0; UNTIL .I EQL .CODEPTR DO BEGIN IF NOT (NULL(.I) OR ALLNOS(.I)) THEN IF .CT[.I,0] EQL CODEC THEN EXITLOOP(MUSTPROMOTE_0) ELSE IF .CT[.I,0] EQL CNVEYC THEN (CNVYIND_.I; MUSTPROMOTE_1); I_.CT[.I,0] END; IF .MUSTPROMOTE THEN CT[.CNVYIND,0]_CODEC; ACPDB(); ! --> \2 GUJUMP(LOCATE(ITEC,5)); ACPR2(); ! --> 3 CLASSLAB(); ! --> 4 PUSHCODE(); ! --> \4 END; GLOBAL ROUTINE GITE3(X)= % ELSE CLAUSE COMPLETED WITHIN AN IF-THEN-ELSE. % BEGIN X_CONVEY(.X); ACPR1(); ! --> 4 PROMOTE(1^RELC OR 1^XCONDC); ACPR1(); ! --> 5 CLASSLAB(); ! --> 0 UNTEMPLATE(); .X END; % CASE-OF-SET-TES CASE E1, ... ,EN OF SET S1; ... ;SM TES ^ ^ ^ ^ ^ GCOST0()-------^ ^ ^ ^ ^ ^ ^ ^ ^ GCOST1(E1)----------^ ^ ^ ^ ^ ^ ^ GCOST2(EN,N)------------------^ ^ ^ ^ ^ GCOST3(S1)-----------------------------^ ^ ^ GCOST4(SM)----------------------------------------^ SKELETONS: SINGLE-SELECTOR: MULTI-SELECTOR: 0 COST 0 COST 0.2 NOT USED 0.2 COUNTREG INFO. 0.3 BOOLEAN:MULTI-SEL 0.3 BOOLEAN:MULTI-SEL 1 SELECTOR 1 SELECTOR SET 2 NOT-USED 2 REGS OF SELECTORS/LABEL 3 INDIRECT JUMP 3 INDIRECT JUMP 4 LABEL 4 LABEL 5 JUMP TABLE 5 JUMPTABLE 6 SET-TES 6 SET-TES 7 LABEL 7 LABEL SET ELEMENT: SET ELEMENT: 0 SET 0 SET 1 LABEL 1 LABEL 2 SET CODE 2 SET CODE 3 LABEL 4 AOJA % MACRO MULTISELECTOR=CT[.H,3]$, COUNTREGADDR=CT[.H,2]$, COUNTREGNAME=CT[.H,2]$; ! TO HELP IN FOLLOWING THESE ROUTINES FOR THE CASE STATEMENT, WE ! INCLUDE SAMPLE CODE FOR THE TWO TYPES: ! ! A_CASE .B OF SET .B+.C; F(); 3; G(.E) TES ! ! ! MOVE 04,B ! XCT $S,L1426(04) ! JRST $S,L1230 ! L1426: JRST $S,L1414 ! PUSHJ $S,F ! MOVEI $V,3 ! JRST $S,L1446 ! L1414: ADD 04,C ! MOVE $V,4 ! JRST $S,L1230 ! L1446: PUSH $S,E ! PUSHJ $S,G ! SUB $S,[000001,,000001] ! L1230: MOVEM $V,A ! ! ! A_CASE .B,.C+.D,F() OF SET G(); .A*.B; .D*F(.A) TES ! ! ! MOVE 04,B ! MOVEM 04,1($F) ! MOVE 05,D ! ADD 05,C ! MOVEM 05,2($F) ! PUSHJ $S,F ! MOVEM $V,3($F) ! SETOM $S,4($F) ! MOVEI 06,1($F) ! L1260: MOVE 07,0(06) ! JRST $S,@L1322(07) ! JRST $S,L1420 ! L1322: JRST $S,L1306 ! JRST $S,L1356 ! JRST $S,L1360 ! L1306: MOVEM 06,5($F) ! PUSHJ $S,G ! MOVE 06,5($F) ! AOJA 06,L1260 ^^^ ! L1356: MOVE $V,B ! IMUL $V,A ! AOJA 06,L1260 ^^^ ! L1360: PUSH $S,A ! MOVEM 06,6($F) ! PUSHJ $S,F ! SUB $S,[000001,,000001] ! IMUL $V,D ! MOVE 06,6($F) ! AOJA 06,L1260 ^^^ ! L1420: MOVEM $V,A GLOBAL ROUTINE GCOST0= ! CASE HAS BEEN MET COMMENCING CASE-OF-SET-TES BEGIN TEMPLATE(2,COSTC,7); ! --> C0 ACPDT(); ! --> C1 PUSHCPH(SELELC); ! --> SLC CT[.CODEPTR,1]_#40; PUSHCODE() ! --> \SLC END; ROUTINE SINGINSTP(H)= !USED TO TEST IF CODE HANGING FROM CT[.H,0] CONTAINS ONLY ONE !INSTRUCTION. PREDICATE IS TRUE IFF RIGHT HALF OF RETURNED VALUE IS A 1. !IF TRUE, THE LEFT HALF CONTAINS INDEX OF THE INSTRUCTION. BEGIN REGISTER C,I; C_0; I_.CT[.H,1]; UNTIL .I EQL .H DO BEGIN IF .CT[.I,0] THEN C_.C+SINGINSTP(.I) ELSE IF .CT[.I,1] NEQ 0 THEN C_.C+(.I^18 OR 1); IF .C GTR 1 THEN BREAK ELSE I_.CT[.I,0] END; .C END; GLOBAL ROUTINE GCOST1(E)= ! COMMA ENCOUNTERED IN THE SELECTOR LIST OF A MULTI-SEL CASE STATEMENT BEGIN SGC12(.E); PUSHCPH(SELELC); ! --> SLC CT[.CODEPTR,1]_#40; PUSHCODE() ! --> \SLC END; ROUTINE SGC12(E)= !SUBROUTINE CALLED FROM GCOST1 AND GCOST2 TO PUT REGISTER ADDRESS !FOR EACH ELEMENT OF SELECTOR LIST ON COSTC #2. CALLED ONLY WHEN !COMPILING A MULTISELECTOR CASE STATEMENT. BEGIN E_GLAR(.E); ACPR1(); ! --> SLC PROMOTE(1^CNVEYC OR 1^RELC); ACPR1(); ! --> C1 CT[NEWBOT(LOCATE(COSTC,2),1),1]_.RT[.E]; DULEX(.E) END; GLOBAL ROUTINE GCOST2(E,N)= ! OF ENCOUNTERED IN SINGLE (N=1) OR MULTI (N>1) SELECTOR CASE STATEMENT BEGIN REGISTER H, ! INDEX OF COSTC HEADER I, ! TEMP FOR INDEXING THRU LIST J, ! " " " " " R; ! MULTI-NAMED REGISTER LOCAL P, ! TEMP INDEX HOLDER LOCBASE;! FIRST ALLOCATED LOCAL OF CONTIGUOUS CHUNK MACRO L=R$, ! TEMP FOR LOCAL LEXEMES COUNTINGREG=R$, ! ADDRESS OF COUNTING REG(MULTISELECTOR) INDEXREG=R$; ! ADDRESS OF INDEX REGISTER FOR JUMPS H_LOCATE(COSTC,0); IF .N EQL 1 THEN BEGIN E_GLAR(.E); ACPR1(); ! --> SLC PROMOTE(1^CNVEYC OR 1^RELC); SYPHON(I_.CODEPTR); ACPR3(); ! --> C3 RELEASESPACE(TAKE(.I),1); PUSHCODE(); %4.11% IF NOT (.NPTFLG) THEN %4.01% CODE(PEEPHOLE,0,PEEPOFF,0); CODE(XCT,0,LABLE(MADRIR(.E,LOCATE(COSTC,4))),0); GCASEJMP(LOCATE(COSTC,7)); END ELSE BEGIN MULTISELECTOR_1; SGC12(.E); I_.CT[.CODEPTR,1]; J_.CT[LOCATE(COSTC,2),1]; !! THIS LOOP GENERATES CODE TO STORE EACH SELECTOR RESULT INTO A !! LOCAL. THIS WILL RESULT IN A CHUNK (N+1) OF LOCALS WITH !! THE N SELECTOR VALUES AND THE LAST CONTAINING A -1 SO THAT !! WHEN THE LIST IS EXHAUSTED CONTROL PASSES TO THE END OF THE !! CASE STATEMENT INCR K FROM 1 TO .N DO BEGIN CODEPTR_.CT[.I,1]; ! --> SLC L_GENLOCAL(); IF .K EQL 1 THEN LOCBASE_.L; CODE(MOVEM,.CT[.J,1],GMA(GAT(.L)),0); SYPHON(P_.I); I_.CT[.I,0]; J_.CT[.J,0]; RELEASESPACE(TAKE(.P),1) END; CODEPTR_.CT[.CT[.H,1],1]; ! --> \C1 CODE(SETOM,0,GMA(GAT(GENLOCAL())),0); CODE(MOVEI,COUNTINGREG_ACQUIRE(-1,1),GMA(GAT(.LOCBASE)),0); COUNTREGADDR_.COUNTINGREG; COUNTREGNAME_.ART[.COUNTINGREG]; ACPR2(); ! --> C2 EMPTY(.CODEPTR); CLASSLAB(); ! --> C3 PUSHCODE(); ! --> \C3 %4.11% IF NOT (.NPTFLG) THEN %4.01% CODE(PEEPHOLE,0,PEEPOFF,0); CODE(MOVE,INDEXREG_ACQUIRE(-1,1),.COUNTREGADDR^18,0); GUJUMP(MADRIR(LEXRA(.INDEXREG),LOCATE(COSTC,4))); CT[.CT[.CODEPTR,1],1]_1; GCASEJMP(LOCATE(COSTC,7)); END; CODEPTR_LOCATE(COSTC,1); ! --> C1 PUSHCODE(); ! --> \C1 RT[.COUNTREGNAME]_1; FREEVREG(); RT[.COUNTREGNAME]_0; CODEPTR_LOCATE(COSTC,4); ! --> C4 CLASSLAB(); ! --> C5 PUSHCODE(); ! --> \C5 ACPR2(); ! --> C6 PUSHCPH(CURRENTC); ! --> CTC CT[.CODEPTR,1]_#40; IF .N EQL 1 THEN PUSHSET() ELSE PUSHMSET() END; ROUTINE PUSHMSET= ! CREATES A SETC ELEMENT IN A MULTI-SEL CASE STATEMENT BEGIN CODEPTR_PUSHBOT(.CODEPTR,SKELETON(1,SETC,4)); ! --> MS0 ACPDT(); ! --> MS1 CLASSLAB(); ! --> MS2 PUSHCODE() ! --> \MS2 END; ROUTINE PUSHSET= ! CREATS A SETC ELEMENT IN A SINGLE-SEL CASE STATEMENT BEGIN CODEPTR_PUSHBOT(.CODEPTR,SKELETON(1,SETC,2)); ! --> S0 ACPDT(); ! --> S1 CLASSLAB(); ! --> S2 PUSHCODE(); ! --> \S2 END; GLOBAL ROUTINE GCOST3(S)= % A SET ELEMENT HAS BEEN COMPLETED IN A CASE STATEMENT. % BEGIN SGC34(.S,0) END; ROUTINE SGC34(S,LAST)= ! SUBROUTINE CALLED BY GCOST3 (LAST=0) AND GCOST4 (LAST=1). IN THE ! SINGLE SELECTOR CASE IT ATTEMPTS TO PUT SINGLE INSTRUCTION SET ELEMENTS ! DIRECTLY INTO THE JUMP TABLE BEGIN REGISTER H, ! INDEX OF COSTC HEADER ONEIND, ! INDEX OF INST. WHERE SET ELEMENT COMPILES TO ONE INSTRUCTION ONERELOC; ! RELOCATION TYPE FOR ONE-INSTRUCTION CASE LOCAL SETLABEL, ! INDEX OF MOST RECENT SET-ELEMENT'S LABEL ONECODE, ! ONE-INSTRUCTION ITSELF ONEINST, ! BOOLEAN INDICATING ONE-INSTRUCTION H1; ! TEMP FOR INDEX H_LOCATE(COSTC,0); SETLABEL_.CT[.CT[.CODEPTR,0],0]; S_CONVEY(.S); IF NOT .MULTISELECTOR THEN BEGIN ONEIND_SINGINSTP(.CT[.CODEPTR,0]); IF .ONEIND EQL 1 THEN BEGIN ONEIND_.ONEIND; ONEINST_1 END ELSE IF .ONEIND EQL 0 THEN BEGIN GUJUMP(LOCATE(COSTC,7)); ONEIND_.CT[.CODEPTR,1]; CT[.ONEIND]=CASEJMPRELOC; ! DON'T ERASE THE CODE THAT FOLLOWS THE ! JUMP **U1** ONEINST_1 END ELSE ONEINST_0; IF NOT .LAST AND NOT .ONEINST THEN GUJUMP(LOCATE(COSTC,7)); ACPR1(); ! --> S2 PROMOTE(1^RELC OR 1^XCOSTC); IF .ONEINST THEN BEGIN ONERELOC_.CT[.ONEIND,0]; ONECODE_.CT[.ONEIND,1]; EMPTY(.CODEPTR) END END ELSE BEGIN ONEINST_0; ACPR1(); ! --> MS2 PROMOTE(1^RELC OR 1^XCOSTC); ACPR1(); ! --> MS3 CLASSLAB(); ! --> MS4 PUSHCODE(); ! --> \MS4 SFORLABEL_1; IF .RT[.COUNTREGNAME] THEN RELOADTEMP(.COUNTREGADDR,.COUNTREGNAME); CODE(AOJA,.COUNTREGADDR,LABLE(LOCATE(COSTC,2)),0); SFORLABEL_0; END; IF NOT .LAST THEN DULEX(.S); CODEPTR_LOCATE(COSTC,5); ! --> C5 ACPDT(); ! --> \C5 IF .ONEINST THEN BEGIN CT[H1_NEWBOT(.CODEPTR,1),0]_.ONERELOC; CT[.H1,1]_.ONECODE END ELSE GCASEJMP(.SETLABEL); !! THIS INSTRUCTION IS PUT OUT AS MARKER TO FLATFUNC SO IT WILL NOT !! ATTEMPT TO BACKOVER THE JUMP-TABLE %4.01% IF .LAST THEN BEGIN %4.01% CODE(#257,0,NOBORELOC^30,0); %4.11% IF NOT (.NPTFLG) THEN %4.01% CODE(PEEPHOLE,0,PEEPREV,0); %4.01% END; ACPR2(); ! --> C6 ACPDT(); ! --> \C6==CTC IF NOT .LAST THEN IF .MULTISELECTOR THEN PUSHMSET() ELSE PUSHSET(); .S END; GLOBAL ROUTINE GCOST4(S)= ! THE FINAL SET ELEMENT HAS BEEN MET IN A CASE STATEMENT BEGIN REGISTER H; S_SGC34(.S,1); H_LOCATE(COSTC,0); SCAN(.CODEPTR,SETC,CLASSP,UNSKELETON); SYPHON(.CODEPTR); ERASE(.CODEPTR); IF .COUNTREGADDR NEQ 0 THEN DUA(.COUNTREGADDR); CODEPTR_.CT[.H,1]; ! --> C7 CLASSLAB(); ! --> C0 UNTEMPLATE(); .S END; % SELECT-OF-NSET-TESN SELECT E1, ... ,EN OF NSET L1:S1; ... :SM TESN ^ ^ ^ ^ ^ ^ GSE0 -------------^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ GSE1(E1) --------------^ ^ ^ ^ ^ ^ ^ ^ ^ GSE2(EN) -------------------------^ ^ ^ ^ ^ ^ ^ GSE3(L1) ----------------------------------^ ^ ^ ^ ^ GSE4(S1) -------------------------------------^ ^ ^ GSE5(SM) ------------------------------------------------^ SKELETONS: 0 SELECT 0.2 LEXEME OF LOCAL FOR RESULT 0.3 BOOLEAN: ALWAYS OR OTHERWISE GENERATED 1 SELECTOR CODE 2 SELECTOR LEXEME(S) 3 NSET-TESN 4 SETO CODE 5 EXIT LABEL NSET ELEMENT: 0 NSET 1 LABEL CODE 2 LABEL 3 NSET CODE 4 LABEL % ! AN EXAMPLE OF THE CODE FOR A SELECT STATEMENT FOLLOWS: ! ! ! A_SELECT .B,0,2 OF NSET .D:F(.E); .E:0 TESN ! ! ! MOVE 04,B ! MOVEM 04,1($F) ! SETOM $S,2($F) ! MOVE 05,D ! CAMN 05,1($F) ! JRST $S,L1276 ! JUMPE 05,L1276 ! CAIE 05,2 ! JRST $S,L1316 ! L1276: AOS $S,2($F) ! PUSH $S,E ! PUSHJ $S,F ! SUB $S,[000001,,000001] ! L1316: MOVE 06,E ! CAMN 06,1($F) ! JRST $S,L1334 ! JUMPE 06,L1334 ! CAIE 06,2 ! JRST $S,L1256 ! L1334: AOS $S,2($F) ! SETZ $V,0 ! L1256: SKIPGE $S,2($F) ! SETO $V,0 ! MOVEM $V,A MACRO MINUSONELOCAL=CT[LOCATE(SELECTC,0),2]$; !LEXEME OF LOCAL USED TO DETERMINE IF A NSET ELEMENT HAS BEEN EXECUTED GLOBAL ROUTINE GSE0= ! SELECT MET COMMENCING A SELECT-OF-NSET-TESN %4.01% BEGIN LOCAL TEMP; FREEVREG(); TEMPLATE(2,SELECTC,5); ! --> S0 ACPDT(); ! --> S1 PUSHCPH(CURRENTC); ! --> CTC CT[.CODEPTR,1]_#40; % 9-21-77 4.11 IF NOT (.NPTFLG) THEN 4.11 BEGIN 4.01 TEMP_.CODEPTR; 4.01 PUSHCODE(); 4.01 CODE(PEEPHOLE,0,PEEPOFF,0); 4.01 CODEPTR_.TEMP; 4.11 END; % PUSHCODE() ! --> \CTC END; ROUTINE SGSE12(E)= ! SUBROUTINE CALLED FROM GSE1 AND GSE2 TO HANG LEXEME OF SELECTOR !ELEMENT FROM SELECTC #2 BEGIN LOCAL H,LEX,V; H_LOCATE(SELECTC,2); IF NOT (IF LITP(.E) THEN (V_LITV(.E);SMPOSLITVP(.V))) THEN (LEX_GENLOCAL();DULEX(GSTO(.LEX,.E))) ELSE LEX_.E; CT[NEWBOT(.H,1),1]_.LEX END; GLOBAL ROUTINE GSE1(E)= ! COMMA MET IN SELECTOR LIST OF SELECT-OF-NSET-TESN BEGIN SGSE12(.E); ACPR1(); ! --> CTC PROMOTE(1^CNVEYC OR 1^RELC); SYPHON(.CODEPTR); PUSHCODE() ! --> \CTC END; GLOBAL ROUTINE GSE2(E)= ! OF MET IN SELECT EXPRESSION. GENERATES LOCAL LEXEME TO BE USED ! TO CHECK IF ANY NSET-TESN ELEMENT IS EXECUTED BEGIN LOCAL H,LEX; SGSE12(.E); LEX_GAT(GENLOCAL()); MINUSONELOCAL_.LEX; CODE(SETOM,0,GMA(.LEX),0); ACPR1(); ! --> CTC PROMOTE(1^CNVEYC OR 1^RELC); SYPHON(H_.CODEPTR); ACPR3(); ! --> C3 ERASE(.H); PUSHCPH(CURRENTC); ! --> CTC CT[.CODEPTR,1]_#40; PUSHNSET() END; ROUTINE PUSHNSET= ! CREATE A NSET ELEMENT BEGIN CODEPTR_PUSHBOT(.CODEPTR,SKELETON(1,NSETC,4)); ! --> NS0 ACPDT(); ! --> NS1 PUSHCODE() ! --> \NS1 END; GLOBAL ROUTINE GSE3(E)= ! A COLON ENCOUNTERED IN A SELECT EXPRESSION. CODE IS GENERATE TO ! CHECK SELECTOR LIST AGAINST VALUE OF LABEL. BEGIN LOCAL LAB1,LAB2,RLEX; REGISTER I; LAB1_LABLE(LOCATE(NSETC,2)); LAB2_LABLE(LOCATE(NSETC,4)); E_REGAK(RLEX_GLAR(.E)); I_.CT[LOCATE(SELECTC,2),1]; UNTIL LAST(.I) DO BEGIN SGSE3(.CT[.I,1],.LAB1,.E,0); I_.CT[.I,0] END; SGSE3(.CT[.I,1],.LAB2,REGAR(.RLEX),1); ACPR1(); ! --> NS1 PROMOTE(1^RELC OR 1^CNVEYC); ACPR1(); ! --> NS2 CLASSLAB(); ! --> NS3 PUSHCODE(); ! --> \NS3 CODE(AOS,0,GMA(.MINUSONELOCAL),0) END; ROUTINE SGSE3(LEX,LAB,REG,LAST)= ! SUBROUTINE CALLED BY GSE3 TO GENERATE TEST (VS. LEX) AND ! JUMP TO LAB. LAST INDICATES THAT LEX IS THE LAST ! SELECTOR ON THE LIST. BEGIN REGISTER V; IF(IF LITP(.LEX) THEN (V_LITV(.LEX);SMPOSLITVP(.V))) THEN IF .V EQL 0 THEN CODE(JUMPE+4*.LAST,.REG,.LAB,0) ELSE BEGIN CODE(CAIN-4*.LAST,.REG,.V,0); CODE(JRST,0,.LAB,0) END ELSE BEGIN CODE(CAMN-4*.LAST,.REG,GMA(GAT(.LEX)),0); CODE(JRST,0,.LAB,0) END END; GLOBAL ROUTINE GSE3O= ! OTHERWISE ENCOUNTERED AS A LABEL BEGIN CT[LOCATE(SELECTC,0),3]_-1; CODE(AOSE,0,GMA(.MINUSONELOCAL),0); CODE(JRST,0,LABLE(LOCATE(NSETC,4)),0); ACPR3(); ! --> NS3 PUSHCODE() ! --> \NS3 END; GLOBAL ROUTINE GSE3A= ! ALWAYS ENCOUNTERED AS A LABEL BEGIN CT[LOCATE(SELECTC,0),3]_-1; ACPR3(); ! --> NS3 PUSHCODE(); ! --> \NS3 CODE(AOS,0,GMA(.MINUSONELOCAL),0) END; GLOBAL ROUTINE GSE4(E)= ! NSET ELEMENT COMPLETED IN A SELECT EXPRESSION BEGIN DULEX(CONVEY(.E)); ACPR1(); ! --> NS3 PROMOTE(1^RELC OR 1^XSELECTC); ACPR1(); ! --> NS4 CLASSLAB(); ! --> NS0 ACPR1(); ! --> CTC PUSHNSET() END; GLOBAL ROUTINE GSE5(E)= ! LAST NSET ELEMENT ENCOUNTERED IN SELECT EXPRESSION. IF E=0, THEN ! WE HAVE THE CASE WHERE THE LAST ELEMENT IS MISSING. E.G.: ! SELECT .A OF NSET .B:.C; .D:.E; TESN ! IF NO ALWAYS OR OTHERWISE LABELS WERE GENERATED, THEN THE -1 VALUE ! IS CONVEYED BEGIN LOCAL I; EMPTY(LOCATE(SELECTC,2)); IF .E EQL 0 THEN CODEPTR_LOCATE(NSETC,4) ! --> NS4 ELSE BEGIN E_CONVEY(.E); ACPR1(); ! --> NS3 PROMOTE(1^RELC OR 1^XSELECTC); ACPR1() ! --> NS4 END; CLASSLAB(); ! --> NS0 ACPR1(); ! --> CTC SCAN(.CODEPTR,NSETC,CLASSP,UNSKELETON); %4.01% I_.CODEPTR; % 6-24-77 DO NOT DELETE A CELL BECAUSE THE CODE IS BAD FOR SELECT . X OF NSET 1:RETURN 1; OTHERWISE: RETURN 0 TESN; 4.11 IF NOT (.NPTFLG) THEN 4.11 BEGIN 4.01 PUSHCODE(); 4.01 CODE(PEEPHOLE,0,PEEPREV,0); 4.01 CODEPTR_.I; 4.11 END; % %4.01% SYPHON(.I); ACPR2(); ! --> S4 ERASE(.I); IF NOT .CT[LOCATE(SELECTC,0),3] THEN BEGIN PUSHCODE(); ! --> \S4 CODE(SKIPGE,0,GMA(.MINUSONELOCAL),0); CODE(SETO,.VREG,0,0); ACPR2(); ! --> S5 END ELSE ACPR1(); ! --> S5 CLASSLAB(); ! --> S0 UNTEMPLATE(); IF .E EQL 0 THEN GETVREG() ELSE .E END; % FUNCTION-ROUTINE CALL E0(E1,EM) ^ ^ GFRC1(E1)____________^ ^ ^ GFRC2(EM,E0,M)__________^ % GLOBAL ROUTINE GFRC1(X)= ! A PARAMETER (NOT THE LAST) HAS BEEN COMPLETED BEGIN PCIVR(.X,0); REGSEARCH(X,0); CODE(PUSH,.SREG,MEMORYA(.X),0) END; % COROUTINES. - - - - GENERAL FORMAT - - - - THE STACK OF A COROUTINE INSTANCE CONSISTS OF A STATE AREA WITH A NORMAL STACK ON TOP. THE STATE AREA AND LOWER PART OF STACK DESCRIBED BELOW. NOTE THAT THE LOWEST 'RETURN ADDRESS' IS REPLACED BY THE ADDR. OF THE THEN-PART OF THE APPROPRIATE CREATE-EXPR., AND THE ORIGINAL CONTENTS OF THE F-REG IS THAT OF THE CREATOR. STATE AREA: THE LAYOUT OF THE STATE AREA IS: ! ! ! ! ^ NORMAL STACK AS DESCRIBED IN MANUAL. ^ ! ! !------------! !THEN ADDRESS! ADDR. OF THEN-PART OF CREATE (IN RETURN ADDR. POSITION). !------------! !LAST ACTUAL ! !-- --! ! ! THIS AREA OMITTED IF NO ACTUALS. !-- --! !1'ST ACTUAL ! !------------! ! SAVE AREA ! ! FOR ALL ! THIS AREA OMITTED IF /R OPTION INVOKED. ! DECLARABLE ! ! REGISTERS ! !------------! 2 ! F REGISTER ! !------------! THESE TWO ALWAYS SAVED AND RESTORED. 1 ! S REGISTER ! !------------! 0 ! REACTIVA- ! ADDRESS WHERE EXECUTION SHOULD RESUME. ! TION POINT !__ BASE REGISTER POINTS HERE DURING EXECUTION. ------------ REGISTERS: ALL DECLARABLE REGISTERS, WHETHER IN USE OR NOT, ARE NORMALLY SAVED IN THE STATE AREA OF THE NEW PROCESS DURING CREATE. THEY ARE RESTORED/SAVED WHEN THE PROCESS IS ENTERED/LEFT BY AN EXCHJ. THE USER MAY OMIT THIS SAVING AND RESTORING BY USING THE /R SWITCH. THIS WILL CLEAR THE "SVERGFLG" IN THE COMPILER. NO SPACE FOR THE REGISTERS IS RESERVED IN THE STATE AREA WHEN THIS OPTION IS USED. TEMPORARY REGISTERS ARE SAVED ACROSS EXCHJ'S IN THE STACK, AS FOR FUNCTION/ROUTINE CALLS. - - - - CREATE: - - - - THE SEQUENCE OF EVALUATIONS AND EVENTS DURING CREATE E1(ELIST) AT E2 LENGTH E3 THEN E4 WILL BE: E2, E3, ELIST IN SEQUENCE, E1, REGISTERS SAVED IN NEW STATE. HOWEVER, IF E1 IS NOT A NAME IT WILL BE EVALUATED BEFORE E2. THE THEN - PART: DURING THE EVALUATION OF E4 THE VALUES OF THE RUN-TIME REGISTERS ARE AS FOR THE OUTMOST LEVEL OF THE PROCESS THAT RETURNED, EXEPT THAT THE F-REGISTER IS AS FOR THE PROCESS THAT CREATED THE ONE WHICH IS NOW RETURNING. HENCE USE OF LOCAL VARIABLES IN E4 WILL USUALLY BE MEANINGFULL. E4 IS TERMINATED BY A HALT INSTRUCTION, WITH THE VALUE OF E4 IN THE VALUE-REGISTER. VALUE OF CREATE: IF THE INSPECT OPTION (/I) IS USED, THE VALUE OF A CREATE IS: --------- --------- ------------------ ^ RAFL ^ RALF ^ BASE ADDRESS ^ --------- --------- ------------------ 0 8 9 17 18 35 WHERE: RAFL = RELATIVE ADDRESS OF FIRST LOCAL RALF = RELATIVE ADDRESS OF LAST FORMAL BOTH RELATIVE TO THE BASE ADDRESS, AND TAKING INTO ACCOUNT THAT THE NO. OF ACTUALS MAY DIFFER FROM THE NO. OF FORMALS. IF THE INSPECT OPTION IS NOT USED, RAFL AND RALF ARE ZERO, THEY WILL ALSO BE ZERO IF THERE ARE NO LOCALS OR ACTUALS. THE INSPECT WORD. THE SPECIAL WORD MENTIONED IN THE DESCRIPTION OF THE INSPECT- SWITCH IN THE MANUAL IS: --------- --------- ------------------ ! RAFL ! NFORM ! OBJECT SIZE ! --------- --------- ------------------ 0 8 9 17 18 35 WHERE RAFL = RELATIVE ADDRESS OF FIRST LOCAL (RELATIVE TO THE LOCATION BELOW THE RETURN ADDRESS), NFORM = # OF FORMALS, OBJECT SIZE = # OF FORMALS + # OF DISPLAYS + # OF SAVED REGISTERS + # OF LOCALS + 2. USE OF THE /I SWITCH WILL SET THE "LUNDEFLG" IN THE COMPILER. - - - - EXCHJ: - - - - DURING THE EVALUATION OF EXCHJ(,) WILL IN THE MOST GENERAL CASE BE EVALUATED BEFORE , AND SAVED IN THE STACK. HOWEVER, THE COMPILER TRIES TO RECOGNICE WHEN CAN BE OBTAINED BY A SINGLE 'MOVE' AND IS NOT LIABLE TO SIDEEFFECTS FROM . IN SUCH CASES WILL BE EVALUATED FIRST AND 'MOVE'D DIRECTLY INTO BREG WHEN NEEDED. THE COMPILER WILL FIRST GENERATE CODE MAKING NO ASSUMPTIONS, THEN REMOVE IT IF THE OPTIMIZABLE CASE IS RECOGNIZED. CREATE F(P1,...,PN) AT E1 LENGTH E2 THEN E3 ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ GCREA0() -----------------------^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ GCREA1(PJ) --- J < N --------------^ ^ ^ ^ ^ ^ ^ ^ ^ GCREA2(PN,F,N) ---------------------------^ ^ ^ ^ ^ ^ ^ GCREA3(E1) ---------------------------------------^ ^ ^ ^ ^ GCREA4(E2) -------------------------------------------------^ ^ ^ GCREA5(E3) --------------------------------------------------------^ CREATE F(P1,...,PN) AT E1 LENGTH E2 THEN E3 ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ GCREA0() -----------------------^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ GCREA1(PJ) --- J < N --------------^ ^ ^ ^ ^ ^ ^ ^ ^ GCREA2(PN,F,N) ---------------------------^ ^ ^ ^ ^ ^ ^ GCREA3(E1) ---------------------------------------^ ^ ^ ^ ^ GCREA4(E2) -------------------------------------------------^ ^ ^ GCREA5(E3) --------------------------------------------------------^ THE STACK- AND BASE REGISTERS OF CREATED PROCESS ARE SIMULATED IN REGISTERS SP AND BP. THESE REGISTERS MAY BE SAVED BY THE PARAMETER CODE, IN WHICH CASE THEY ARE RELOADED BY THESE ROUTINES. SKELETON O CREATC 0.2 REGISTER SIMULATING SREG, AS XWD NAME,ADDRESS. 0.3 REGISTER SIMULATING BREG, AS XWD NAME,ADDRESS. 1 CODE TO BUILD SP,BP FROM E1,E2. 2 CODE FOR F(P1,...,PN), STATE AREA, RAFL. 3 LABEL FOR = 0 4 CODE FOR AND VALUE. 5 LABEL 6 CODE FOR E3 7 LABEL % GLOBAL ROUTINE GCREA0 = %_SET UP TEMPLATE AND ACQUIRE REGISTERS FOR SP AND BP READY TO RECEIVE CODE FOR FUNCTION/ROUTINE NAME AND PARAMETERS. CODEPTR AT \2 ON EXIT. _% BEGIN LOCAL H; TEMPLATE(2,CREATC,7); ACPDT(); ! --> 1; H _ .CT[.CODEPTR,0]; PUSHCODE(); !--> \1; ! SAVE IDENTITY OF SP, BP AS XWD NAME,ADDRESS. CT[.H,2] _ ACQUIRE(-1,1); CT[.H,3] _ ACQUIRE(-1,1); CT[.H,2] _ .ART[.CT[.H,2]]; CT[.H,3] _ .ART[.CT[.H,3]]; ACPR2(); ! -->2 PUSHCODE(); ! -->\2 END; ! END OF GCREA0. GLOBAL ROUTINE GCREA1(P) = %_GENERATE CODE FOR PARAMETERS EXEPT LAST. CODEPOINTER AT \2 THROUGHOUT. _% BEGIN LOCAL H; PCIVR(.P,0); ! RELOAD SP IF NECESSARY. H _ LOCATE(CREATC,0); IF .RT[.CT[.H,2]] THEN RELOADTEMP(.CT[.H,2],.CT[.H,2]); REGSEARCH(P,0); CODE(PUSH,.CT[.H,2],MEMORYA(.P),0); END; ! END OF GCREA1. GLOBAL ROUTINE GCREA2(P,F,M) = %_P IS PARAMETER LEXEME, F IS FUNCTION/ROUTINE LEXEME, M IS # OF PARAMETERS. PUSH DOWN LAST PARAMETER, THEN PUT RETURN POINT, S-REGISTER, F-REGISTER, DECLARABLE REGISTERS, REACTIVATION POINT INTO STATE AREA. IF THE INSPECTION FEATURE IS USED, GENERATE CODE TO COMPUTE CORRECT RAFL AND RALF FIELDS. -->\2 ON ENTRY; -->\1 ON EXIT. _% BEGIN LOCAL K,RETLEX; REGISTER H; MACRO SP = (.H)$, BP = (.H+1)$; H _ CT[LOCATE(CREATC,0),2]<0,0>; ! ADDR OF SP,BP IS NOW .SP, .BP. IF .M NEQ 0 THEN GCREA1(.P); ! CODE FOR LAST PARAMETER. ! RELOAD BP IF NECESSARY. IF .RT[.(.H+1)] THEN RELOADTEMP(.BP,.(.H+1)); ! NOW INITIALIZE STATE AREA. %3.38% CODE(PUSH,.SP,COPTR(0,0,LABLE(LOCATE(CREATC,5))),0); ! RETURN ADDR. CODE(MOVEM,.SP,.BP^18 OR 1,0); ! SAVE PROCESS SREG CODE(HRRZM,.FREG,.BP^18 OR 2,0); ! SAVE PROCESS FREG. CODE(HRRZI,.SP,GMA(GAT(.F)),0); CODE(MOVEM,.SP,.BP^18,0); ! SAVE REACTIVATION POINT. IF .SVERGFLG THEN ! NOW CODE TO SAVE ALL DECLARABLE REGISTERS IN PROCESS STATE. ( K _ 2; INCR I FROM 0 TO 15 DO IF (.SVREGM AND 1^.I) NEQ 0 THEN CODE(MOVEM,.I,.BP^18 OR (K _ .K+1),1); ); ! K NOW HOLDS SIZE OF STATEAREA - 1. ! NOW CODE TO SET RALF, RAFL FIELDS AND TRANSMIT VALUE OF CREATE. RETLEX _ GETVREG(); IF .LUNDEFLG THEN ! YES, RALF/RAFL MUST BE CALCULATED. ( K _ .M + 2 + (IF .SVERGFLG THEN .NOSVR ELSE 0); ! K NOW HOLDS REL. ADDR. OF FIRST 'PSEUDO LOCAL'. CODE(LDB,.VREG,LITA(LITLEXEME(#331100777777 OR .SP^18)),1); ! NOW RAFL FROM SPECIAL WORD IN CODE IS IN VREG. CODE(JUMPE,.VREG,LABLE(LOCATE(CREATC,3)),1); ! JUMP IF RAFL = 0. CODE(ADDI,.VREG,.K,0); ! ADD SIZE OF STATE+PARAMETERAREA. CODE(LSH,.VREG,9,0); ! NOW MOVE PAST LABEL. ACPR2(); CLASSLAB(); PUSHCODE(); ! -->3; -->4; -->\4; IF .M NEQ 0 THEN CODE(IORI,.VREG,.K,0); ! OR IN RALF. ! NOW FINISH THE VALUE. CODE(LSH,.VREG,18,0); CODE(IOR,.VREG,.BP,0); ! OR IN BASE ADDR. FROM BR. ) ELSE ! NO, RAFL/RALF NOT WANTED. ( CODE(MOVE,.VREG,.BP,0); %3.38% ACPR2(); CLASSLAB(); PUSHCODE(); ! -->3; -->4; -->\4; ); ! NOW CODE TO JUMP PAST THEN PART. CODE(JRST,0,LABLE(LOCATE(CREATC,7)),1); ! FIRST CLASSIFY THEN-LABEL. ACPR2(); CLASSLAB(); ! -->5; -->6; ! NOW BE READY TO RECEIVE CODE FOR LOCATION AND LENGTH OF PROCESS. CODEPTR _ LOCATE(CREATC,1); PUSHCODE(); ! -->1; -->\1; DULEX(.RETLEX); .RETLEX END; ! END OF GCREA2. GLOBAL ROUTINE GCREA3(S) = %_COMPILE CODE TO LOAD BASE OF PROCESS INTO SIMULATED STACK REGISTER. -->\1 THROUGHOUT. _% BEGIN REGISTER H; H _ LOCATE(CREATC,0); ! RELOAD SP IF NECESSARY. IF .RT[.CT[.H,2]] THEN RELOADTEMP(.CT[.H,2],.CT[.H,2]); PCIVR(.S,0); CODE(HRRZ,.CT[.H,2],MEMORYA(.S),0) END; ! END OF GCREA3. GLOBAL ROUTINE GCREA4(S) = %_COMPILE CODE TO LOAD NEGATIVE LENGTH OF PROCESS INTO LEFT HALF OF SIMULATED S-REGISTER, INITIALIZE SIMULATED BASE, AND MOVE SP PAST STATE-AREA. -->\1 ON ENTRY; -->\6 ON EXIT; _% BEGIN LOCAL L,R; REGISTER H; MACRO SP = (.H)$, BP = (.H+1)$; H _ CT[LOCATE(CREATC,0),2]<0,0>; ! NOW .SP, .BP IS ADDRESS OF SP, BP. PCIVR(.S,0); ! RELOAD SP, BP IF NECESSARY. IF .RT[.(.H)] THEN RELOADTEMP(.SP,.(.H)); IF .RT[.(.H+1)] THEN RELOADTEMP(.BP,.(.H+1)); CODE(MOVN,.BP,MEMORYA(.S),1); CODE(HRL,.SP,.BP,0); CODE(HRRZ,RMA(.BP,0,.BP),.SP,0); L _ (IF .SVERGFLG THEN .NOSVR ELSE 0) + 2; CODE(ADD,RMA(.SP,0,.SP),LITA(LITLEXEME((.L)^18 OR .L)),0); ! NOW MAKE READY FOR THEN-PART. CODEPTR _ LOCATE(CREATC,6); ! -->6. PUSHCODE(); ! -->\6. END; ! END GCREA4. GLOBAL ROUTINE GCREA5(S) = %_S IS THE THEN-PART LEXEME. TERMINATE CODE FOR THEN-PART WITH A HALT. CLEAN UP THE MESS. -->\6 ON ENTRY. _% BEGIN DULEX(CONVEY(.S)); CODE(JRST,4,0,0); ACPR2(); ! -->7. CLASSLAB(); ! -->0. UNTEMPLATE(); END; ! OF GCREA5. % ROUTINES FOR EXCHJ. EXCHJ(PP,VAL) ^ ^ ^ ^ GEXCH0(PP) ----------------------------------^ ^ ^ GEXCH1(VAL,TOG) ---------------------------------^ SKELETON: 0 EXCHC 1 CODE TO SAVE PROCESS STATE 2 PROCESS-EXPR IF NOT ONE-MOVER 3 REST OF CODE 4 LABEL - REACTIVATION POINT _% GLOBAL ROUTINE GEXCH0(PP) = %_SET UP TEMPLATE, GENERATE CODE FOR STATE AND NEW BASE. BE READY TO RECEIVE CODE FOR VALUE-EXPRESSION VALUE RETURNED IS TRUE IF PP CAN BE PUSHED WITHOUT PREVIOUS CALCULATION. ITS LEFTF THEN HOLDS CT-INDEX OF THAT PUSH-INSTR. --> \3 ON EXIT. _% BEGIN %3.36% EXTERNAL RBREG; LOCAL R,ONEINSTR; TEMPLATE(1,EXCHC,4); ACPDT(); ! --> 1. PUSHCODE(); ! --> \1. %> FIRST SAVE PROCESS STATE REGISTERS, WHICH ARE UNCHANGED ACROSS THE PARAMETER EXPRESSIONS. THEN SET THE REACTIVATION POINT. <% %3.36% CODE(MOVE,BREG_ACQUIRE(-1,1),GMA(.RBREG),0); CODE(MOVEM,.FREG,.BREG^18 OR 2,0); CODE(MOVEM,.SREG,.BREG^18 OR 1,0); CODE(MOVEI,R_ACQUIRE(-1,1),LABLE(LOCATE(EXCHC,4)),1); CODE(MOVEM,RMA(.R,0,.R),.BREG^18,1); %> NOW PUSH NEW BASE, ASSUMING IT HAS SIDEEFFECTS ON VALUE. <% ACPR2(); PUSHCODE(); ! --> 2; --> \2. CODE(PUSH,.SREG,(PP _ MEMORYA(.PP)),1); NEXTLOCAL _ .NEXTLOCAL + 1; DULEX(.PP); ONEINSTR _ SINGINSTP(.CT[.CODEPTR,0]); ! WAS PUSH THE ONLY INSTR. GENERATED? ACPR2(); ! --> 3; PUSHCODE(); ! --> \3; .ONEINSTR END; ! END ROUTINE GEXCH0. GLOBAL ROUTINE GEXCH1(VAL,TOG) = %_VAL IS LEXEME FOR VALUE-EXPRESSION. TOG IS TRUE IF WE CAN MOVE PP DIRECTLY TO BASE REGISTER, AND ITS LEFTF HOLDS THE CT-INDEX OF PUSH-INSTR. GENERATED BY GEXCH0. --> \3 ON ENTRY. _% BEGIN %3.36% EXTERNAL RBREG; LOCAL R,K,MASK1,B18; B18 _ .BREG^18; MASK1 _ 0; VAL _ CONVEY(.VAL); ! NOW CODE TO SAVE HI-TEMPS. INCR I FROM 16 TO 31 DO IF .RT[.I] NEQ 0 THEN IF NOT (.RT[.I]) THEN IF (((1^(R_.RT[.I])) AND .HITREGM) NEQ 0) OR (IF .R EQL .VREG THEN .RT[.I] GTR 1 ELSE 0) THEN DUMPREG(.R); ! NOW CODE TO SAVE ALL DECLARABLES. IF .SVERGFLG THEN ( K _ 2; INCR I FROM 0 TO 15 DO IF (.SVREGM AND 1^.I) NEQ 0 THEN ( MASK1 _ .MASK1 OR 1^.I; CODE(MOVEM,.I,.B18 OR (K _ .K+1),1)); ); ! NOW READY TO SWAP BASES. IF .TOG THEN ! YES, WE MAY REPLACE THE PUSH BY A MOVE AFTER THE VALUE CALCULATION. ( R _ PUSHBOT(.CODEPTR,TAKE(.TOG)); CT[.R,1] _ MOVE; CT[.R,1] _ .BREG) ELSE ! NO, MUST COMPUTE PP BEFORE VAL. NOW POP IT INTO BREG. CODE(POP,.SREG,.BREG,0); IF .NEXTLOCAL GTR .MAXLOCAL THEN MAXLOCAL _ .NEXTLOCAL; NEXTLOCAL _ .NEXTLOCAL - 1; ! BREG NOW CONTAINS BASE OF DESTINATION, AND WE MAY RESTORE ALL ! REGISTERS. %3.36% CODE(MOVEM,.BREG,GMA(.RBREG),0); CODE(MOVE,.SREG,.B18 OR 1,0); CODE(MOVE,.FREG,.B18 OR 2,0); IF .SVERGFLG THEN ( K _ 2; INCR I FROM 0 TO 15 DO IF .MASK1^(-.I) THEN CODE(MOVE,.I,.B18 OR (K _ .K+1),1); ); ! NOW READY TO JUMP ACROSS INDIRECTLY VIA STORED REACTIVATION POINT. CODE(JRST,0,(1^22) OR .B18,0); %3.36% RELREG(.BREG); ACPR1(); ! -->3. PROMOTE(1^CNVEYC OR 1^RELC); ACPR1(); ! --> 4 CLASSLAB(); ! --> 0 UNTEMPLATE(); SESTOG _ .SESTOG OR 4; .VAL END; ! END ROUTINE GEXCH1. GLOBAL ROUTINE GSPUNOP(TYPE,PARAMETER)= !THIS ROUTINE SERVES AS A SWITCH TO CALL THE SPECIAL-UNARY-OPERATOR !ROUTINES BEGIN ROUTINE GJFFO(X)= BEGIN !GENERATE CODE FOR FIRSTONE(X) BIND JFFOC=CMPEXC; LOCAL REG,RESREG; IF LITP(.X) THEN RETURN LITLEXEME(FIRSTONE(LITV(.X))); PCIVR(.X,0); REGSEARCH(X,0); TEMPLATE(1,JFFOC,2); ACPDT(); PUSHCODE(); CODEN(JFFO,RESREG_REGAR(REG_GLTR2(.X)),LABLE(LOCATE(JFFOC,2)),3,.X); CODE(SETO,RESREG_.RESREG+1,0,0); ACPR2(); CLASSLAB(); UNTEMPLATE(); LEXRA(.RESREG) END; ROUTINE GMOVM(X)= !GENERATE CODE FOR ABS(X) BEGIN LOCAL REG; IF LITP(.X) THEN RETURN LITLEXEME(ABS(LITV(.X))); PCIVR(.X,0); REGSEARCH(X,0); CODE(MOVM,REG_ACQUIRE(-1,1),MEMORYA(.X),1); LEXRA(.REG) END; ROUTINE GSGN(X)= !GENERATE CODE FOR SIGN(X) BEGIN LOCAL REG,ADDR; IF LITP(.X) THEN RETURN LITLEXEME(SIGN(LITV(.X))); PCIVR(.X,0); CODE(SKIPE,REG_ACQUIRE(-1,1),ADDR_MEMORYA(.X),0); CODE(SETO,.REG,0,0); CODE(SKIPLE,0,.ADDR,0); CODE(MOVEI,.REG,1,0); LEXRA(.REG) END; EXTERNAL GOFFSET; CASE .TYPE OF SET GJFFO(.PARAMETER); GMOVM(.PARAMETER); %2.10% GSGN(.PARAMETER); %2.10% GOFFSET(.PARAMETER) TES END; GLOBAL ROUTINE GSPLF(T,P1,P2)= ! GENERATE CODE FOR SP-FCNS: ! 1 --> SCANN ! 2 --> SCANI ! 3 --> REPLACEN ! 4 --> REPLACEI ! 5 --> COPYNN ! 6 --> COPYNI ! 7 --> COPYIN ! 8 --> COPYII ! 9 --> INCP ! 10--> ASH %5-17-77% ! 11--> ROT %5-17-77% ! 12--> LSH %5-17-77% IF .T GEQ 10 THEN BEGIN EXTERNAL GASH,GROT,GLSH; CASE .T - 10 OF SET GASH(.P1,.P2); GROT(.P1,.P2); GLSH(.P1,.P2) TES END ELSE BEGIN LOCAL R; PCIVR(.P1,.P2); P1_IF .P1 THEN GAT(.P1) ELSE GDOT(.P1); IF .T GEQ 5 THEN (P2_IF .P2 THEN GAT(.P2) ELSE GDOT(.P2)); IF (T_.T-1) LEQ 1 THEN BEGIN !SCANN AND SCANI CODE(LDB-.T,R_ACQUIRE(-1,1),GMA(.P1),1); SESTOG_.SESTOG OR 1 END ELSE IF .T LEQ 3 THEN !REPLACEN AND REPLACEI %3.25% CODE(DPB-(.T-2),R_REGAK(GLAR(.P2)),GMA(.P1),5) ELSE IF .T EQL 8 THEN !INCP CODE(IBP,R_0,GMA(.P1),5) ELSE !COPYNN, COPYNI, COPYIN, COPYII BEGIN CODE(LDB-(.T GTR 5),R_ACQUIRE(-1,1),GMA(.P1),1); CODE(DPB-(.T AND 1),REGAK(LEXRA(.R)),GMA(.P2),5) END; SESTOG_.SESTOG OR 8; IF .R NEQ 0 THEN LEXRA(.R) ELSE ZERO END; GLOBAL ROUTINE GML(F,A,M,X,I)= ! GENERATE CODE FOR MACHINE LANGUAGE CONSTRUCT. A IS GUARANTEED TO ! BE A LITERAL. NOTE THAT I MUST ALSO BE A LITERAL OTHERWISE AN ! ERROR IS GIVEN BEGIN LOCAL VA,INDIRMASK; VA_LITV(.A) AND 1^4-1; IF LITP(.I) THEN (INDIRMASK_(LITV(.I) AND 1)^22; I_0) ELSE RETURN ERROR(.NDEL,#147); M_GPTR(.M,0,36,.X,.I); IF NOT REGP(.M) THEN M_GDOT(.M); CODE(.F,REGAK(A_LEXRA(.VA)),MEMORYA(.M) OR .INDIRMASK,.ART[.VA]); IF .F LEQ #130 THEN SESTOG_.SESTOG OR 8; .A END; %3.1% GLOBAL ROUTINE CONVEY(X)= % GENERATE CODE TO MOVE X TO .VREG, THE VALUE-REGISTER. % GESCAPE(.X,CNVEYC); GLOBAL ROUTINE GRETURN(X)= % GENERATE CODE FOR RETURN X. % BEGIN LOCAL V,C,I; REGISTER PTRTOI; PCIVR(.X,0); V_GESCAPE(.X,CODEC); I_.CODEPTR; PTRTOI_I; DO C_.CT[ADVR1(.PTRTOI),0] UNTIL IF .C GEQ BEC THEN CASE .C-BEC OF SET %BEC% BEGIN CODE(XCT,0,LABLE(ADVR1(.PTRTOI)),0); SURFACE(.PTRTOI) END; %FRC% GUJUMP(ADVR1(.PTRTOI)); %CURRENTC% 0 TES ELSE IF .I EQL .PROGRAM THEN RETURN ERROR(.NDEL,#144) ELSE SURFACE(.PTRTOI); .V END; ! OVERALL COMMENT ON HOW EXIT STATEMENTS ARE HANDLED: ! ! TO INSURE THAT CODE TO CONVEY UNUSED VALUES IS DISCARDED WHEN AN ! EXIT STATEMENT IS GENERATED, THE CONVEYING CODE IS HUNG OFF A HEADER OF ! TYPE XLOOPC, XCASEC, ETC. DEPENDING ON THE CONTROL ENVIRONMENT BEING ! EXITED. FOR EXAMPLE, THE EXIT STATEMENT: ! DO DO IF .A THEN .B ELSE EXIT[2] WHILE C() UNTIL D() ! IS GENERATED INTERNALLY BY GXEXIT AS THOUGH IT WAS AN EXITLOOP[1]. THE ! SUBCLASS FIELD OF THE EXITC HEADER CONTAINS THE COUNT OF THE NUMBER OF ! LEVELS OF CONTROL OF THIS CLASS TO BE EXITED. EACH TIME THE PROMOTE ! ROUTINE (SEE LOLSTPKG) IS CALLED BY THE APPROPRIATE CONTROL ROUTINE OF ! THIS CLASS IT DECREMENTS THIS COUNT BY 1. WHEN THE COUNT REACHES 0, THEN ! THE EXITCLASS IS CHANGED TO A CONVEYC AND THE VALUE IS SUBSEQUENTLY ! RETAINED OR DISCARDED. %V2H% GLOBAL ROUTINE GLEAVE(X,N)= %V2H% !THIS ROUTINE WILL EVENTUALLY REPLACE GXEXIT AND THE %V2H% !INDIVIDUAL EXIT CONTROL ROUTINES EXCEPT FOR PERHAPS %V2H% !EXITLOOP FOR BLIS11 COMPATIBILITY. THIS REPLACES %V2H% !ALL "EXIT" TYPE EXCAPES WITH "LEAVE" TYPE ESCAPES. IT %V2H% !IS BASICALLY PATTERNED AFTER GXEXIT AND USES PRETTY MUCH THE %V2H% !THE SAME MECHANISM. %V2H% ! GENERATE JUMP TO PROPER LABEL. SEE COMMENT ABOVE. %V2H% %V2H% BEGIN %V2H% STRUCTURE EXITVECT[I]=[I](.EXITVECT-2+.I)<0,36>; %V2H% %V2H% BIND XCLASSES=1^COSTC+1^SELECTC+1^CMPEXC+1^ITEC+1^DWUC+1^WUDC+1^IDFTDC+1^BEC; %V2H% REGISTER C, ! CLASS OF CELL BEING TESTED %V2H% SUBCLASS, ! SUBCLASS OF CELL BEING TESTED %V2H% EXTYPE, ! TYPE(CLASS) OF CONTROL ACTUALLY EXITED %V2H% CODEPTRSAV, ! A TEMP TO HOLD CODEPTR (NEC. BECAUSE LOCATE STARTS SEARCH AT .CODEPTR) %V2H% PTRTOI; ! HOLDS POINTER TO I TO PASS TO ADVR1, ETC. %V2H% %V2H% LOCAL V, ! LEXEME OF VALUE REGISTER %V2H% EXCODIND, ! INDEX OF HEADER W/ CODE TO LOAD VREG %V2H% I, ! INDEX OF CELL BEING TESTED %V2H% CODEPROD, ! BOOLEAN INDICATING CODE GENERATED TO LOAD VREG %V2H% EXITVECT NUM[6],! A VECTOR IN WHICH NUM[I] CONTAINS THE %V2H% ! NUMBER OF LEVELS OF EXITABLE CONTROL %V2H% ! OF TYPE I ACTUALLY EXITED %V2H% ICURR, !TO SAVE CURRENT CONTENTS OF I %V2H% HEADER; !INDEX OF HEADER OF WHICH .I IS CURRENTLY A SUBHEADER. %V2H% %V2H% PCIVR(.X,0); %V2H% CODEPROP_0; %V2H% V_GESCAPE(.X,XITC); %V2H% CODEPROD_.CODEPROP; %V2H% I_.CODEPTR; %V2H% PTRTOI_I; %V2H% EXCODIND_.CT[.CODEPTR,0]; %V2H% NUM[2]_NUM[3]_NUM[4]_NUM[5]_NUM[6]_NUM[7]_0; %V2H% DO C_.CT[ADVR1(.PTRTOI),0] UNTIL %V2H% IF (1^.C AND XCLASSES) NEQ 0 OR (.C GEQ BEC) THEN %V2H% BEGIN %V2H% SUBCLASS_.CT[.I,1]; %V2H% ICURR_.I; !SAVE CURRENT INDEX %V2H% SURFACE(.PTRTOI); !GET HEADER INDEX %V2H% HEADER_.I; !SAVE HEADER INDEX %V2H% I_.ICURR; !RESTORE OLD I %V2H% CASE .C - COSTC OF %V2H% SET %V2H% !COSTC ******** #16 %V2H% BEGIN %V2H% NUM[XCOSTC]_.NUM[XCOSTC]+1; %V2H% IF .N EQL .HEADER %V2H% THEN %V2H% BEGIN %V2H% EXTYPE_XCOSTC; %V2H% CODEPTRSAV_.CODEPTR; CODEPTR_.I; %V2H% I_LOCATE(COSTC,7); %V2H% CODEPTR_.CODEPTRSAV; %V2H% GUJUMP(.I) %V2H% END %V2H% ELSE SURFACE(.PTRTOI) %V2H% END; %V2H% !SELECTC ******** #17 %V2H% BEGIN %V2H% NUM[XSELECTC]_.NUM[XSELECTC]+1; %V2H% IF .N EQL .HEADER THEN %V2H% BEGIN %V2H% EXTYPE_XSELECTC; %V2H% CODEPTRSAV_.CODEPTR; CODEPTR_.I; %V2H% I_LOCATE(SELECTC,5); %V2H% CODEPTR_.CODEPTRSAV; %V2H% GUJUMP(.I) %V2H% END %V2H% ELSE SURFACE(.PTRTOI) %V2H% END; %V2H% 0; !SELELC ******** #20 %V2H% 0; !EXCHC ******** #21 %V2H% 0; !CREATC ******** #22 %V2H% 0; !UNUSED ******** #23 %V2H% 0; !UNUSED ******** #24 %V2H% 0; !CASEC ******** #25 %V2H% 0; !SETC ******** #26 %V2H% 0; !NSETC ******** #27 %V2H% !CMPEXC ******** #30 %V2H% BEGIN %V2H% NUM[XCMPEXC]_.NUM[XCMPEXC]+1; %V2H% IF .N EQL .HEADER THEN %V2H% (EXTYPE_XCMPEXC;GUJUMP(ADVR1(.PTRTOI));CT[.CT[.I,0],2]_1) %V2H% ELSE SURFACE(.PTRTOI) %V2H% END; %V2H% !ITEC ******** #31 %V2H% BEGIN %V2H% NUM[XCONDC]_.NUM[XCONDC]+1; %V2H% IF .N EQL .HEADER %V2H% THEN %V2H% BEGIN %V2H% EXTYPE_XCONDC; %V2H% CODEPTRSAV_.CODEPTR; CODEPTR_.I; %V2H% I_LOCATE(ITEC,5); %V2H% CODEPTR_.CODEPTRSAV; %V2H% GUJUMP(.I) %V2H% END %V2H% ELSE SURFACE(.PTRTOI) %V2H% END; %V2H% !DWUC ******** #32 %V2H% BEGIN %V2H% NUM[XLOOPC]_.NUM[XLOOPC]+1; %V2H% IF .N EQL .HEADER %V2H% THEN %V2H% BEGIN %V2H% EXTYPE_XLOOPC; %V2H% CODEPTRSAV_.CODEPTR; CODEPTR_.I; %V2H% I_LOCATE(DWUC,4); %V2H% CODEPTR_.CODEPTRSAV; %V2H% GUJUMP(.I) %V2H% END %V2H% ELSE SURFACE(.PTRTOI) %V2H% END; %V2H% !WUDC ******** #33 %V2H% BEGIN %V2H% NUM[XLOOPC]_.NUM[XLOOPC]+1; %V2H% IF .N EQL .HEADER %V2H% THEN %V2H% BEGIN %V2H% EXTYPE_XLOOPC; %V2H% CODEPTRSAV_.CODEPTR; CODEPTR_.I; %V2H% I_LOCATE(WUDC,6); %V2H% CODEPTR_.CODEPTRSAV; %V2H% GUJUMP(.I) %V2H% END %V2H% ELSE SURFACE(.PTRTOI) %V2H% END; %V2H% !IDFTDC ******** #34 %V2H% BEGIN %V2H% NUM[XLOOPC]_.NUM[XLOOPC]+1; %V2H% IF .N EQL .HEADER THEN %V2H% BEGIN %V2H% EXTYPE_XLOOPC; %V2H% CODEPTRSAV_.CODEPTR; CODEPTR_.I; %V2H% I_LOCATE(IDFTDC,6); %V2H% CODEPTR_.CODEPTRSAV; %V2H% GUJUMP(.I) %V2H% END %V2H% ELSE SURFACE (.PTRTOI) %V2H% END; %V2H% !BEC ******** #35 %V2H% BEGIN %V2H% NUM[XBLOCKC]_.NUM[XBLOCKC]+1; %V2H% IF .N EQL .HEADER THEN (EXTYPE_XBLOCKC;GUJUMP(ADVR1(.PTRTOI)); CT[ADVR2(.PTRTOI),2]_1) %V2H% ELSE (CODE(XCT,0,LABLE(ADVR1(.PTRTOI)),0);SURFACE(.PTRTOI)) %V2H% END; %V2H% !FRC ******** #36 %V2H% RETURN(ERROR(.NDEL,#144)); %V2H% !CURRENTC ******** #37 %V2H% 0 %V2H% TES %V2H% END ELSE %V2H% IF .I EQL .PROGRAM THEN RETURN ERROR(.NDEL,#144) %V2H% ELSE SURFACE (.PTRTOI); %V2H% IF .CODEPROD NEQ 0 THEN %V2H% BEGIN %V2H% CT[.EXCODIND,0]_.EXTYPE; %V2H% CT[.EXCODIND,1]_.NUM[.EXTYPE] %V2H% END; %V2H% .V %V2H% END; ROUTINE GXEXIT(X,N,XTYPE,XCLASSES)= ! CALLED BY ALL THE EXIT ROUTINES TO GENERATE CODE TO CONVEY VALUE ! GENERATE JUMP TO PROPER LABEL. SEE COMMENT ABOVE. BEGIN STRUCTURE EXITVECT[I]=[I](.EXITVECT-2+.I)<0,36>; REGISTER C, ! CLASS OF CELL BEING TESTED SUBCLASS, ! SUBCLASS OF CELL BEING TESTED EXTYPE, ! TYPE(CLASS) OF CONTROL ACTUALLY EXITED CODEPTRSAV, ! A TEMP TO HOLD CODEPTR (NEC. BECAUSE LOCATE STARTS SEARCH AT .CODEPTR) PTRTOI; ! HOLDS POINTER TO I TO PASS TO ADVR1, ETC. LOCAL V, ! LEXEME OF VALUE REGISTER EXCODIND, ! INDEX OF HEADER W/ CODE TO LOAD VREG I, ! INDEX OF CELL BEING TESTED CODEPROD, ! BOOLEAN INDICATING CODE GENERATED TO LOAD VREG EXITVECT NUM[6];! A VECTOR IN WHICH NUM[I] CONTAINS THE ! NUMBER OF LEVELS OF EXITABLE CONTROL ! OF TYPE I ACTUALLY EXITED PCIVR(.X,0); CODEPROP_0; V_GESCAPE(.X,.XTYPE); CODEPROD_.CODEPROP; I_.CODEPTR; PTRTOI_I; EXCODIND_.CT[.CODEPTR,0]; NUM[2]_NUM[3]_NUM[4]_NUM[5]_NUM[6]_NUM[7]_0; DO C_.CT[ADVR1(.PTRTOI),0] UNTIL IF (1^.C AND .XCLASSES) NEQ 0 OR (.C GEQ BEC) THEN BEGIN SUBCLASS_.CT[.I,1]; CASE .C - SETC OF SET !SETC BEGIN N_.N-1;NUM[XCOSTC]_.NUM[XCOSTC]+1; IF .N EQL 0 THEN BEGIN CODEPTRSAV_.CODEPTR; CODEPTR_.I; I_IF .CT[LOCATE(COSTC,0),3] AND ((1^CASEC AND .XCLASSES) EQL 0) THEN LOCATE(SETC,3) ELSE LOCATE(COSTC,7); CODEPTR_.CODEPTRSAV; EXTYPE_XCOSTC; GUJUMP(.I) END ELSE SURFACE(.PTRTOI) END; !NSETC BEGIN N_.N-1;NUM[XSELECTC]_.NUM[XSELECTC]+1; IF .N EQL 0 THEN BEGIN EXTYPE_XSELECTC; CODEPTRSAV_.CODEPTR; CODEPTR_.I; I_LOCATE(SELECTC,5); CODEPTR_.CODEPTRSAV; GUJUMP(.I) END ELSE SURFACE(.PTRTOI) END; !CMPEXC BEGIN N_.N-1;NUM[XCMPEXC]_.NUM[XCMPEXC]+1; IF .N EQL 0 THEN (EXTYPE_XCMPEXC;GUJUMP(ADVR1(.PTRTOI));CT[.CT[.I,0],2]_1) ELSE SURFACE(.PTRTOI) END; !ITEC IF .SUBCLASS EQL 1 THEN SURFACE(.PTRTOI) ELSE BEGIN N_.N-1;NUM[XCONDC]_.NUM[XCONDC]+1; IF .N EQL 0 THEN (EXTYPE_XCONDC;GUJUMP(IF .SUBCLASS EQL 2 THEN ADVR3(.PTRTOI) ELSE ADVR1(.PTRTOI))) ELSE SURFACE(.PTRTOI) END; !DWUC IF .SUBCLASS NEQ 2 THEN SURFACE(.PTRTOI) ELSE BEGIN N_.N-1;NUM[XLOOPC]_.NUM[XLOOPC]+1; IF .N EQL 0 THEN (EXTYPE_XLOOPC;GUJUMP(ADVR2(.PTRTOI))) ELSE SURFACE(.PTRTOI) END; !WUDC IF .SUBCLASS NEQ 3 THEN SURFACE (.PTRTOI) ELSE BEGIN N_.N-1;NUM[XLOOPC]_.NUM[XLOOPC]+1; IF .N EQL 0 THEN (EXTYPE_XLOOPC;GUJUMP(ADVR3(.PTRTOI))) ELSE SURFACE(.PTRTOI) END; !IDFTDC IF .SUBCLASS NEQ 3 THEN SURFACE(.PTRTOI) ELSE BEGIN N_.N-1;NUM[XLOOPC]_.NUM[XLOOPC]+1; IF .N EQL 0 THEN BEGIN EXTYPE_XLOOPC; CODEPTRSAV_.CODEPTR; CODEPTR_.I; I_LOCATE(IDFTDC,6); CODEPTR_.CODEPTRSAV; GUJUMP(.I) END ELSE SURFACE (.PTRTOI) END; !BEC BEGIN IF (1^BEC AND .XCLASSES) NEQ 0 THEN (N_.N-1;NUM[XBLOCKC]_.NUM[XBLOCKC]+1); IF .N EQL 0 THEN (EXTYPE_XBLOCKC;GUJUMP(ADVR1(.PTRTOI)); CT[ADVR2(.PTRTOI),2]_1) ELSE (CODE(XCT,0,LABLE(ADVR1(.PTRTOI)),0);SURFACE(.PTRTOI)) END; !FRC RETURN(ERROR(.NDEL,#144)); !CURRENTC 0 TES END ELSE IF .I EQL .PROGRAM THEN RETURN ERROR(.NDEL,#144) ELSE SURFACE (.PTRTOI); IF .CODEPROD NEQ 0 THEN BEGIN CT[.EXCODIND,0]_.EXTYPE; CT[.EXCODIND,1]_.NUM[.EXTYPE] END; .V END; GLOBAL ROUTINE GXBLOCK(X,N)=GXEXIT(.X,.N,XBLOCKC,1^BEC); GLOBAL ROUTINE GXLOOP(X,N)=GXEXIT(.X,.N,XLOOPC,1^DWUC OR 1^WUDC OR 1^IDFTDC); GLOBAL ROUTINE GXCOND(X,N)=GXEXIT(.X,.N,XCONDC,1^ITEC); GLOBAL ROUTINE GXCMPEX(X,N)=GXEXIT(.X,.N,XCMPEXC,1^CMPEXC); GLOBAL ROUTINE GXSELECT(X,N)=GXEXIT(.X,.N,XSELECTC,1^NSETC); GLOBAL ROUTINE GXSET(X,N)=GXEXIT(.X,.N,XCOSTC,1^SETC); GLOBAL ROUTINE GXCASE(X,N)=GXEXIT(.X,.N,XCOSTC,1^CASEC OR 1^SETC); GLOBAL ROUTINE GEXIT(X,N)=GXEXIT(.X,.N,XITC,1^SETC OR 1^NSETC OR 1^CMPEXC OR 1^ITEC OR 1^DWUC OR 1^WUDC OR 1^IDFTDC OR 1^BEC); ROUTINE GESCAPE(X,N)= % CALLED FOR CONVEY AND ALL EXIT STATEMENTS. GENERATES CODE TO LOAD VREG WITH X (IF NECESSARY). % BEGIN LOCAL V, ! LEXEME OF VALUE REGISTER NAME; !RT-INDEX OF VREG'S NAME IF LEXRN(.ART[.VREG]) EQL .X THEN RETURN .X; NAME_.ART[.VREG]; V_ IF .NAME NEQ 0 THEN IF .X EQL .NAME THEN INCRUSEN(.NAME) ELSE IF .NAME GEQ 16 THEN LEXRN(.NAME) ELSE LEXRN(GETRN(.VREG,0,0)) ELSE LEXRN(GETRN(.VREG,0,0)); FOLLCPH(0,.N,0); GLPR(.X,.VREG); FOLLCPH(0,CODEC,0); CLEARONE(RT[.V]); .V END; ROUTINE GCUJUMP(X,J,N,U)= % GENERATE CODE TO JUMP TO CODE TABLE ENTRY J, CONDITIONALLY ON LEXEME X EQV N. FOR THE SPECIAL CASE X EQV N AT COMPILE TIME, GENERATE AN UNCONDITIONAL JUMP ONLY IF U=1, OTHERWISE GENERATE NO CODE. % ! RETURNS: ! 0 --> X NOT EQV AT COMPILE TIME ! 1 --> X EQV N AT COMPILE TIME ! 2 --> EQUIVALENCE NOT KNOWN AT COMPILE TIME ! ! THIS IS THE ROUTINE THAT OPTIMIZES THE RELATIONAL BOOLEANS. E.G.: ! "IF .A LSS 0 THEN ..." ETC. GLSS (H2ARITH) HAS HUNG THE CODE FOR ! ".A LSS 0" OFF A RELC HEADER AND THIS ROUTINE MANIPULATES THAT CODE ! DISCARDING SOME OF IT. IT ALSO ATTEMPTS TO PRODUCE AOJLE ETC. FOR ! CONSTRUCTS OF THE FORM ... (A_.A+1) LEQ 0 ... BEGIN IF LITP(.X) THEN RETURN IF LITV(.X) EQV .N THEN IF .U THEN GUJUMP(.J) ELSE 1 ELSE 0; IF NO(.X) THEN RETURN GCUJUMP(GYES(.X),.J,.N XOR 1,.U); IF SIGN(.X) THEN RETURN GCUJUMP(GABS(.X),.J,.N,.U); IF REGP(.X) AND (NULL(.CODEPTR) OR ALLNOS(.CODEPTR)) THEN BEGIN LOCAL AOJTYPE,CAI0TYPE,RELINST,INEQ,AOIND,FUNC; MACRO AOINST=CT[.AOIND,1]$; REGISTER HEADIND, ! INDEX OF RELC HEADER PCH; ! INDEX OF CODE LIST PREVIOUS TO RELC HEADIND_.CT[.CODEPTR,0]; IF NOT .CT[.HEADIND,0] EQL RELC THEN EXITBLOCK; IF NOT .CT[.HEADIND,2] EQL .X THEN EXITBLOCK; IF .CT[.CT[.HEADIND,1],1] EQL MOVEI THEN ERASETOP(.HEADIND); ERASEBOT(.HEADIND); AOJTYPE_0; CAI0TYPE_(.CT[.HEADIND,3] AND NOT (7^27 OR #17^23)) EQL CAI^27 AND .CT[RELINST_.CT[.HEADIND,1],0] EQL 0; INEQ_.CT[.HEADIND,3]<27,3>; IF .CAI0TYPE THEN BEGIN PCH_.CT[.HEADIND,0]; IF .CT[.PCH,0] NEQ CODEC THEN EXITCOMP; IF NULL(.PCH) OR ALLNOS(.PCH) THEN EXITCOMP; AOIND_PREVCODE(.CT[.PCH,1],.PCH); AOINST_.CT[.AOIND,1]; FUNC_.AOINST; IF .AOINST NEQ .CT[.HEADIND,3] THEN EXITCOMP; AOJTYPE_ .FUNC EQL AOJ OR .FUNC EQL SOJ; IF .FUNC EQL AOS OR .FUNC EQL SOS OR .AOJTYPE THEN BEGIN EMPTY(.HEADIND); RELINST_PUSHBOT(.HEADIND,TAKE(.AOIND)); CT[.HEADIND,3]_.AOINST; CT[.HEADIND,3]<27,3>_CT[.RELINST,1]<27,3>_.INEQ; CAI0TYPE_0 END END; FUNC_.CT[.HEADIND,3]; IF .CAI0TYPE OR .AOJTYPE THEN BEGIN FUNC_IF .AOJTYPE THEN .FUNC AND #770 ELSE JUMP; CODE(.FUNC OR (.N^2 XOR .INEQ XOR 4), .CT[.HEADIND,3],LABLE(.J),0) END ELSE BEGIN CT[.RELINST,1]<27,3>_.INEQ XOR .N^2; PUSHBOT(.CODEPTR,TAKE(.RELINST)); GUJUMP(.J) END; IF .FREEVHEADER LSS 0 THEN BEGIN EMPTY(.HEADIND); CT[.HEADIND,0]_CODEC; CT[.HEADIND,1]_0; RELEASESPACE(.HEADIND+2,1); FREEVHEADER_.HEADIND END ELSE ERASE(.HEADIND); DULEX(.X); CLEARONE(RT[.X]); RETURN 2 END; BEGIN LOCAL P,S; IF .FREEVHEADER LSS 0 THEN BEGIN FREEVHEADER_FOLLCPH(0,CODEC,0); FOLLCPH(0,CODEC,0) END; IF .X NEQ 0 AND (S_.X) NEQ 0 AND (P_.X) LSS 36 THEN CODE(CASE .P/18*2+.N OF SET TRNN; TRNE; TLNN; TLNE TES, RAGLAR(GAT(.X AND (RTEM OR LSSTEM))), 1^(.P MOD 18),0) ELSE CODE(IF .N THEN TRNE ELSE TRNN,REGAR(GLAR(.X)),1,0); GUJUMP(.J); END; 2 END; ROUTINE GUJUMP(J)= % GENERATE UNCONDITIONAL JUMP TO J. % BEGIN CODE(JRST,0,LABLE(.J),0); 1 END; ROUTINE LABLE(J)= % SET RELOCATION FIELD OF J TO BE LABEL. % BEGIN J_CTRELOC; .J END; %% % THIS SUB-MODULE GENERATES THE LINKAGE CODE FOR TIMING BLISS ROUTINES. TIMSTE CONTAINS THE INDEX OF THE STE OF THE TIMER ROUTINE NAME % %% ROUTINE TIMLINK(MPINST,INST)= BEGIN MACRO MAKEOP(OP,REG,ADDR)=((OP)<0,0>^27 + (REG)<0,0>^23 + (ADDR)<0,0>)$; LOCAL REG; CODE(.INST,.JSPREG,0,0); IF .MPINST NEQ 0 THEN CODE(.MPINST,.JSPREG,#400000,0); CODE (PUSH, .SREG,.JSPREG, 0); CODE (PUSHJ,.SREG, GMA(.TIMSTE OR LSM OR DOTM), 0); CODE (SUB, .SREG, LITA(LITLEXEME(1^18+1)), 0); IF .DEBFLG THEN !PUT PUSHJ TO TIMER ROUTINE IN USERS .JB41 (WRITE9(#41,MAKEOP(PUSHJ,.SREG,0)); ! CODE WRIT10(#41,GETNAM(TABLE[.TIMSTE + 2],6))); ! EXTERNAL REQUEST %% % .INST R,0 PUSH $S,R PUSHJ $S, SUB $S,[1000001] % %% END; GLOBAL ROUTINE TIMEIN=TIMLINK(0,HRRZI); GLOBAL ROUTINE TIMEOUT=BEGIN CODE(PUSH,.SREG,.VREG,0); TIMLINK(0,HRROI); CODE(POP,.SREG,.VREG,0); END; GLOBAL ROUTINE MPTIMIN=TIMLINK(TLO,HRRZI); GLOBAL ROUTINE MPTIMOUT=TIMLINK(TLZ,HRROI); GLOBAL ROUTINE DEBIN(RTNSTE)=CODE(DEBUGUUO,0,GMA(.RTNSTE OR LSM OR DOTM),0); GLOBAL ROUTINE DEBOUT(RTNSTE)=CODE(DEBUGUUO,1,GMA(.RTNSTE OR LSM OR DOTM),0); !END OF H1CNTR.BLI