#include // 1 ! Some instances of the following records failed to identify fields: Q_ V_ S_ AVAR_ B_ C_ W_ F_ R_ CHAIN_ TARGET_ L_ // 2 // 3 {###################################} // 4 {# Copyright (C) 1988 #} // 5 {# 3L Limited #} // 6 {# #} // 7 {# All rights reserved #} // 8 {###################################} // 9 // 10 {Pass 2 for ARM IMP} // 11 // 12 %externalstring(7) P2 Version = "004" _imp_string /*%string(7)*/ P2VERSION = _imp_str_literal("004"); // 13 // 14 ! To Do: // 15 ! // 16 // 17 !Revision history: // 18 ! // 19 ! 004 7-Sep-88 PSR Made DALLOC forget Sp and // 20 ! made FORGET forget locked regs {C-136} // 21 ! 003 22-Jun-88 PSR Changes to compile native on A310 // 22 ! Made diag string 127 instead of 31 // 23 ! 002 23-Feb-88 PSR Changed to ARM calling stack frame // 24 ! 001 4-FEB-88 PSR Started additions for ACORN DEBUG // 25 ! - Record diags dumped in reverse order (that of declaration) // 26 ! 0.9 15-Jan-88 PSR Removed the %name %array ILABELS by means of // 27 ! another recordformat. // 28 ! ******* release 1.2 sent to Acorn & Validated ******* // 29 ! 2-Nov-87 PSR Put FORGET DESTINATION in JUMP BACKWARDS to permit // 30 ! unassigned checking of control // 31 ! catching unassigned FOR control variables // 32 ! - Made MULTIPLY call LOAD PROTECTED in case destination // 33 ! register is already in use. (SCR/87/448) // 34 ! 9-Oct-87 PSR Made R14 preferable when hazarding to prevent // 35 ! corrupting a parameter (e.g. for REAL EXP). (SCR/87/449) // 36 ! - Added check for "Subroutines nested too deeply" (SCR/87/447) // 37 ! 0.8 5-Oct-87 PSR Removed optimisation for C1*(V1+C2) :: overflow! // 38 ! - Added check for the cases: (I<= A*B (SCR/87/409) // 43 ! - Fixed OPERATE which was converting A<= [something] which was returning a zero/non-zero // 54 ! condition code but testing for a >= or <= code (SCR/87/398) // 55 ! - Added internally-generated NO-OP 128+'0' + // 56 ! - made WORK AREAS an indefinitely expanding list. (SCR/87/400) // 57 ! - Corrected bugs in ABS(ABS(X)), ABS(-X), and ABS(\X). // 58 ! (SCR/87/401, SCR/87/422) // 59 ! 0.6 16-Sep-87 PSR Test version for BSI visit // 60 ! - Made BUILD SET save & restore oper & link to fix // 61 ! problems with S := [1..x]-[y]; (SCR/87/388) // 62 ! - Set the WORK SET bit on the temp created by BUILD SET // 63 ! - Problem with passing longreals as parameters. The LDM // 64 ! in PPARAMS.INC was not preceded by the necessary HAZARDS // 65 ! - ABS(X) used unsafe MOVS to set condition code, // 66 ! would not work if CC already set incorrectly. // 67 ! 0.5 7-Aug-87 NPH [SCR/87/324] Set value to Default value in Update Line // 68 ! // 69 ! 0.5 4-Aug-87 NPH [SCR/87/325] If saved, Wsp must be saved after a Dalloc // 70 ! Quick soln : save it again if it has been saved. // 71 ! // 72 ! 30-Jul-87 PSR PESSIMISE got the wrong displacement when temps were // 73 ! a long way away from FP // 74 ! Was also a problem with STAB. // 75 ! 8-Jul-87 PSR Forget destination not forgetting after R_a(n) = ... // 76 ! - Stopped optimising X&255 -> byte load when checkable // 77 ! 0.4 24-Jun-87 PSR The event trap routine was forgetting everything // 78 ! AFTER it had planted the LDR Wsp .... This was wrong // 79 ! it the save area was too far away for a simple load. // 80 ! This gave rise to an address error in Pascal Pass1 after // 81 ! a *FATAL ERROR report. // 82 ! 0.3 14-Jun-87 PSR Fixed ALL CONST when first string isn't constant // 83 ! - Fixed PRINTSTRING("") // 84 ! 0.2 28-Mar-86 PSR Tightened up setting condition-code values // 85 ! - remembered ZERO after in-line loops // 86 ! - added optimisation to remember constants after IF x=const // 87 ! - improved handling of SHORTS (esp in S&16_FFFF) // 88 ! - optimised X op Y shift Const, X shift const op Y // 89 ! - corrected problem with OWNs living at 0(SB) // 90 ! - corrected problem causing Record=0 to clear by bytes. // 91 ! 0.01 24-Mar-86 PSR Released to Acorn // 92 ! 0.01 27-Jan-86 PSR Cloned from SUN pass2 v0.39 // 93 // 94 %owninteger Diag = 0, static int DIAG = 0; static int DEBUG = 0; static int CURRENTLINE = 0; // 95 Debug = 0, {#0 if -DEBUG specified} {001} // 96 Current Line = 0 {here to aid diagnostics} // 97 // 98 %constinteger MonCode = 1<<0, // 99 MonStack = 1<<1, // 100 MonReg = 1<<2, // 101 MonOperand = 1<<3, // 102 MonOperate = 1<<4, // 103 MonMove = 1<<5, // 104 MonLine = 1<<6, // 105 MonOpt = 1<<7, // 106 MonCond = 1<<8, // 107 MonBang = 1<<9 // 108 // 109 %constinteger Infinity = (-1)>>1, // 110 Minus Infinity = \Infinity // 111 // 112 %constinteger Max Vars = 2000, Var Top = Max Vars>>6, // 113 Max Labels = 8000, Max Label = Max Labels!255, // 114 Max Work Areas = 500, Max Work Area = Max Work Areas!15, // 115 Max Nesting = 17, // 116 Max Bound = 7, // 117 Set Size = 256//8 // 118 // 119 {Types} // 120 // 121 %constinteger Undefined = 0, // 122 Integers = 1, // 123 Shorts = 2, // 124 Halves = 3, // 125 Bytes = 4, // 126 Addrs = 5, // 127 Reals = 6, // 128 Lreals = 7, // 129 Strings = 8, // 130 Records = 9, // 131 Generals = 10, // 132 Labels = 11, // 133 Booleans = 12, // 134 Sets = 13 // 135 // 136 %constbytearray Internal Type(Undefined:Sets) = const unsigned char INTERNALTYPE[14] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 4, 13, }; // 137 Undefined, Integers, Shorts, Halves, Bytes, Addrs, // 138 Reals, Lreals, // 139 Strings, Records, Generals, Labels, Bytes, Sets // 140 // 141 %conststring(7)%array TypeId(Undefined:Sets) = const _imp_string /*%string(7)*/ TYPEID[14] = { _imp_str_literal("Unknown"), _imp_str_literal("Integer"), _imp_str_literal("Short "), _imp_str_literal("Half "), _imp_str_literal("Byte "), _imp_str_literal("Addr "), _imp_str_literal("Real "), _imp_str_literal("Lreal "), _imp_str_literal("String "), _imp_str_literal("Record "), _imp_str_literal("General"), _imp_str_literal("Label "), _imp_str_literal("Boolean"), _imp_str_literal("Set "), }; // 142 "Unknown", "Integer", "Short ", "Half ", "Byte ", "Addr ", // 143 "Real ", "Lreal ", // 144 "String ", "Record ", "General", "Label ", "Boolean", "Set " // 145 // 146 %constbytearray Type Fmt (Undefined:Sets) = 0,4,2,2,1,4,4,8,0,0,0, 0,1,32 const unsigned char TYPEFMT[14] = { 0, 4, 2, 2, 1, 4, 4, 8, 0, 0, 0, 0, 1, 32, }; // 147 %constbytearray Type Code(Undefined:Sets) = 0,1,6,6,5,1,2,8,3,4,0,10,0,0 const unsigned char TYPECODE[14] = { 0, 1, 6, 6, 5, 1, 2, 8, 3, 4, 0, 10, 0, 0, }; // 148 %constbytearray Type Size(Undefined:Sets) = 0,4,2,2,1,4,4,8,0,0,12,0,2,Set Size const unsigned char TYPESIZE[14] = { 0, 4, 2, 2, 1, 4, 4, 8, 0, 0, 12, 0, 2, 32, }; // 149 %constbytearray Ucheck (Undefined:Sets) = 0,1,0,0,0,1,1,1,1,0,0,0,0,0 const unsigned char UCHECK[14] = { 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, }; // 150 // 151 !%from IMP %include Option3l, Stream3l, Spec3l, Interfac, // 152 ! Comm23, Attr, Lflags // 153 // 154 %include "imp/option3l.inc" // 1 %constinteger LL Trusted = 1<< 0, // 2 LL Trace = 1<< 1, // 3 LL Vars = 1<< 2, // 4 LL Lines = 1<< 3, // 5 LL Records = 1<< 4, // 6 LL Assigned = 1<< 5, // 7 LL Array = 1<< 6, // 8 LL Range = 1<< 7, // 9 LL Variants = 1<< 8, // 10 LL Knuth = 1<< 9, // 11 LL Warn = 1<<10, // 12 LL Mon = 1<<11, // 13 LL Reference = 1<<12, // 14 LL Notify = 1<<13, // 15 LL Extend = 1<<14, // 16 LL Level0 = 1<<15, // 17 LL Report = 1<<16, // 18 LL Decode = 1<<17, // 19 LL Predef = 1<<18, // 20 LL List = 1<<19, // 21 LL Stack = 1<<20, // 22 LL Anon = 1<<21, // 23 LL Brief = 1<<22, // 24 LL Debug = 1<<23 // 25 %endoffile // 155 %include "imp/stream3l.inc" // 1 %constinteger Source = 1, Predef In = 2 // 2 // 3 %constinteger Icode In = 1, Icode Out = 1, // 4 Icode In2 = 2, // 5 Report = 0, // 6 Objectives Out = 1, Objectives In = 1, PrimObj In = 3, // 7 Directives Out = 2, Directives In = 2, PrimDir In = 4, // 8 Object Out = 1, Decode Out = 3, // 9 Listing = 7 // 10 %endoffile // 156 %include "imp/spec3l.inc" // 1 {Spec3L.INC} // 2 %endoffile // 157 %include "imp/interfac.inc" // 1 %recordformat CommFm( %c typedef struct COMMFM COMMFM; struct COMMFM { int LANGUAGE; int OPTIONS; int SPECIALS; int PRIM; int STATEMENTS; int FAULTS; int REFCOUNT; int PRIMREFCOUNT; int DEFCOUNT; int PRIMDEFCOUNT; int BLOCKCOUNT; int PRIMBLOCKCOUNT; int EXTERNALCOUNT; int PRIMEXTERNALCOUNT; int GLOBALSIZE; int PRIMGLOBALSIZE; int FORMATS; int PRIMFORMATS; int CONSTANTSIZE; int PRIMCONSTANTSIZE; int GLOBALARRAYSIZE; int TOTALITEMS; int TOTALBLOCKS; int TOTALFORMATS; int TOTALEXTERNALS; _imp_string /*%string(255)*/ SOURCEFILE; _imp_string /*%string(255)*/ MODULE; }; // 2 %integer Language, // 3 Options, // 4 Specials, // 5 Prim, // 6 Statements, // 7 Faults, // 8 Ref Count, Prim Ref Count, // 9 Def Count, Prim Def Count, // 10 Block Count, Prim Block Count, // 11 External Count, Prim External Count, // 12 Global Size, Prim Global Size, // 13 Formats, Prim Formats, // 14 Constant Size, Prim Constant Size, // 15 Global Array Size, // 16 Total Items, // 17 Total Blocks, // 18 Total Formats, // 19 Total Externals, // 20 %string(255) Source File, // 21 Module) // 22 // 23 %constinteger Special Main = 2_0001 // 24 %endoffile // 158 %include "imp/comm23.inc" // 1 %constinteger Dir Start Block = 1, // 2 Dir Diag = 2, // 3 Dir Line = 3, // 4 Dir Include = 4, // 5 Dir Record On = 5, // 6 Dir Record Off = 6, // 7 Dir Slabel = 7, // 8 Dir Label = 8, // 9 Dir Mark User = 9, // 10 Dir Const Addr = 10 // 11 // 12 %constinteger Dir Const Load = 11, // 13 Dir Real Load = 12, // 14 Dir Spec Load = 13, // 15 Dir Branch = 14, // 16 Dir McLabel = 15, // 17 Dir Modify = 16, // 18 Dir Header = 17, // 19 Dir Thunk = 18, // 20 Dir xThunk = 19, // 21 Dir Call = 20 // 22 // 23 %constinteger Dir Ext = 21, // 24 Dir Xref = 22, // 25 Dir xCall = 23, // 26 Dir Assigned = 24, // 27 Dir Prim = 25, // 28 Dir Return = 26, // 29 Dir Area = 27, // 30 Dir Swdef = 28, // 31 Dir Sw Ref = 29, // 32 Dir Init = 30 // 33 // 34 %constinteger Dir Dump = 31, // 35 Dir End Block = 32, // 36 Dir Debug Array = 33, // 37 Dir Debug Var = 34, // 38 Dir Debug Start Proc = 35, // 39 Dir Debug End Proc = 36 // 40 // 41 %constinteger Max Dir = 36 // 42 %endoffile // 159 %include "imp/attr.inc" // 1 %constinteger Attr Needs Display = 2_00 0000 0001, // 2 Attr Inner Uses = 2_00 0000 0010, // 3 Attr Needs Gp = 2_00 0000 0100, // 4 Attr Prim = 2_00 0000 1000, // 5 Attr Xdef = 2_00 0001 0000, // 6 Attr Sp Unknown = 2_00 0010 0000, // 7 Attr Dynamic = 2_00 0100 0000, // 8 Attr Local Display = 2_00 1000 0000, // 9 Attr Inherit = 2_01 0000 0000, // 10 Attr Globals = 2_10 0000 0000 // 11 // 12 %constinteger Attr Both = 2_00 0000 0010 // 13 %endoffile // 160 %include "imp/lflags.inc" // 1 {lflags} // 2 // 3 %constinteger Pascal Flag = 2_0001, // 4 Non Exact For = 2_0010, // 5 Undefined Control = 2_0100 // 6 %endoffile // 161 // 162 // 163 %include "opcodes.inc" // 1 %constinteger Invert Cond = 16_E000 0000 // 2 // 3 %constinteger Cond EQ = 16_0000 0000 !! Invert Cond, // 4 Cond NE = 16_1000 0000 !! Invert Cond, // 5 Cond CS = 16_2000 0000 !! Invert Cond, // 6 Cond CC = 16_3000 0000 !! Invert Cond, // 7 Cond MI = 16_4000 0000 !! Invert Cond, // 8 Cond PL = 16_5000 0000 !! Invert Cond, // 9 Cond VS = 16_6000 0000 !! Invert Cond, // 10 Cond VC = 16_7000 0000 !! Invert Cond, // 11 Cond HI = 16_8000 0000 !! Invert Cond, // 12 Cond LS = 16_9000 0000 !! Invert Cond, // 13 Cond GE = 16_A000 0000 !! Invert Cond, // 14 Cond LT = 16_B000 0000 !! Invert Cond, // 15 Cond GT = 16_C000 0000 !! Invert Cond, // 16 Cond LE = 16_D000 0000 !! Invert Cond, // 17 Cond AL = 16_E000 0000 !! Invert Cond, // 18 Cond NV = 16_F000 0000 !! Invert Cond // 19 // 20 {The Invert Cond is to make ALWAYS default to 0 internally} // 21 // 22 %constinteger Post Indexed = 16_0100 0000, // 23 Reg Index = 16_0200 0000, // 24 Write Back = 1<<21, // 25 Byte Op = 1<<22, // 26 Scc = 1<<20 // 27 // 28 %constinteger IA = 16_0080 0000, {increment after} // 29 IB = 16_0180 0000, {increment before} // 30 DA = 16_0000 0000, {decrement after} // 31 DB = 16_0100 0000 {decrement before} // 32 // 33 %constinteger Logical Left = 2_000<<4, // 34 Logical Right = 2_010<<4, // 35 Arithmetic Right = 2_100<<4, // 36 Rotate Right = 2_110<<4 // 37 // 38 %constinteger Logical Left R = 2_1001<<4, // 39 Logical Right R = 2_1011<<4, // 40 Arithmetic Right R = 2_1101<<4, // 41 Rotate Right R = 2_1111<<4 // 42 // 43 %constinteger ADD = 16_4 << 21, // 44 ADC = 16_5 << 21, // 45 SUB = 16_2 << 21, // 46 SBC = 16_6 << 21, // 47 RSB = 16_3 << 21, // 48 RSC = 16_7 << 21, // 49 CMP = 16_A << 21 ! Scc, // 50 CMN = 16_B << 21 ! Scc, // 51 AND = 16_0 << 21, // 52 EOR = 16_1 << 21, // 53 ORR = 16_C << 21, // 54 BIC = 16_E << 21, // 55 TST = 16_8 << 21 ! Scc, // 56 TEQ = 16_9 << 21 ! Scc, // 57 MOV = 16_D << 21, // 58 MVN = 16_F << 21 // 59 // 60 %constinteger LDR = 16_0410 0000, // 61 STR = 16_0400 0000 // 62 // 63 %constinteger SWI = 16_0F00 0000 // 64 // 65 %constinteger LDM = 16_0810 0000, // 66 STM = 16_0800 0000 // 67 // 68 %constinteger B = 16_0A00 0000, // 69 BL = 16_0B00 0000 // 70 // 71 {Floating-point ops} // 72 // 73 %constinteger LDFD = 2_ 00001100 0 0 0 1 0000 1000 0001 00000000, // 74 LDFS = 2_ 00001100 0 0 0 1 0000 0000 0001 00000000, // 75 STFD = 2_ 00001100 0 0 0 0 0000 1000 0001 00000000, // 76 STFS = 2_ 00001100 0 0 0 0 0000 0000 0001 00000000 // 77 // 78 %constinteger FLT = 2_ 00001110 000 0 1000 0000 0001 0001 0000, // 79 FIX = 2_ 00001110 000 1 1000 0000 0001 0001 0000 // 80 // 81 %constinteger CMF = 2_ 00001110 100 1 0000 1111 0001 0001 0000, // 82 CNF = 2_ 00001110 101 1 0000 1111 0001 0001 0000 // 83 // 84 %constinteger Small Constant = 8 // 85 // 86 !These are the extended-mode functions // 87 !%constinteger ADF = 2_ 00001110 0000 1000 0000 0001 0000 0000, // 88 ! MUF = 2_ 00001110 0001 1000 0000 0001 0000 0000, // 89 ! SUF = 2_ 00001110 0010 1000 0000 0001 0000 0000, // 90 ! RSF = 2_ 00001110 0011 1000 0000 0001 0000 0000, // 91 ! DVF = 2_ 00001110 0100 1000 0000 0001 0000 0000, // 92 ! RDF = 2_ 00001110 0101 1000 0000 0001 0000 0000, // 93 ! POW = 2_ 00001110 0110 1000 0000 0001 0000 0000, // 94 ! RPW = 2_ 00001110 0111 1000 0000 0001 0000 0000, // 95 ! RMF = 2_ 00001110 1000 1000 0000 0001 0000 0000, // 96 ! POL = 2_ 00001110 1100 1000 0000 0001 0000 0000, // 97 ! MVF = 2_ 00001110 0000 1000 1000 0001 0000 0000, // 98 ! MNF = 2_ 00001110 0001 1000 1000 0001 0000 0000, // 99 ! ABS = 2_ 00001110 0010 1000 1000 0001 0000 0000, // 100 ! SQT = 2_ 00001110 0100 1000 1000 0001 0000 0000, // 101 ! LOG = 2_ 00001110 0101 1000 1000 0001 0000 0000, // 102 ! LGN = 2_ 00001110 0110 1000 1000 0001 0000 0000, // 103 ! EXP = 2_ 00001110 0111 1000 1000 0001 0000 0000, // 104 ! SIN = 2_ 00001110 1000 1000 1000 0001 0000 0000, // 105 ! COS = 2_ 00001110 1001 1000 1000 0001 0000 0000, // 106 ! TAN = 2_ 00001110 1010 1000 1000 0001 0000 0000, // 107 ! ASN = 2_ 00001110 1011 1000 1000 0001 0000 0000, // 108 ! ACS = 2_ 00001110 1100 1000 1000 0001 0000 0000, // 109 ! ATN = 2_ 00001110 1101 1000 1000 0001 0000 0000, // 110 ! FML = 2_ 00001110 1001 0000 0000 0001 1000 0000, // 111 ! FDV = 2_ 00001110 1010 0000 0000 0001 1000 0000, // 112 ! FRD = 2_ 00001110 1011 0000 0000 0001 1000 0000, // 113 ! RND = 2_ 00001110 0011 0000 1000 0001 1000 0000 // 114 ! // 115 !These are the double-precision functions // 116 %constinteger ADF = 2_ 00001110 0000 0000 0000 0001 1000 0000, // 117 MUF = 2_ 00001110 0001 0000 0000 0001 1000 0000, // 118 SUF = 2_ 00001110 0010 0000 0000 0001 1000 0000, // 119 RSF = 2_ 00001110 0011 0000 0000 0001 1000 0000, // 120 DVF = 2_ 00001110 0100 0000 0000 0001 1000 0000, // 121 RDF = 2_ 00001110 0101 0000 0000 0001 1000 0000, // 122 POW = 2_ 00001110 0110 0000 0000 0001 1000 0000, // 123 RPW = 2_ 00001110 0111 0000 0000 0001 1000 0000, // 124 RMF = 2_ 00001110 1000 0000 0000 0001 1000 0000, // 125 POL = 2_ 00001110 1100 0000 0000 0001 1000 0000, // 126 MVF = 2_ 00001110 0000 0000 1000 0001 1000 0000, // 127 MNF = 2_ 00001110 0001 0000 1000 0001 1000 0000, // 128 ABS = 2_ 00001110 0010 0000 1000 0001 1000 0000, // 129 SQT = 2_ 00001110 0100 0000 1000 0001 1000 0000, // 130 LOG = 2_ 00001110 0101 0000 1000 0001 1000 0000, // 131 LGN = 2_ 00001110 0110 0000 1000 0001 1000 0000, // 132 EXP = 2_ 00001110 0111 0000 1000 0001 1000 0000, // 133 SIN = 2_ 00001110 1000 0000 1000 0001 1000 0000, // 134 COS = 2_ 00001110 1001 0000 1000 0001 1000 0000, // 135 TAN = 2_ 00001110 1010 0000 1000 0001 1000 0000, // 136 ASN = 2_ 00001110 1011 0000 1000 0001 1000 0000, // 137 ACS = 2_ 00001110 1100 0000 1000 0001 1000 0000, // 138 ATN = 2_ 00001110 1101 0000 1000 0001 1000 0000, // 139 FML = 2_ 00001110 1001 0000 0000 0001 1000 0000, // 140 FDV = 2_ 00001110 1010 0000 0000 0001 1000 0000, // 141 FRD = 2_ 00001110 1011 0000 0000 0001 1000 0000, // 142 RND = 2_ 00001110 0011 0000 1000 0001 1000 0000 // 143 %endoffile // 164 // 165 %externalroutine PASS2(%record(Commfm)%name Interface) void PASS2( COMMFM /*name*/*INTERFACE ) { // 166 %constinteger Word Length = 4, {in bytes} // 167 Alignment = 3, {word alignment needed} // 168 Alignment Mask = \Alignment // 169 // 170 %externalroutinespec D68000(%integer Op, Ca) extern void D68000( int OP, int CA ); // 171 %externalroutinespec Dump Encoded(%integer N) extern void DUMPENCODED( int N ); // 172 %include "xspecs.inc" // 1 {xspecs} // 2 // 3 %externalroutinespec Print Hex %alias "3L_IMP_PRINT_HEX"(%integer N, P) extern void PRINTHEX( int N, int P ) __asm__("3L_IMP_PRINT_HEX"); // 4 %endoffile // 173 // 174 {Register info} // 175 // 176 {Integer activities are: 0 = free // 177 { -1 = locked // 178 { >0 = claimed that many times // 179 {NOTE: registers are only claimed by LOAD (or the load implied by OPTIMISE} // 180 // 181 { Register Alias} // 182 %constinteger None = 0, // 183 R0 = 1, // 184 R1 = 2, // 185 R2 = 3, // 186 R3 = 4, // 187 R4 = 5, // 188 R5 = 6, // 189 R6 = 7, // 190 R7 = 8, // 191 R8 = 9, // 192 R9 = 10, Sb = R9, // 193 R10 = 11, Fp = R10, // 194 R11 = 12, Ip = R11, // 195 R12 = 13, Sp = R12, // 196 R13 = 14, Sl = R13, // 197 R14 = 15, Link = R14, // 198 R15 = 16, Pc = R15, // 199 Any = 17, // 200 F0 = 18, // 201 F1 = 19, // 202 F2 = 20, // 203 F3 = 21, // 204 F4 = 22, // 205 F5 = 23, // 206 F6 = 24, // 207 F7 = 25, // 208 AnyF = 26 // 209 { Register Alias} // 210 // 211 %constbytearray Actual(0:AnyF) = 0, 0, 1, 2, 3, 4, 5, 6, 7, const unsigned char ACTUAL[27] = { 0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 0, 0, 1, 2, 3, 4, 5, 6, 7, 0, }; // 212 8, 9, 10, 11, 12, 13, 14, 15, 0, // 213 0, 1, 2, 3, 4, 5, 6, 7, 0 // 214 // 215 // 216 %conststring(3)%array RegId(0:AnyF) = "", const _imp_string /*%string(3)*/ REGID[27] = { _imp_str_literal(""), _imp_str_literal("R0 "), _imp_str_literal("R1 "), _imp_str_literal("R2 "), _imp_str_literal("R3 "), _imp_str_literal("R4 "), _imp_str_literal("R5 "), _imp_str_literal("R6 "), _imp_str_literal("R7 "), _imp_str_literal("R8 "), _imp_str_literal("R9 "), _imp_str_literal("R10"), _imp_str_literal("R11"), _imp_str_literal("R12"), _imp_str_literal("R13"), _imp_str_literal("R14"), _imp_str_literal("R15"), _imp_str_literal("R? "), _imp_str_literal("F0 "), _imp_str_literal("F1 "), _imp_str_literal("F2 "), _imp_str_literal("F3 "), _imp_str_literal("F4 "), _imp_str_literal("F5 "), _imp_str_literal("F6 "), _imp_str_literal("F7 "), _imp_str_literal("F? "), }; // 217 "R0 ", "R1 ", "R2 ", "R3 ", "R4 ", "R5 ", "R6 ", "R7 ", // 218 "R8 ", "R9 ", "R10", "R11", "R12", "R13", "R14", "R15", "R? ", // 219 "F0 ", "F1 ", "F2 ", "F3 ", "F4 ", "F5 ", "F6 ", "F7 ", "F? " // 220 // 221 %constbytearray Rtype(0:AnyF) = Undefined, Integers(17), Lreals(9) const unsigned char RTYPE[27] = { 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7, 7, 7, 7, 7, 7, 7, 7, 7, }; // 222 // 223 %recordformat Boundfm(%integer Lower, Upper, Mult) typedef struct BOUNDFM BOUNDFM; struct BOUNDFM { int LOWER; int UPPER; int MULT; }; // 224 %recordformat Afm(%integer Dimension, typedef struct AFM AFM; struct AFM { int DIMENSION; int TOTALSIZE; int ZERODISPLACEMENT; int DV; int LOCALFRAME; int BASE; BOUNDFM BOUND[7]; }; // 225 Total Size, // 226 Zero Displacement, // 227 DV, // 228 Local Frame, // 229 Base, // 230 %record(Boundfm)%array Bound(1:Max Bound)) // 231 // 232 %constrecord(Afm)%name A type == 0 {for NEW} const AFM /*name*/*ATYPE = { 0 } /* Initialise all fields of a record to 0. */; // 233 // 234 %recordformat Varfm(%integer Flags, typedef struct VARFM VARFM; struct VARFM { int FLAGS; unsigned char BASE; unsigned char PRIM; unsigned char TYPE; unsigned char FORM; double RVAR; int DISP; int EXTRA; AFM /*name*/*ADATA; int FORMAT; int SCALE; int AREA; }; // 235 %byte Base, Prim, // 236 %byte Type, Form, // 237 (%longreal Rvar %or // 238 %integer Disp, (%integer Extra %or %record(Afm)%name Adata)), // 239 (%integer Format %or %integer Scale), // 240 %integer Area) // 241 // 242 // 243 %recordformatspec Stackfm // 244 %recordformat Olfm(%integer Oper, %record(Stackfm)%name Link) typedef struct OLFM OLFM; struct OLFM { int OPER; void /*name*/*LINK; }; // 245 %recordformat Xfm(%integer Xsize, %record(Stackfm)%name Index) typedef struct XFM XFM; struct XFM { int XSIZE; void /*name*/*INDEX; }; // 246 // 247 %recordformat Datafm( %c typedef struct DATAFM DATAFM; struct DATAFM { VARFM V; int VARNO; VARFM /*name*/*FV; int BIAS; unsigned char REG; unsigned char LABEL; void /*name*/*PARAMS; void /*name*/*RECORD; int OPER; void /*name*/*LINK; OLFM OPLINK; int XSIZE; void /*name*/*INDEX; XFM X; }; // 248 %record(Varfm) V, // 249 %integer Varno, // 250 %record(Varfm)%name Fv, // 251 (%integer Bias %or %byte Reg, Label), // 252 %record(Stackfm)%name Params, Record, // 253 (%integer Oper, %record(Stackfm)%name Link %or %record(Olfm) Oplink), // 254 (%integer Xsize, %record(Stackfm)%name Index %or %record(Xfm) X)) // 255 // 256 %recordformat Memberfm(%integer Const, Items, typedef struct MEMBERFM MEMBERFM; struct MEMBERFM { int CONST; int ITEMS; void /*name*/*A; void /*name*/*B; MEMBERFM /*name*/*LINK; }; // 257 %record(Stackfm)%name A, B, // 258 %record(Memberfm)%name Link) // 259 // 260 %constrecord(Memberfm)%name Memberfm Type == 0 const MEMBERFM /*name*/*MEMBERFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 261 // 262 %recordformat Stackfm( %c typedef struct STACKFM STACKFM; struct STACKFM { VARFM V; DATAFM DATA; int FLAGS; unsigned char BASE; unsigned char PRIM; unsigned char TYPE; unsigned char FORM; double RVAL; int RHIGH; int RLOW; int DISP; int EXTRA; AFM /*name*/*ADATA; int FORMAT; int SCALE; int AREA; int VARNO; VARFM /*name*/*FV; MEMBERFM /*name*/*MEMBERS; int BIAS; unsigned char REG; unsigned char LABEL; STACKFM /*name*/*PARAMS; STACKFM /*name*/*RECORD; int OPER; STACKFM /*name*/*LINK; OLFM OPLINK; int XSIZE; STACKFM /*name*/*INDEX; XFM X; STACKFM /*name*/*USING; STACKFM /*name*/*STACK; }; // 263 %record(Varfm) V %or // 264 %record(Datafm) Data %or // 265 %integer Flags, // 266 %byte Base, Prim, // 267 %byte Type, Form, // 268 (%longreal Rval %or %integer Rhigh, Rlow %c // 269 %or (%integer Disp, (%integer Extra %or %record(Afm)%name Adata)), // 270 (%integer Format %or %integer Scale), // 271 %integer Area, // 272 %integer Varno, // 273 (%record(Varfm)%name Fv %or %record(Memberfm)%name Members), // 274 (%integer Bias %or %byte Reg, Label), // 275 %record(Stackfm)%name Params, Record, // 276 (%integer Oper, %record(Stackfm)%name Link %or %record(Olfm) Oplink), // 277 (%integer Xsize, %record(Stackfm)%name Index %or %record(Xfm) X)), // 278 %record(Stackfm)%name Using, Stack) // 279 // 280 %constrecord(Stackfm)%name Stackfm Type == 0 const STACKFM /*name*/*STACKFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 281 // 282 %recordformat Withfm(%integer Key, %record(Datafm) Data, typedef struct WITHFM WITHFM; struct WITHFM { int KEY; DATAFM DATA; WITHFM /*name*/*LINK; }; // 283 %record(Withfm)%name Link) // 284 %constrecord(Withfm)%name Withfm Type == 0 const WITHFM /*name*/*WITHFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 285 // 286 %recordformat Workfm(%integer Size, Displacement, Validity) typedef struct WORKFM WORKFM; struct WORKFM { int SIZE; int DISPLACEMENT; int VALIDITY; }; // 287 %recordformat WorkVfm(%record(WorkVfm)%name Link, typedef struct WORKVFM WORKVFM; struct WORKVFM { WORKVFM /*name*/*LINK; WORKFM W[31]; }; // 288 %record(Workfm)%array W(0:30)) // 289 %constrecord(WorkVfm)%name WorkVfmType == 0 const WORKVFM /*name*/*WORKVFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 290 %record(WorkVfm) Work List = 0 WORKVFM WORKLIST; WORKLIST = (WORKVFM){ 0 } /* Assign 0's to all fields of record */; // 291 %integer Work Validity = 1, Last Work = -1 int WORKVALIDITY; WORKVALIDITY = 1; int LASTWORK; LASTWORK = (-1); // 292 // 293 {Flag bits} // 294 // 295 %constinteger By Ref = 1<< 0, {in FLAGS} // 296 Array = 1<< 1, // 297 Parameter = 1<< 2, {procedure parameter} // 298 Defered = 1<< 3, {needs indirection} // 299 Hazarded = 1<< 4, // 300 Static = 1<< 5, // 301 Arrayname = 1<< 6, // 302 Known Ass = 1<< 7, {cannot be unassigned} // 303 Prim Proc = 1<< 8, // 304 Primitive = 1<< 9, {prim procedure} // 305 Xproc Spec = 1<<10, {external procedure} // 306 Closed = 1<<11, {cannot return} // 307 Internal = 1<<12, {can use JSB} // 308 Call it = 1<<13, {cannot use JSB} // 309 Null Set = 1<<14, // 310 Keep Local = 1<<15, // 311 Nasty Proc = 1<<16, {uses the environment} // 312 Awanted = 1<<17, // 313 Work Set = 1<<18, // 314 Answer = 1<<19, // 315 Checkable = 1<<20, // 316 Pred Call = 1<<21, {is a predicate} // 317 Stored With = 1<<22, // 318 Xdata Spec = 1<<23, // 319 Xproc Def = 1<<24 // 320 // 321 %recordformat Forfm(%byte Label, Entry, Reg, CC, typedef struct FORFM FORFM; struct FORFM { unsigned char LABEL; unsigned char ENTRY; unsigned char REG; unsigned char CC; int TYPE; int AS; DATAFM CONTROL; DATAFM FINAL; FORFM /*name*/*LINK; }; // 322 %integer Type, // 323 %integer AS, // 324 %record(Datafm) Control, Final, // 325 %record(Forfm)%name Link) // 326 %constrecord(Forfm)%name ForfmType == 0 const FORFM /*name*/*FORFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 327 %ownrecord (Forfm)%name Fors == 0 static FORFM /*name*/*FORS = { 0 } /* Initialise all fields of a record to 0. */; // 328 // 329 %ownrecord(Stackfm)%name Stack == 0 static STACKFM /*name*/*STACK = { 0 } /* Initialise all fields of a record to 0. */; // 330 %ownrecord(Stackfm)%name Using == 0, static STACKFM /*name*/*USING = { 0 } /* Initialise all fields of a record to 0. */; static STACKFM /*name*/*DASL = { 0 } /* Initialise all fields of a record to 0. */; // 331 Dasl == 0 // 332 // 333 %recordformat Valuefm(%longreal Real %or %c typedef struct VALUEFM VALUEFM; struct VALUEFM { double REAL; int INTEGER; _imp_string /*%string(255)*/ STRING; unsigned char FILL[256]; }; // 334 %integer Integer %or %c // 335 %string(255) String %or %c // 336 %bytearray Fill(0:255)) // 337 // 338 %ownrecord(Valuefm) Value = 0, static VALUEFM VALUE = { 0 } /* Initialise all fields of a record to 0. */; static VALUEFM DEFAULTVALUE = { 0 } /* Initialise all fields of a record to 0. */; // 339 Default Value = 0 // 340 // 341 // 342 {Internal operations} // 343 // 344 %constinteger Real Shift = 21 // 345 // 346 %constinteger NOTx = 1, {Integer operations} // 347 NEGx = 2, // 348 ABSx = 3, // 349 ADDx = 4, // 350 SUBx = 5, // 351 MULx = 6, // 352 DIVx = 7, // 353 EXPx = 8, // 354 ANDx = 9, // 355 ORx = 10, // 356 XORx = 11, // 357 BICx = 12, // 358 ROTx = 13, // 359 LSHx = 14, // 360 RSHx = 15, // 361 REMx = 16, // 362 MODx = 17, // 363 MULHx = 18, {special for halfword multiply} // 364 UDIVx = 19, {unsigned divide} // 365 UREMx = 20, {unsigned rem} // 366 EXTx = 21, // 367 CONCx = 22, // 368 RNEGx = NEGx+Real Shift, {floating-point operations} // 369 RABSx = ABSx+Real Shift, // 370 RADDx = ADDx+Real Shift, // 371 RSUBx = SUBx+Real Shift, // 372 RMULx = MULx+Real Shift, // 373 RDIVx = DIVx+Real Shift, // 374 REXPx = EXPx+Real Shift // 375 // 376 // 377 %conststring(4)%array OperId(NOTx:REXPx) = const _imp_string /*%string(4)*/ OPERID[29] = { _imp_str_literal("not "), _imp_str_literal("neg "), _imp_str_literal("abs "), _imp_str_literal("add "), _imp_str_literal("sub "), _imp_str_literal("mul "), _imp_str_literal("div "), _imp_str_literal("exp "), _imp_str_literal("and "), _imp_str_literal("or "), _imp_str_literal("xor "), _imp_str_literal("bic "), _imp_str_literal("rot "), _imp_str_literal("lsh "), _imp_str_literal("rsh "), _imp_str_literal("rem "), _imp_str_literal("mod "), _imp_str_literal("ext "), _imp_str_literal("mulh"), _imp_str_literal("udiv"), _imp_str_literal("urem"), _imp_str_literal("conc"), _imp_str_literal("negr"), _imp_str_literal("absr"), _imp_str_literal("addr"), _imp_str_literal("subr"), _imp_str_literal("mulr"), _imp_str_literal("divr"), _imp_str_literal("expr"), }; // 378 "not ", "neg ", "abs ", // 379 "add ", "sub ", "mul ", "div ", "exp ", // 380 "and ", "or ", "xor ", "bic ", "rot ", "lsh ", "rsh ", // 381 "rem ", "mod ", // 382 "ext ", "mulh", "udiv", "urem", "conc", // 383 "negr", "absr", // 384 "addr", "subr", "mulr", "divr", "expr" // 385 // 386 {Oper flags} // 387 // 388 %constinteger Commutative = 1<<0, // 389 InPrim = 1<<1, // 390 Easy = 1<<2, // 391 Selfop = 1<<3, // 392 Unary = 1<<5, // 393 Incdec = 1<<6, // 394 No Assoc = 1<<7, // 395 Weak Assoc = 1<<8, Assoc Mask = No Assoc!Weak Assoc, // 396 Nullop = 1<<9 // 397 // 398 %constshortarray Oper Flags(NOTx:REXPx) = const short OPERFLAGS[29] = { 40, 40, 32, 589, 588, 769, 640, 642, 781, 781, 781, 780, 640, 648, 648, 128, 128, 128, 128, 128, 128, 128, 168, 160, 129, 128, 129, 128, 130, }; // 399 {NOTx} Unary!Selfop, // 400 {NEGx} Unary!Selfop, // 401 {ABSx} Unary, // 402 {ADDx} Commutative!Easy!Selfop!Nullop!Incdec, // 403 {SUBx} Easy!Selfop!Nullop!Incdec, // 404 {MULx} Commutative!Weak Assoc!Nullop, // 405 {DIVx} No Assoc!Nullop, // 406 {EXPx} InPrim!No Assoc!Nullop, // 407 {ANDx} Weak Assoc!Easy!Nullop!Selfop!Commutative, // 408 {ORx} Weak Assoc!Easy!Nullop!Selfop!Commutative, // 409 {XORx} Weak Assoc!Easy!Nullop!Selfop!Commutative, // 410 {BICx} Weak Assoc!Easy!Nullop!Selfop, // 411 {ROTx} No Assoc!Nullop, // 412 {LSHx} No Assoc!Nullop!Selfop, // 413 {RSHx} No Assoc!Nullop!Selfop, // 414 {REMx} No Assoc, // 415 {MODx} No Assoc, // 416 {EXTx} No Assoc, // 417 {MULHx} No Assoc, // 418 {UDIVx} No Assoc, // 419 {UREMx} No Assoc, // 420 {CONCx} No Assoc, // 421 {RNEGx} No Assoc!Unary!Selfop, // 422 {RABSx} No Assoc!Unary, // 423 {RADDx} No Assoc!Commutative, // 424 {RSUBx} No Assoc, // 425 {RMULx} No Assoc!Commutative, // 426 {RDIVx} No Assoc, // 427 {REXPx} No Assoc!Inprim // 428 // 429 %constintegerarray Easy Op(ADDx:BICx) = const int EASYOP[9] = { 8388608, 4194304, 0, 0, 0, 0, 25165824, 2097152, 29360128, }; // 430 {ADDx} ADD, // 431 {SUBx} SUB, // 432 {MULx} 0, // 433 {DIVx} 0, // 434 {EXPx} 0, // 435 {ANDx} AND, // 436 {ORx} ORR, // 437 {XORx} EOR, // 438 {BICx} BIC // 439 // 440 %constintegerarray Null Value(ADDx:RSHx) = const int NULLVALUE[12] = { 0, 0, 1, 1, 1, (-1), 0, 0, 0, 0, 0, 0, }; // 441 0, {ADDx} 0, {SUBx} 1, {MULx} // 442 1, {DIVx} 1, {EXPx} -1, {ANDx} // 443 0, {ORx} 0, {XORx} 0, {BICx} 0, {ROTx} // 444 0, {LSHx} 0 {RSHx} // 445 // 446 {Condition codes} // 447 // 448 %constinteger EQ = 1, LT = 2, GT = 4, TT = 8, Always = 7, // 449 NE = 6, LE = 3, GE = 5, FF = 9, Never = 0 // 450 // 451 %constbytearray Reverse(Never:FF) = Never, const unsigned char REVERSE[10] = { 0, 1, 4, 5, 2, 3, 6, 7, 8, 9, }; // 452 EQ {EQ}, GT {LT}, GE {LE}, // 453 LT {GT}, LE {GE}, NE {NE}, // 454 Always, TT {TT}, FF {FF} // 455 // 456 %constbytearray Negated(Never:FF) = Always, const unsigned char NEGATED[10] = { 7, 6, 5, 4, 3, 2, 1, 0, 9, 8, }; // 457 NE {EQ}, GE {LT}, GT {LE}, // 458 LE {GT}, LT {GE}, EQ {NE}, // 459 Never, FF {TT}, TT {FF} // 460 // 461 {Otypes} // 462 // 463 %constinteger Own = 1, EqualsEquals = 1, // 464 Con = 2, Equals = 0, // 465 External = 3, Jam = -1, // 466 System = 4, // 467 Dynamic = 5, // 468 Primrt = 6, // 469 Permrt = 7 // 470 // 471 {Procedure end codes} // 472 // 473 %constinteger Map = -2, // 474 Fn = -1, {negative implies stacked result} // 475 Routine = 0, // 476 True = 1, // 477 False = 2 // 478 // 479 // 480 %integer J, NN int J; int NN; // 481 %owninteger Code = 0, {current I-code symbol} static int CODE = 0; static int PENDING = 0; static int PENDINGTAG = 0; static int PENDINGLIT = 0; static int PENDINGAUTON = 0; static int PENDINGAUTO = 0; static int PENDINGAUTOCA = 0; static int LANGUAGEFLAGS = 0; static int STACKCHECK = 0; static int FALIGN = 0; // 482 Pending = 0, {next I-code symbol} // 483 Pending Tag = 0, {optimise 0<=N<=...} // 484 Pending Lit = 0, // 485 Pending Auto N = 0, // 486 Pending Auto = 0, // 487 Pending Auto Ca = 0, // 488 Language Flags = 0, // 489 Stack Check = 0, {entry for external} // 490 Falign = 0 {worst internal alignment} // 491 // 492 %owninteger Invert = 0, static int INVERT = 0; static int UNSIGNED = 0; static int FREELABEL; // 493 Unsigned = 0, // 494 Free Label // 495 // 496 %constinteger Defined = 16_8000 0000, // 497 Label Mask = \Defined, // 498 Inverted = 1 // 499 // 500 %recordformat Knowfm(%byte Ftype, Reg, Base, Oper, typedef struct KNOWFM KNOWFM; struct KNOWFM { unsigned char FTYPE; unsigned char REG; unsigned char BASE; unsigned char OPER; int DISP; int AREA; int OPND; int EXTRA; KNOWFM /*name*/*LINK; }; // 501 %integer Disp, Area, Opnd, Extra, // 502 %record(Knowfm)%name Link) // 503 %constrecord(Knowfm)%name KnowfmType == 0 const KNOWFM /*name*/*KNOWFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 504 // 505 %recordformat Labelfm(%integer Lab, %record(Knowfm)%name Env) typedef struct LABELFM LABELFM; struct LABELFM { int LAB; KNOWFM /*name*/*ENV; }; // 506 // 507 %recordformat Ilabelfm(%record(Ilabelfm)%name Link, typedef struct ILABELFM ILABELFM; struct ILABELFM { ILABELFM /*name*/*LINK; LABELFM LAB[256]; }; // 508 %record(Labelfm)%array Lab(0:255)) // 509 %constrecord(Ilabelfm)%name Ilabelfm Type == 0 const ILABELFM /*name*/*ILABELFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 510 %record(Ilabelfm)%name Ilabel List == NIL ILABELFM /*name*/*ILABELLIST; ILABELLIST = NIL; // 511 // 512 !0.9! %record(Ilabelfm)%namearray Ilabels(0: Max Label>>8) // 513 {0.9} %recordformat IlabelPfm(%record(Ilabelfm)%name Label) typedef struct ILABELPFM ILABELPFM; struct ILABELPFM { ILABELFM /*name*/*LABEL; }; // 514 {0.9} %record(IlabelPfm)%array Ilabels(0:Max Label>>8) ILABELPFM ILABELS[(((unsigned char)((int)((((unsigned int)(8191)) >> (8))))) + (1))]; // 515 // 516 %ownrecord(Knowfm)%name Knowing == 0, static KNOWFM /*name*/*KNOWING = { 0 } /* Initialise all fields of a record to 0. */; static KNOWFM /*name*/*KASL = { 0 } /* Initialise all fields of a record to 0. */; // 517 Kasl == 0 // 518 %ownintegerarray Ktimes(0:AnyF) = 0(*) static int KTIMES[27] = { [0 ... 26] = 0 }; // 519 // 520 %owninteger Used Time = 0 static int USEDTIME = 0; // 521 %ownintegerarray Used(0:AnyF) = 0(*) static int USED[27] = { [0 ... 26] = 0 }; // 522 %ownintegerarray Activity(0:AnyF) = 0(*) static int ACTIVITY[27] = { [0 ... 26] = 0 }; // 523 %owninteger Active Registers = 0 static int ACTIVEREGISTERS = 0; // 524 // 525 %integer Pending Known Register = 0 int PENDINGKNOWNREGISTER; PENDINGKNOWNREGISTER = 0; // 526 %record(Stackfm) Pending Known STACKFM PENDINGKNOWN; // 527 // 528 %ownstring(127) Alias = "", {003} static _imp_string /*%string(127)*/ ALIAS = _imp_str_literal(""); static _imp_string /*%string(127)*/ INTERNALID = _imp_str_literal(""); static _imp_string /*%string(127)*/ EXTERNALID = _imp_str_literal(""); static _imp_string /*%string(127)*/ SECTIONID = _imp_str_literal(""); // 529 Internal Id = "", // 530 External Id = "", // 531 Section Id = "" // 532 // 533 %owninteger Decl Size, static int DECLSIZE; static int VLB; static int VUB; static int OSTATE; static int OWNTYPE; static int OWNFORM; static int OWNEXTRA; static int CONSTANTTYPE; static int INITFLAG = 0; // 534 Vlb, Vub, // 535 Ostate, // 536 OwnType, // 537 OwnForm, // 538 Ownextra, // 539 Constant Type, // 540 Init Flag = 0 // 541 // 542 %record(Varfm)%name DefV VARFM /*name*/*DEFV; // 543 %record(Varfm) AltV VARFM ALTV; // 544 %owninteger Parms static int PARMS; // 545 %owninteger Section = 0 static int SECTION = 0; // 546 // 547 %owninteger Control = 0, {Unass Check} static int CONTROL = 0; static int UNASSIGNED = 0; static int COMPILINGPRIM = 0; // 548 Unassigned = 0, {#0 for unassigned checks} // 549 Compiling Prim = 0 {#0 when compiling PRIM file} // 550 // 551 {Forms} // 552 // 553 %constinteger Address = 0, // 554 Direct = Address+1, // 555 AutoI = 2, Memorable Limit = AutoI, // 556 AutoD = 3, // 557 Proc = 4, // 558 LabelX = 5, // 559 Indirect = 15 {**only for VARs**} // 560 // 561 %conststring(6)%array FormId(Address:LabelX) = "addr", "value", "()+", const _imp_string /*%string(6)*/ FORMID[6] = { _imp_str_literal("addr"), _imp_str_literal("value"), _imp_str_literal("()+"), _imp_str_literal("-()"), _imp_str_literal("proc"), _imp_str_literal("label"), }; // 562 "-()", "proc", "label" // 563 // 564 {Prim routines} // 565 // 566 %constinteger Signal = 1, {%signal} // 567 Cscomp = 2, {compare string & constant} // 568 Sres = 3, {string resolution} // 569 Sw Jump = 4, {switch jump} // 570 Intexp = 5, {integer exponentiation} // 571 RealExp = 6, {real exponentiation} // 572 Genmove = 7, {general string move} // 573 Sconc = 8, {string concatenation} // 574 Scomp = 9, {string comparison} // 575 Sjam = 10, {string jam transfer, length known} // 576 SetIn = 11, {test for R0 IN (R3)} // 577 Resflop = 12, {string resolution fails} // 578 TestNil = 13, {Nil, Unassigned & Disposed} // 579 MakeLocal = 14, {copy array into local space} // 580 Aref = 15, {n-dim array reference} // 581 Dynamic Range= 16, {Check R2 <= R1 <= R3} // 582 Dynamic N = 17, {n-dim array declaration} // 583 Frag1 = 18, {assign resolution fragment 1} // 584 RtMonitor = 19, {invoke run-time monitor} // 585 Set Bit = 20, {bit -> 1 in set} // 586 Captest = 21, {test for capacity exceeded} // 587 Ass Test = 22, {unassigned test} // 588 Trace Line = 23, {line trace debugger} // 589 Frag2 = 24, {assign resolution fragment 2} // 590 Clear Bit = 25, {bit -> 0 in set} // 591 Test New = 26, {fail if variant NEW} // 592 Nil Test = 27, {Test for NIL pointer} // 593 Set Bits = 28, {set multiple bits in SETs} // 594 Set Add = 29, // 595 Set Sub = 30, // 596 Set Inter = 31, // 597 Set GE = 32, // 598 Check Range = 33, // 599 Test MOD = 34, {check for a MOD (<=0)} // 600 Clear Bits = 35, {clear multiple bits in set} // 601 Test Variant = 36, // 602 Prim Mul = 37, // 603 Prim Div = 38, // 604 Test Real = 39, {compare real with zero} // 605 Prim Compare = 40, // 606 Real Intpt = 41, // 607 Modulus = 42 // 608 { Avoid "Program too complex" compiler failure } // 609 %const %integer Dynamic 1 = 43, {single-dimension dynamic array} // 610 Dynamic 2 = 44, {two-dimensional dynamic array} // 611 Psymbol = 45, {printsymbol} // 612 Set Range = 46, {check set ranges} // 613 ReadCh = 47, {readsymbol in prim} // 614 NextCh = 48, {nextsymbol in prim} // 615 Prim Udiv = 49, {unsigned divide} // 616 Set Zero = 50, {test for null set} // 617 Set Equal = 51, {test for set equality} // 618 Real Int = 52, {int(F0) -> R0} // 619 Real Round = 53, {round(F0) -> R0} // 620 CallP = 54, {call proc parameter} // 621 Enter P = 55, {jump to procedure} // 622 Dalloc = 56 {dynamic allocation & unassign} // 623 // 624 %constinteger Last Prim = 56 // 625 // 626 %owninteger Enter Proc = 0 {filled in on first use} static int ENTERPROC = 0; // 627 // 628 %constintegerarray Corrupts(Signal:Last Prim) = const int CORRUPTS[56] = { 0, 1, 4607, 0, 47, 393217, 4095, 60, 126, 15, 9, 0, 7, 15, 0, 0, 2287, 135, 0, 25, 0, 0, 4095, 77, 25, 0, 0, 58, 2559, 2559, 2559, 2559, 0, 0, 58, 0, 3, 63, 0, 31, 262145, 62, 511, 255, 8189, 56, 1023, 1023, 15, 510, 2559, 393217, 131073, 0, 0, 6160, }; // 629 {FFFF FFFF A RRRR RRRR RRRR RRRR } // 630 {7654 3210 FEDC BA98 7654 3210 } // 631 2_0000 0000 0 0000 0000 0000 0000, { 1:signal} // 632 2_0000 0000 0 0000 0000 0000 0001, { 2:cscomp} // 633 2_0000 0000 0 0001 0001 1111 1111, { 3:Sres} // 634 2_0000 0000 0 0000 0000 0000 0000, { 4:swjump} // 635 2_0000 0000 0 0000 0000 0010 1111, { 5:intexp} // 636 2_0000 0011 0 0000 0000 0000 0001, { 6:realexp} // 637 2_0000 0000 0 0000 1111 1111 1111, { 7:rtraceproc} // 638 2_0000 0000 0 0000 0000 0011 1100, { 8:Sconc} // 639 2_0000 0000 0 0000 0000 0111 1110, { 9:scomp} // 640 2_0000 0000 0 0000 0000 0000 1111, {10:sjam} // 641 2_0000 0000 0 0000 0000 0000 1001, {11:SetIn} // 642 2_0000 0000 0 0000 0000 0000 0000, {12:ResFlop} // 643 2_0000 0000 0 0000 0000 0000 0111, {13:sconc opt} // 644 2_0000 0000 0 0000 0000 0000 1111, {14:MakeLocal} // 645 2_0000 0000 0 0000 0000 0000 0000, {15:aref} // 646 2_0000 0000 0 0000 0000 0000 0000, {16:Dynamic Range} // 647 2_0000 0000 0 0000 1000 1110 1111, {17:dynamic n} // 648 2_0000 0000 0 0000 0000 1000 0111, {18:Frag1} // 649 2_0000 0000 0 0000 0000 0000 0000, {19:rtmonitor} // 650 2_0000 0000 0 0000 0000 0001 1001, {20:set bit} // 651 2_0000 0000 0 0000 0000 0000 0000, {21:captest} // 652 2_0000 0000 0 0000 0000 0000 0000, {22:asstest} // 653 2_0000 0000 0 0000 1111 1111 1111, {23:traceline} // 654 2_0000 0000 0 0000 0000 0100 1101, {24:Frag2} // 655 2_0000 0000 0 0000 0000 0001 1001, {25:Clear bit} // 656 2_0000 0000 0 0000 0000 0000 0000, {26:Test New} // 657 2_0000 0000 0 0000 0000 0000 0000, {27:Nil test} // 658 2_0000 0000 0 0000 0000 0011 1010, {28:Set Bits} // 659 2_0000 0000 0 0000 1001 1111 1111, {29:Set Add} // 660 2_0000 0000 0 0000 1001 1111 1111, {30:Set Sub} // 661 2_0000 0000 0 0000 1001 1111 1111, {31:Set Inter} // 662 2_0000 0000 0 0000 1001 1111 1111, {32:Set GE} // 663 2_0000 0000 0 0000 0000 0000 0000, {33:Check Range} // 664 2_0000 0000 0 0000 0000 0000 0000, {34:test mod} // 665 2_0000 0000 0 0000 0000 0011 1010, {35:Clear Bits} // 666 2_0000 0000 0 0000 0000 0000 0000, {36:Test Variant} // 667 2_0000 0000 0 0000 0000 0000 0011, {37:prim mul} // 668 2_0000 0000 0 0000 0000 0011 1111, {38:prim div} // 669 2_0000 0000 0 0000 0000 0000 0000, {39:test real} // 670 2_0000 0000 0 0000 0000 0001 1111, {40:primcomp} // 671 2_0000 0010 0 0000 0000 0000 0001, {41:intpt} // 672 2_0000 0000 0 0000 0000 0011 1110, {42:modulus} // 673 2_0000 0000 0 0000 0001 1111 1111, {43:dynamic 1} // 674 2_0000 0000 0 0000 0000 1111 1111, {44:dynamic 2} // 675 2_0000 0000 0 0001 1111 1111 1101, {45:Psymbol} // 676 2_0000 0000 0 0000 0000 0011 1000, {46:Set Range} // 677 2_0000 0000 0 0000 0011 1111 1111, {47:ReadCh} // 678 2_0000 0000 0 0000 0011 1111 1111, {48:NextCh} // 679 2_0000 0000 0 0000 0000 0000 1111, {49:prim udiv} // 680 2_0000 0000 0 0000 0001 1111 1110, {50:set zero} // 681 2_0000 0000 0 0000 1001 1111 1111, {51:set equal} // 682 2_0000 0011 0 0000 0000 0000 0001, {52:Real Int} // 683 2_0000 0001 0 0000 0000 0000 0001, {53:Real Round} // 684 2_0000 0000 0 0000 0000 0000 0000, {54:CallP} // 685 2_0000 0000 0 0000 0000 0000 0000, {55:EnterP} // 686 2_0000 0000 0 0001 1000 0001 0000 {56:Dalloc} {004} // 687 // 688 %constintegerarray Prim Parameter(Signal:Last Prim) = const int PRIMPARAMETER[56] = { 0, 6, 7966, 2, 6, 131073, 0, 12, 6, 7, 6, 0, 7, 7, 0, 14, 2054, 4230, 0, 258, 0, 0, 0, 4172, 258, 0, 2, 259, 2304, 2304, 2304, 2304, 10, 0, 259, 10, 3, 6, 0, 7, 3, 6, 56, 472, 2, 7, 0, 0, 6, 1, 3, 131073, 131072, 0, 0, 16, }; // 689 {FFFF FFFF A RRRR RRRR RRRR RRRR } // 690 {7654 3210 FEDC BA98 7654 3210 } // 691 2_0000 0000 0 0000 0000 0000 0000, { 1:signal} // 692 2_0000 0000 0 0000 0000 0000 0110, { 2:cscomp} // 693 2_0000 0000 0 0001 1111 0001 1110, { 3:Sres} // 694 2_0000 0000 0 0000 0000 0000 0010, { 4:swjump} // 695 2_0000 0000 0 0000 0000 0000 0110, { 5:intexp} // 696 2_0000 0001 0 0000 0000 0000 0001, { 6:realexp} // 697 2_0000 0000 0 0000 0000 0000 0000, { 7:traceproc} // 698 2_0000 0000 0 0000 0000 0000 1100, { 8:Sconc} // 699 2_0000 0000 0 0000 0000 0000 0110, { 9:scomp} // 700 2_0000 0000 0 0000 0000 0000 0111, {10:sjam} // 701 2_0000 0000 0 0000 0000 0000 0110, {11:SetIn} // 702 2_0000 0000 0 0000 0000 0000 0000, {12:ResFlop} // 703 2_0000 0000 0 0000 0000 0000 0111, {13:sconc opt} // 704 2_0000 0000 0 0000 0000 0000 0111, {14:MakeLocal} // 705 2_0000 0000 0 0000 0000 0000 0000, {15:aref} // 706 2_0000 0000 0 0000 0000 0000 1110, {16:Dynamic Range} // 707 2_0000 0000 0 0000 1000 0000 0110, {17:dynamic n} // 708 2_0000 0000 0 0001 0000 1000 0110, {18:Frag1} // 709 2_0000 0000 0 0000 0000 0000 0000, {19:rtmonitor} // 710 2_0000 0000 0 0000 0001 0000 0010, {20:set bit} // 711 2_0000 0000 0 0000 0000 0000 0000, {21:captest} // 712 2_0000 0000 0 0000 0000 0000 0000, {22:asstest} // 713 2_0000 0000 0 0000 0000 0000 0000, {23:traceline} // 714 2_0000 0000 0 0001 0000 0100 1100, {24:Frag2} // 715 2_0000 0000 0 0000 0001 0000 0010, {25:clear bit} // 716 2_0000 0000 0 0000 0000 0000 0000, {26:Test New} // 717 2_0000 0000 0 0000 0000 0000 0010, {27:Nil test} // 718 2_0000 0000 0 0000 0001 0000 0011, {28:Set Bits} // 719 2_0000 0000 0 0000 1001 0000 0000, {29:Set Add} // 720 2_0000 0000 0 0000 1001 0000 0000, {30:Set Sub} // 721 2_0000 0000 0 0000 1001 0000 0000, {31:Set Inter} // 722 2_0000 0000 0 0000 1001 0000 0000, {32:Set GE} // 723 2_0000 0000 0 0000 0000 0000 1010, {33:Check Range} // 724 2_0000 0000 0 0000 0000 0000 0000, {34:test mod} // 725 2_0000 0000 0 0000 0001 0000 0011, {35:Clear Bits} // 726 2_0000 0000 0 0000 0000 0000 1010, {36:Test Variant} // 727 2_0000 0000 0 0000 0000 0000 0011, {37:prim mul} // 728 2_0000 0000 0 0000 0000 0000 0110, {38:prim div} // 729 2_0000 0000 0 0000 0000 0000 0000, {39:test real} // 730 2_0000 0000 0 0000 0000 0000 0111, {40:primcomp} // 731 2_0000 0000 0 0000 0000 0000 0011, {41:intpt} // 732 2_0000 0000 0 0000 0000 0000 0110, {42:prim div} // 733 2_0000 0000 0 0000 0000 0011 1000, {43:dynamic 1} // 734 2_0000 0000 0 0000 0001 1101 1000, {44:dynamic 2} // 735 2_0000 0000 0 0000 0000 0000 0010, {45:Psymbol} // 736 2_0000 0000 0 0000 0000 0000 0111, {46:Set Range} // 737 2_0000 0000 0 0000 0000 0000 0000, {47:ReadCh} // 738 2_0000 0000 0 0000 0000 0000 0000, {48:NextCh} // 739 2_0000 0000 0 0000 0000 0000 0110, {49:prim udiv} // 740 2_0000 0000 0 0000 0000 0000 0001, {50:set zero} // 741 2_0000 0000 0 0000 0000 0000 0011, {51:set equal] // 742 2_0000 0001 0 0000 0000 0000 0001, {52:Real Int} // 743 2_0000 0001 0 0000 0000 0000 0000, {53:Real Round} // 744 2_0000 0000 0 0000 0000 0000 0000, {54:CallP} // 745 2_0000 0000 0 0000 0000 0000 0000, {55:EnterP} // 746 2_0000 0000 0 0000 0000 0001 0000 {56:Dalloc} // 747 // 748 {File data} // 749 // 750 %constinteger Icode = 1 // 751 // 752 %owninteger Last Dir = 0, static int LASTDIR = 0; static int REFS = 0; static int BLOCKS = 0; // 753 Refs = 0, Blocks = 0 // 754 // 755 {Areas} // 756 // 757 %constinteger Code Area = 0<<8, // 758 Own Area = 1<<8, // 759 Constant Area = 2<<8, // 760 Own Array Area = 3<<8 // 761 // 762 {============================================================} // 763 // 764 %owninteger Own Base = 0, {current own area address} static int OWNBASE = 0; static int MINSB = 0; static int OWNARRAYBASE = 0; static int CONSTANTBASE = 0; static int CURRENTAREA = 0; static int LASTAREA = 0; static int EXTERNALNO = 0; // 765 Min SB = 0, {backward offset into SB} // 766 Own Array Base = 0, // 767 Constant Base = 0, {current constant area address} // 768 Current Area = Code Area, {currently selected area} // 769 Last Area = 0, // 770 External No = 0 // 771 // 772 %constinteger Base Local = 128 // 773 // 774 %ownintegerarray Frame Use(Base Local:Base Local+Max Nesting) = 0(*) static int FRAMEUSE[18] = { [0 ... 17] = 0 }; // 775 %owninteger Fmark = 0 static int FMARK = 0; // 776 // 777 %record(Stackfm) Uapat, Zero, One, SpV STACKFM UAPAT; STACKFM ZERO; STACKFM ONE; STACKFM SPV; // 778 %record(Stackfm)%array RegV(None:AnyF) STACKFM REGV[27]; // 779 // 780 %record(Varfm)%name For Range == Nil {## Nil if check required} VARFM /*name*/*FORRANGE; FORRANGE = NIL; // 781 // 782 %record(Stackfm) C255 = 0; C255_Disp = 255; C255_Type = Integers STACKFM C255; C255 = (STACKFM){ 0 } /* Assign 0's to all fields of record */; C255.DISP = 255; C255.TYPE = 1; // 783 %constinteger No Danger = 16_7FFF {>> than 128+depth} // 784 %owninteger Jamit= 0, Entry Point = -1, static int JAMIT = 0; static int ENTRYPOINT = (-1); static int DANGERLEVEL = 32767; // 785 Danger Level = No Danger {limit of normal globals} // 786 // 787 %string(127) Include File = "" _imp_string /*%string(127)*/ INCLUDEFILE; INCLUDEFILE = _imp_str_literal(""); // 788 // 789 %integer Dtype {for remembering disag type on arrays} int DTYPE; // 790 // 791 %recordformat Qfm(%integer Type, Size, Round, Bias, Dim, Format, typedef struct QFM QFM; struct QFM { int TYPE; int SIZE; int ROUND; int BIAS; int DIM; int FORMAT; int DIAGS; int DTYPE; int DFORM; int IND; QFM /*name*/*POINTED; }; // 792 Diags, Dtype, Dform, Ind, // 793 %record(Qfm)%name Pointed) // 794 // 795 %recordformat Diag Fm(%record(Diagfm)%name Link, typedef struct DIAGFM DIAGFM; struct DIAGFM { DIAGFM /*name*/*LINK; VARFM /*name*/*VAR; int X; int XTYPE; int FORMAT; int EXT; _imp_string /*%string(127)*/ ID; }; // 796 %record(Varfm)%name Var, // 797 %integer X, Xtype, // 798 Format, // 799 Ext, // 800 %string(127) Id) {003} // 801 // 802 %constrecord(Diagfm)%name Diagfm Type == 0 const DIAGFM /*name*/*DIAGFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 803 %record(Diagfm)%name Diag List == Nil DIAGFM /*name*/*DIAGLIST; DIAGLIST = NIL; // 804 // 805 %constinteger Display Limit = 128+17 // 806 %ownshortarray Display Vector(128:Display Limit) = 0(*) static short DISPLAYVECTOR[18] = { [0 ... 17] = 0 }; // 807 // 808 %owninteger Cp = 0 static int CP = 0; // 809 %bytearray Code Buffer(0:255) unsigned char CODEBUFFER[256]; // 810 // 811 %recordformat Vvfm(%record(Vvfm)%name Link, %record(Varfm)%array V(0:63)) typedef struct VVFM VVFM; struct VVFM { VVFM /*name*/*LINK; VARFM V[64]; }; // 812 %constrecord(Vvfm)%name VvfmType == 0 const VVFM /*name*/*VVFMTYPE = { 0 } /* Initialise all fields of a record to 0. */; // 813 %record(Vvfm)%name Var List == NIL VVFM /*name*/*VARLIST; VARLIST = NIL; // 814 %recordformat Pvfm(%record(Vvfm)%name P) typedef struct PVFM PVFM; struct PVFM { VVFM /*name*/*P; }; // 815 %record(Pvfm)%array Pvar(0:Var Top) PVFM PVAR[32]; // 816 // 817 %record(Varfm)%map Var(%integer A) VARFM /*map*/*VAR( int A ) { // 818 %record(Vvfm)%name V VVFM /*name*/*V; // 819 %record(Pvfm)%name X PVFM /*name*/*X; // 820 X == Pvar(A>>6) X = &PVAR[(int)((((unsigned int)(A)) >> (6)))]; // 821 %if X_P == Nil %start if (((X->P) != (NIL))) goto L_0002; // 822 V == NEW(VvfmType) V = _imp_NEW(VVFMTYPE); // 823 V_Link == Var List; Var List == V V->LINK = VARLIST; VARLIST = V; // 824 X_P == V X->P = V; // 825 %finish L_0002:; // 826 %result == X_P_V(A&63) /* Remove %on %event handler here if present for this block */ return &X->P->V[((A) & (63))]; // 827 %end } // End of block VAR at level 2 // 828 // 829 %routine Flush Code void FLUSHCODE( void ) { // 830 %integer J int J; // 831 %return %if Cp = 0 if (((CP) != (0))) goto L_0003; /* Remove %on %event handler here if present for this block */ return; L_0003:; // 832 Printsymbol(Dir Dump) _imp_PRINTSYMBOL(31); // 833 Dump Encoded(Cp) DUMPENCODED(CP); // 834 Printsymbol(Code Buffer(J)) %for J = 1, 1, Cp {static int _initial, _increment, _final, _control; _initial = 1; _increment = 1; _final = CP; J = _control = _initial; if (((_final-_initial) % _increment) != 0) _imp_signal(5,1,0,"Illegal cycle J = 1, 1, CP"); J -= _increment; _control -= _increment; L_0004:; if (J == _final) goto L_0005; J += _increment; _control += _increment; if (J != _control) _imp_signal(4,2,0,"Corrupt control variable J"); /* FOR loop control variable corrupted */ } _imp_PRINTSYMBOL(CODEBUFFER[J]); goto L_0004; L_0005:; // 835 Cp = 0 CP = 0; // 836 %end /* Remove %on %event handler here if present for this block */ return; } // End of block FLUSHCODE at level 2 // 837 // 838 %routine Assemble(%record(Varfm)%name Avar, void ASSEMBLE( VARFM /*name*/*AVAR, int AMODE, int VARS, int LOCAL, int PARAMETERLIST, int /*name*/*GLOBALATTRIBUTES ) { // 839 %integer Amode, Vars, Local, Parameter List, // 840 %integername Global Attributes) // 841 {Amode = -16 - Initial call } // 842 { -2 - Alternate format start} // 843 { -1 - Recordformat } // 844 { 0 - Procedure } // 845 { >0 - Procedure spec } // 846 %routinespec Not in Yet auto void NOTINYET( void ); // 847 %routinespec Fail(%string(63) Why) auto void FAIL( _imp_string /*%string(63)*/ WHY ); // 848 %routinespec Warn(%integer Fault, %string(63) What) auto void WARN( int FAULT, _imp_string /*%string(63)*/ WHAT ); // 849 %routinespec Display(%record(Stackfm)%name V, %integer Bias) auto void DISPLAY( STACKFM /*name*/*V, int BIAS ); // 850 %routinespec Monitor(%record(Stackfm)%name V, %string(127) Text) auto void MONITOR( STACKFM /*name*/*V, _imp_string /*%string(127)*/ TEXT ); // 851 %predicatespec Iconst(%record(Stackfm)%name V) auto int /*Boolean*/ ICONST( STACKFM /*name*/*V ); // 852 %predicatespec Iconst Item(%record(Stackfm)%name V) auto int /*Boolean*/ ICONSTITEM( STACKFM /*name*/*V ); // 853 %predicatespec Const(%record(Stackfm)%name V) auto int /*Boolean*/ CONST( STACKFM /*name*/*V ); // 854 %predicatespec Same(%record(Stackfm)%name A, B) auto int /*Boolean*/ SAME( STACKFM /*name*/*A, STACKFM /*name*/*B ); // 855 %predicatespec InReg(%record(Stackfm)%name V) auto int /*Boolean*/ INREG( STACKFM /*name*/*V ); // 856 %predicatespec Floating(%record(Stackfm)%name V) auto int /*Boolean*/ FLOATING( STACKFM /*name*/*V ); // 857 %integerfnspec Power(%integer N) auto int POWER( int N ); // 858 %integerfnspec Item Size(%integer T) auto int ITEMSIZE( int T ); // 859 %record(Stackfm)%mapspec Register(%integer R) auto STACKFM /*map*/*REGISTER( int R ); // 860 %routinespec Claim(%integer Register) auto void CLAIM( int REGISTER ); // 861 %routinespec Release(%integer Register) auto void RELEASE( int REGISTER ); // 862 %routinespec Release and Drop(%record(Stackfm)%name V) auto void RELEASEANDDROP( STACKFM /*name*/*V ); // 863 %routinespec Zap Index and Record(%record(Stackfm)%name V) auto void ZAPINDEXANDRECORD( STACKFM /*name*/*V ); // 864 %routinespec Release and Drop Pair(%record(Stackfm)%name A, B) auto void RELEASEANDDROPPAIR( STACKFM /*name*/*A, STACKFM /*name*/*B ); // 865 %routinespec Hazard(%integer Register) auto void HAZARD( int REGISTER ); // 866 %routinespec Pessimise(%record(Stackfm)%name V) auto void PESSIMISE( STACKFM /*name*/*V ); // 867 %routinespec Forget(%integer Register) auto void FORGET( int REGISTER ); // 868 %routinespec Forget Destination(%record(Stackfm)%name V) auto void FORGETDESTINATION( STACKFM /*name*/*V ); // 869 %routinespec Forget Everything auto void FORGETEVERYTHING( void ); // 870 %routinespec Remember(%integer Register, %record(Stackfm)%name V) auto void REMEMBER( int REGISTER, STACKFM /*name*/*V ); // 871 %routinespec Remember Zero(%integer Register) auto void REMEMBERZERO( int REGISTER ); // 872 %routinespec Optimise(%record(Stackfm)%name V, %integer Mode) auto void OPTIMISE( STACKFM /*name*/*V, int MODE ); // 873 // 874 %routinespec Simplify(%record(Stackfm)%name V) auto void SIMPLIFY( STACKFM /*name*/*V ); // 875 %routinespec Amap(%record(Stackfm)%name V) auto void AMAP( STACKFM /*name*/*V ); // 876 %routinespec Vmap(%record(Stackfm)%name V, %integer Type) auto void VMAP( STACKFM /*name*/*V, int TYPE ); // 877 %routinespec Make AutoI(%record(Stackfm)%name V, %integer Type) auto void MAKEAUTOI( STACKFM /*name*/*V, int TYPE ); // 878 %routinespec Advance(%record(Stackfm)%name V, %integer Type, By) auto void ADVANCE( STACKFM /*name*/*V, int TYPE, int BY ); // 879 %routinespec Load(%record(Stackfm)%name V, %integer Register) auto void LOAD( STACKFM /*name*/*V, int REGISTER ); // 880 %routinespec Loadup(%record(Stackfm)%name V) auto void LOADUP( STACKFM /*name*/*V ); // 881 %routinespec Load Address(%record(Stackfm)%name V, %integer R) auto void LOADADDRESS( STACKFM /*name*/*V, int R ); // 882 %routinespec Loadup Address(%record(Stackfm)%name V) auto void LOADUPADDRESS( STACKFM /*name*/*V ); // 883 %routinespec Load Pair(%record(Stackfm)%name A, %integer Ar, auto void LOADPAIR( STACKFM /*name*/*A, int AR, STACKFM /*name*/*B, int BR ); // 884 %record(Stackfm)%name B, %integer Br) // 885 %routinespec Load Trio(%record(Stackfm)%name A, %integer Ar, auto void LOADTRIO( STACKFM /*name*/*A, int AR, STACKFM /*name*/*B, int BR, STACKFM /*name*/*C, int CR ); // 886 %record(Stackfm)%name B, %integer Br, // 887 %record(Stackfm)%name C, %integer Cr) // 888 %routinespec Pop Stack(%integer Bytes) auto void POPSTACK( int BYTES ); // 889 %routinespec Load Protected(%record(Stackfm)%name V) auto void LOADPROTECTED( STACKFM /*name*/*V ); // 890 %routinespec Move(%record(Stackfm)%name From, To) auto void MOVE( STACKFM /*name*/*FROM, STACKFM /*name*/*TO ); // 891 %routinespec Move Literal(%integer Lit, %record(Stackfm)%name V) auto void MOVELITERAL( int LIT, STACKFM /*name*/*V ); // 892 %routinespec Store(%record(Stackfm)%name From, To) auto void STORE( STACKFM /*name*/*FROM, STACKFM /*name*/*TO ); // 893 %routinespec Store Address(%record(Stackfm)%name From, To, auto void STOREADDRESS( STACKFM /*name*/*FROM, STACKFM /*name*/*TO, int /*name*/*EXTRA ); // 894 %integername Extra) // 895 %routinespec Operate(%integer Op, %record(Stackfm)%name L, R) auto void OPERATE( int OP, STACKFM /*name*/*L, STACKFM /*name*/*R ); // 896 %routinespec Compare(%record(Stackfm)%name L, R) auto void COMPARE( STACKFM /*name*/*L, STACKFM /*name*/*R ); // 897 %integerfnspec New Label auto int NEWLABEL( void ); // 898 %routinespec Jump To(%integer Internal Label, Cond Code) auto void JUMPTO( int INTERNALLABEL, int CONDCODE ); // 899 %routinespec Define Label(%integer Internal Label) auto void DEFINELABEL( int INTERNALLABEL ); // 900 %routinespec Test Zero(%record(Stackfm)%name V) auto void TESTZERO( STACKFM /*name*/*V ); // 901 %routinespec Test Range(%record(Stackfm)%name V, auto void TESTRANGE( STACKFM /*name*/*V, VARFM /*name*/*R ); // 902 %record(Varfm)%name R) // 903 %routinespec Clear Vars(%integer Limit) auto void CLEARVARS( int LIMIT ); // 904 %routinespec DIR String(%integer Op, %string(*)%name S) auto void DIRSTRING( int OP, _imp_string /*%string(255)*/ /*name*/*S ); // 905 %routinespec Float(%record(Stackfm)%name V, %integer R) auto void FLOAT( STACKFM /*name*/*V, int R ); // 906 %routinespec Dump External(%integer C, %record(Varfm)%name V) auto void DUMPEXTERNAL( int C, VARFM /*name*/*V ); // 907 %routinespec Do(%string(31) Ident, %integername Ep, %integer Result) auto void DO( _imp_string /*%string(31)*/ IDENT, int /*name*/*EP, int RESULT ); // 908 // 909 %integerfnspec GPR auto int GPR( void ); // 910 %integerfnspec FPR auto int FPR( void ); // 911 %integerfnspec Select Best(%record(Stackfm)%name From, To, %integer D) auto int SELECTBEST( STACKFM /*name*/*FROM, STACKFM /*name*/*TO, int D ); // 912 %record(Stackfm)%mapspec Descriptor auto STACKFM /*map*/*DESCRIPTOR( void ); // 913 %record(Stackfm)%mapspec Temporary auto STACKFM /*map*/*TEMPORARY( void ); // 914 %routinespec Drop(%record(Stackfm)%name V) auto void DROP( STACKFM /*name*/*V ); // 915 %record(Stackfm)%mapspec Local Integer(%integer Disp) auto STACKFM /*map*/*LOCALINTEGER( int DISP ); // 916 %record(Stackfm)%mapspec Literal(%integer N) auto STACKFM /*map*/*LITERAL( int N ); // 917 %record(Stackfm)%mapspec Copy(%record(Stackfm)%name V) auto STACKFM /*map*/*COPY( STACKFM /*name*/*V ); // 918 // 919 %integerfnspec Tag auto int TAG( void ); // 920 %integerfnspec Four Bytes auto int FOURBYTES( void ); // 921 // 922 %routinespec Prim(%integer N) auto void PRIM( int N ); // 923 %routinespec Dump Text(%integer Max) auto void DUMPTEXT( int MAX ); // 924 %routinespec Pass Parameters(%record(Stackfm)%name V, auto void PASSPARAMETERS( STACKFM /*name*/*V, int /*name*/*X, int BASEREG ); // 925 %integername X, %integer BaseReg) // 926 %routinespec Assign(%integer How) auto void ASSIGN( int HOW ); // 927 %routinespec String Assign(%record(Stackfm)%name From, To) auto void STRINGASSIGN( STACKFM /*name*/*FROM, STACKFM /*name*/*TO ); // 928 %routinespec Set Assign(%record(Stackfm)%name From, To) auto void SETASSIGN( STACKFM /*name*/*FROM, STACKFM /*name*/*TO ); // 929 %routinespec Evaluate String Expression(%record(Stackfm)%name V) auto void EVALUATESTRINGEXPRESSION( STACKFM /*name*/*V ); // 930 %routinespec Record Assign(%record(Stackfm)%name From, To) auto void RECORDASSIGN( STACKFM /*name*/*FROM, STACKFM /*name*/*TO ); // 931 %record(Stackfm)%mapspec Claim Work Area(%integer Size, Type) auto STACKFM /*map*/*CLAIMWORKAREA( int SIZE, int TYPE ); // 932 %routinespec Flush Diags auto void FLUSHDIAGS( void ); // 933 %routinespec Convert Format(%record(Stackfm)%name V, %integer Type) auto void CONVERTFORMAT( STACKFM /*name*/*V, int TYPE ); // 934 %routinespec To Short Real(%record(Stackfm)%name V) auto void TOSHORTREAL( STACKFM /*name*/*V ); // 935 %routinespec Store Real Constant(%record(Stackfm)%name W) auto void STOREREALCONSTANT( STACKFM /*name*/*W ); // 936 %routinespec Build Set(%record(Stackfm)%name S) auto void BUILDSET( STACKFM /*name*/*S ); // 937 %routinespec Drop Members(%record(Stackfm)%name S) auto void DROPMEMBERS( STACKFM /*name*/*S ); // 938 // 939 %owninteger Frame = 0, static int FRAME = 0; static int ROUND = 0; // 940 Round = 0 // 941 %integer Aframe = 0, {array extension to frame} int AFRAME; AFRAME = 0; int PARAMETERFRAME; PARAMETERFRAME = 0; int PARAMETERREGS; PARAMETERREGS = 0; int STRINGRESULT; STRINGRESULT = 0; // 942 Parameter Frame = 0, // 943 Parameter Regs = 0, // 944 String Result = 0 // 945 // 946 %integer Block Type = 0, int BLOCKTYPE; BLOCKTYPE = 0; int CODEBASE; CODEBASE = 0; int UNCONDJUMP; UNCONDJUMP = (-1); int D; int N; int PARAMETERMODE; int VARBASE; VARBASE = VARS; int FIRSTALT; FIRSTALT = (((int)(PARMS)) - (1)); int FRAMEBASE; int OLDFRAME; int ALTALIGN; int FRAMEEXTRA; int MAXFRAME; // 947 Code Base = 0, // 948 Uncond Jump = -1, // 949 D, // 950 N, // 951 Parameter Mode, // 952 VarBase = Vars, // 953 First Alt = Parms-1, // 954 Frame Base, // 955 Old Frame, // 956 Alt Align, {Worst alignment of record alternatives} // 957 Frame Extra, {putative padding at front of alternative} // 958 Max Frame {largest alternative so far} // 959 // 960 %integer Assign Lock = 1 {#0 to permit marking assigned permanently} int ASSIGNLOCK; ASSIGNLOCK = 1; // 961 // 962 %integer Attributes = 0, int ATTRIBUTES; ATTRIBUTES = 0; int AT; AT = 0; int ENTRYMASK; ENTRYMASK = 0; int MYMARK; int OPEN; OPEN = 2048; int EVENTLABEL; EVENTLABEL = 0; int EVENTBODY; EVENTBODY = 0; int EVENTBITS; EVENTBITS = 0; int WSPSAVE; WSPSAVE = 0; int DANGERMARKER; DANGERMARKER = 0; int LOCALDISPLAY; LOCALDISPLAY = 0; int JLAB; int ARRAYBASE; ARRAYBASE = 0; // 963 At = 0, // 964 Entry Mask = 0, // 965 MyMark, // 966 Open = Closed, {assume cannot return} // 967 Event Label = 0, // 968 Event Body = 0, // 969 Event Bits = 0, // 970 Wsp Save = 0, {frame address of where SP is saved} // 971 Danger Marker = 0, {=1 if the block is dangerous} // 972 Local Display = 0, {#0 if in a dangerous block} // 973 Jlab, // 974 Array Base = 0 {#0 if allocated} // 975 // 976 %integer Work Base = Last Work int WORKBASE; WORKBASE = LASTWORK; // 977 // 978 %integername Ca == Code Base {current Address} int /*name*/*CA; CA = &CODEBASE; // 979 // 980 %string(127) Proc Id = Internal Id {003} _imp_string /*%string(127)*/ PROCID; PROCID = INTERNALID; // 981 // 982 %record(Withfm)%name Withs == Nil WITHFM /*name*/*WITHS; WITHS = NIL; // 983 // 984 %conststring(255) Monitor Id = "3L___monitor" const _imp_string /*%string(255)*/ MONITORID = _imp_str_literal("3L___monitor"); // 985 %owninteger Monitor Ep = 0 static int MONITOREP = 0; // 986 // 987 %routine Decode(%integer Word, At) void DECODE( int WORD, int AT ) { // 988 %externalroutinespec D %alias "DECODE_ARM"(%integer W, A) extern void D( int W, int A ) __asm__("DECODE_ARM"); // 989 Select Output(Report) _imp_SELECTOUTPUT(0); // 990 D(Word, At) D(WORD, AT); // 991 Select Output(Directives Out) _imp_SELECTOUTPUT(2); // 992 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DECODE at level 3 // 993 // 994 %record(Stackfm)%map Display Info(%integer Base) STACKFM /*map*/*DISPLAYINFO( int BASE ) { // 995 %integer N int N; // 996 %record(Stackfm)%name T STACKFM /*name*/*T; // 997 %if Base < Danger Level %start {the safe case} if (((BASE) >= (DANGERLEVEL))) goto L_0007; // 998 Frame Use(Base) = 0 {show the level used} (FRAMEUSE-128)[BASE] = 0; // 999 N = Display Vector(Base) N = (DISPLAYVECTOR-128)[BASE]; // 1000 %if N = 0 %start if (((N) != (0))) goto L_0008; // 1001 Min SB = Min SB-4; N = Min SB MINSB = (((int)(MINSB)) - (4)); N = MINSB; // 1002 Display Vector(Base) = N (DISPLAYVECTOR-128)[BASE] = N; // 1003 %finish L_0008:; // 1004 T == Literal(N) T = LITERAL(N); // 1005 T_Form = Direct T->FORM = 1; // 1006 T_Base = Sb T->BASE = 10; // 1007 %else {the dangerous case - p-params} goto L_0009; L_0007:; // 1008 T == Local Integer(Local Display+4*(Base-Danger Level)) T = LOCALINTEGER(((LOCALDISPLAY) + ((int)(((4) * ((int)((((int)(BASE)) - (DANGERLEVEL))))))))); // 1009 %finish L_0009:; // 1010 Attributes = Attributes!Attr Needs Display ! Attr Needs Gp ATTRIBUTES = ((((ATTRIBUTES) | (1))) | (4)); // 1011 T_Flags = T_Flags!Known Ass T->FLAGS = ((T->FLAGS) | (128)); // 1012 %result == T /* Remove %on %event handler here if present for this block */ return T; // 1013 %end } // End of block DISPLAYINFO at level 3 // 1014 // 1015 %routine BD(%integer Base, Disp) void BD( int BASE, int DISP ) { // 1016 Write(Disp, 1) _imp_WRITE(DISP, 1); // 1017 Printsymbol('(') _imp_PRINTSYMBOL(40); // 1018 %if None <= Base <= AnyF %start if ((((0) > (BASE))) || (((BASE) > (26)))) goto L_000a; // 1019 Printstring(Regid(Base)) _imp_PRINTSTRING(REGID[BASE]); // 1020 %else goto L_000b; L_000a:; // 1021 %if Base >= Base Local %start if (((BASE) < (128))) goto L_000c; // 1022 %if Base = Local %start if (((BASE) != (LOCAL))) goto L_000d; // 1023 Printstring("Fp") _imp_PRINTSTRING(_imp_str_literal("Fp")); // 1024 %else goto L_000e; L_000d:; // 1025 Printsymbol('L') _imp_PRINTSYMBOL(76); // 1026 Base = Base-Base Local-1 BASE = (((int)((((int)(BASE)) - (128)))) - (1)); // 1027 Write(Base, 0) _imp_WRITE(BASE, 0); // 1028 %finish L_000e:; // 1029 %else goto L_000f; L_000c:; // 1030 Write(Base, 0) _imp_WRITE(BASE, 0); // 1031 %finish L_000f:; // 1032 %finish L_000b:; // 1033 Printsymbol(')') _imp_PRINTSYMBOL(41); // 1034 %end /* Remove %on %event handler here if present for this block */ return; } // End of block BD at level 3 // 1035 // 1036 %routine Show(%integer N, %string(15) Text) void SHOW( int N, _imp_string /*%string(15)*/ TEXT ) { // 1037 %if N # 0 %start if (((N) == (0))) goto L_0010; // 1038 Space; Printstring(Text) _imp_SPACE(); _imp_PRINTSTRING(TEXT); // 1039 Write(n, 1) _imp_WRITE(N, 1); // 1040 %finish L_0010:; // 1041 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SHOW at level 3 // 1042 // 1043 %routine Show Data(%record(Stackfm)%name V, %integer Left) void SHOWDATA( STACKFM /*name*/*V, int LEFT ) { // 1044 Spaces(Left); Printstring(Typeid(V_Type)) _imp_SPACES(LEFT); _imp_PRINTSTRING(TYPEID[V->TYPE]); // 1045 Space; Printstring(Formid(V_Form)) _imp_SPACE(); _imp_PRINTSTRING(FORMID[V->FORM]); // 1046 BD(V_Base, V_Disp) BD(V->BASE, V->DISP); // 1047 Show(V_Format, "Fm:") SHOW(V->FORMAT, _imp_str_literal("Fm:")); // 1048 Show(V_Area, "A:") SHOW(V->AREA, _imp_str_literal("A:")); // 1049 Show(V_Flags, "Fl:") SHOW(V->FLAGS, _imp_str_literal("Fl:")); // 1050 PrintSymbol('R') %if V_Flags&By Ref # 0 if (((((V->FLAGS) & (1))) == (0))) goto L_0011; _imp_PRINTSYMBOL(82); L_0011:; // 1051 PrintSymbol('A') %if V_Flags&Array # 0 if (((((V->FLAGS) & (2))) == (0))) goto L_0012; _imp_PRINTSYMBOL(65); L_0012:; // 1052 PrintSymbol('N') %if V_Flags&Arrayname # 0 if (((((V->FLAGS) & (64))) == (0))) goto L_0013; _imp_PRINTSYMBOL(78); L_0013:; // 1053 PrintSymbol('P') %if V_Flags&Parameter # 0 if (((((V->FLAGS) & (4))) == (0))) goto L_0014; _imp_PRINTSYMBOL(80); L_0014:; // 1054 PrintSymbol('D') %if V_Flags&Defered # 0 if (((((V->FLAGS) & (8))) == (0))) goto L_0015; _imp_PRINTSYMBOL(68); L_0015:; // 1055 PrintSymbol('W') %if V_Flags&Awanted # 0 if (((((V->FLAGS) & (131072))) == (0))) goto L_0016; _imp_PRINTSYMBOL(87); L_0016:; // 1056 PrintSymbol('S') %if V_Flags&Static # 0 if (((((V->FLAGS) & (32))) == (0))) goto L_0017; _imp_PRINTSYMBOL(83); L_0017:; // 1057 PrintSymbol('=') %if V_Flags&Known Ass # 0 if (((((V->FLAGS) & (128))) == (0))) goto L_0018; _imp_PRINTSYMBOL(61); L_0018:; // 1058 Printsymbol('H') %if V_Flags&Hazarded # 0 if (((((V->FLAGS) & (16))) == (0))) goto L_0019; _imp_PRINTSYMBOL(72); L_0019:; // 1059 Printsymbol('X') %if V_Flags&Xproc Spec # 0 if (((((V->FLAGS) & (1024))) == (0))) goto L_001a; _imp_PRINTSYMBOL(88); L_001a:; // 1060 Printsymbol('n') %if V_Flags&Nasty Proc # 0 if (((((V->FLAGS) & (65536))) == (0))) goto L_001b; _imp_PRINTSYMBOL(110); L_001b:; // 1061 Printsymbol('C') %if V_Flags&Checkable # 0 if (((((V->FLAGS) & (1048576))) == (0))) goto L_001c; _imp_PRINTSYMBOL(67); L_001c:; // 1062 PrintSymbol('#') %and Write(V_Varno, 0) %if V_Varno # 0 if (((V->VARNO) == (0))) goto L_001d; _imp_PRINTSYMBOL(35); _imp_WRITE(V->VARNO, 0); L_001d:; // 1063 %if V_Record ## Nil %start if (((V->RECORD) == (NIL))) goto L_001e; // 1064 Newline _imp_NEWLINE(); // 1065 Spaces(Left); Printstring(" _:") _imp_SPACES(LEFT); _imp_PRINTSTRING(_imp_str_literal(" _:")); // 1066 Display(V_Record, Left+4) DISPLAY(V->RECORD, (((int)(LEFT)) + (4))); // 1067 %finish L_001e:; // 1068 %if V_Index ## Nil %start if (((V->INDEX) == (NIL))) goto L_001f; // 1069 Newline _imp_NEWLINE(); // 1070 Write(V_Xsize, Left+2); Printstring("i:") _imp_WRITE(V->XSIZE, (((int)(LEFT)) + (2))); _imp_PRINTSTRING(_imp_str_literal("i:")); // 1071 Display(V_Index, Left+4) DISPLAY(V->INDEX, (((int)(LEFT)) + (4))); // 1072 %finish L_001f:; // 1073 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SHOWDATA at level 3 // 1074 // 1075 %routine Display(%record(Stackfm)%name V, %integer Bias) void DISPLAY( STACKFM /*name*/*V, int BIAS ) { // 1076 %if V == Nil %start if (((V) != (NIL))) goto L_0020; // 1077 Printstring(" Nil"); Newline _imp_PRINTSTRING(_imp_str_literal(" Nil")); _imp_NEWLINE(); // 1078 %return /* Remove %on %event handler here if present for this block */ return; // 1079 %finish L_0020:; // 1080 Show Data(V, Bias) SHOWDATA(V, BIAS); // 1081 newline _imp_NEWLINE(); // 1082 %if V_Oper # 0 %start if (((V->OPER) == (0))) goto L_0021; // 1083 Spaces(Bias-4); Printstring(Operid(V_Oper)) _imp_SPACES((((int)(BIAS)) - (4))); _imp_PRINTSTRING((OPERID-1)[V->OPER]); // 1084 Display(V_Link, Bias+4) DISPLAY(V->LINK, (((int)(BIAS)) + (4))); // 1085 %finish L_0021:; // 1086 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DISPLAY at level 3 // 1087 // 1088 %routine Show Reg(%integer R) void SHOWREG( int R ) { // 1089 %integer A int A; // 1090 A = Activity(R) A = ACTIVITY[R]; // 1091 Printstring(Regid(R)) _imp_PRINTSTRING(REGID[R]); // 1092 %if A = 0 %start if (((A) != (0))) goto L_0022; // 1093 Printstring(" unused") _imp_PRINTSTRING(_imp_str_literal(" unused")); // 1094 %else %if A < 0 goto L_0023; L_0022:; if (((A) >= (0))) goto L_0024; // 1095 %if A = -1 %start if (((A) != ((-1)))) goto L_0025; // 1096 Printstring(" locked") _imp_PRINTSTRING(_imp_str_literal(" locked")); // 1097 %else goto L_0026; L_0025:; // 1098 Printstring(" ="); Printstring(Regid(-A)); Spaces(2) _imp_PRINTSTRING(_imp_str_literal(" =")); _imp_PRINTSTRING(REGID[(-(A))]); _imp_SPACES(2); // 1099 %finish L_0026:; // 1100 %else goto L_0023; L_0024:; // 1101 Printstring(" used*"); Write(A, -1) _imp_PRINTSTRING(_imp_str_literal(" used*")); _imp_WRITE(A, (-1)); // 1102 %finish L_0023:; // 1103 Printstring(" u:"); Print Hex(Used(R), 5) _imp_PRINTSTRING(_imp_str_literal(" u:")); PRINTHEX(USED[R], 5); // 1104 Printstring(" k:"); Write(Ktimes(R), 0) _imp_PRINTSTRING(_imp_str_literal(" k:")); _imp_WRITE(KTIMES[R], 0); // 1105 Newline _imp_NEWLINE(); // 1106 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SHOWREG at level 3 // 1107 // 1108 %routine Monitor N(%integer N, %string(255) Text) void MONITORN( int N, _imp_string /*%string(255)*/ TEXT ) { // 1109 Select Output(Report) _imp_SELECTOUTPUT(0); // 1110 Printstring(Text) _imp_PRINTSTRING(TEXT); // 1111 Write(N, 8) _imp_WRITE(N, 8); // 1112 Newline _imp_NEWLINE(); // 1113 Select Output(Directives Out) _imp_SELECTOUTPUT(2); // 1114 %end /* Remove %on %event handler here if present for this block */ return; } // End of block MONITORN at level 3 // 1115 // 1116 %routine Monitor Register(%integer R, %string(127) Text) void MONITORREGISTER( int R, _imp_string /*%string(127)*/ TEXT ) { // 1117 Select Output(Report) _imp_SELECTOUTPUT(0); // 1118 Printstring(Text); Spaces(9-length(Text)); Space _imp_PRINTSTRING(TEXT); _imp_SPACES(((9) - (*(int *)(_imp_LENGTH(&TEXT))))); _imp_SPACE(); // 1119 Show Reg(R) SHOWREG(R); // 1120 Select Output(Directives Out) _imp_SELECTOUTPUT(2); // 1121 %end /* Remove %on %event handler here if present for this block */ return; } // End of block MONITORREGISTER at level 3 // 1122 // 1123 %routine Monitor(%record(Stackfm)%name V, %string(127) Text) void MONITOR( STACKFM /*name*/*V, _imp_string /*%string(127)*/ TEXT ) { // 1124 Select Output(Report) _imp_SELECTOUTPUT(0); // 1125 Printstring(Text); Spaces(9-length(Text)); Space _imp_PRINTSTRING(TEXT); _imp_SPACES(((9) - (*(int *)(_imp_LENGTH(&TEXT))))); _imp_SPACE(); // 1126 Display(V, 6) DISPLAY(V, 6); // 1127 Select Output(Directives Out) _imp_SELECTOUTPUT(2); // 1128 %end /* Remove %on %event handler here if present for this block */ return; } // End of block MONITOR at level 3 // 1129 // 1130 %routine Mon Regid(%integer R, %string(127) Text) void MONREGID( int R, _imp_string /*%string(127)*/ TEXT ) { // 1131 Select Output(Report) _imp_SELECTOUTPUT(0); // 1132 Printstring(Regid(R)); Space _imp_PRINTSTRING(REGID[R]); _imp_SPACE(); // 1133 Printstring(Text) _imp_PRINTSTRING(TEXT); // 1134 Newline _imp_NEWLINE(); // 1135 Select Output(Directives Out) _imp_SELECTOUTPUT(2); // 1136 %end /* Remove %on %event handler here if present for this block */ return; } // End of block MONREGID at level 3 // 1137 // 1138 %routine Display Knowledge void DISPLAYKNOWLEDGE( void ) { // 1139 %record(Knowfm)%name K KNOWFM /*name*/*K; // 1140 Select Output(Report) _imp_SELECTOUTPUT(0); // 1141 K == Knowing K = KNOWING; // 1142 %while K ## Nil %cycle L_0027:; if (((K) == (NIL))) goto L_0028; // 1143 Printstring(Regid(K_Reg)); Printstring(" = ") _imp_PRINTSTRING(REGID[K->REG]); _imp_PRINTSTRING(_imp_str_literal(" = ")); // 1144 Printstring(Typeid(K_Ftype>>4)); Space _imp_PRINTSTRING(TYPEID[(unsigned char)((((unsigned char)(K->FTYPE)) >> (4)))]); _imp_SPACE(); // 1145 Printstring(Formid(K_Ftype&15)); Space _imp_PRINTSTRING(FORMID[((K->FTYPE) & (15))]); _imp_SPACE(); // 1146 BD(K_Base, K_Disp) BD(K->BASE, K->DISP); // 1147 %if K_Extra # 0 %start if (((K->EXTRA) == (0))) goto L_002a; // 1148 Printstring(" X:"); Write(K_Extra, 1) _imp_PRINTSTRING(_imp_str_literal(" X:")); _imp_WRITE(K->EXTRA, 1); // 1149 %finish L_002a:; // 1150 %if K_Area # 0 %start if (((K->AREA) == (0))) goto L_002b; // 1151 Printstring(" A:"); Write(K_Area, 1) _imp_PRINTSTRING(_imp_str_literal(" A:")); _imp_WRITE(K->AREA, 1); // 1152 %finish L_002b:; // 1153 %if K_Oper # 0 %start if (((K->OPER) == (0))) goto L_002c; // 1154 Space; Printstring(OperId(K_Oper)) _imp_SPACE(); _imp_PRINTSTRING((OPERID-1)[K->OPER]); // 1155 Write(K_Opnd, 1) _imp_WRITE(K->OPND, 1); // 1156 %finish L_002c:; // 1157 Newline _imp_NEWLINE(); // 1158 K == K_Link K = K->LINK; // 1159 %repeat goto L_0027; L_0028:; // 1160 Select Output(Directives Out) _imp_SELECTOUTPUT(2); // 1161 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DISPLAYKNOWLEDGE at level 3 // 1162 // 1163 %routine Show Where void SHOWWHERE( void ) { // 1164 Select Output(Report) _imp_SELECTOUTPUT(0); // 1165 Printstring(" at line "); Write(Current Line, 0) _imp_PRINTSTRING(_imp_str_literal(" at line ")); _imp_WRITE(CURRENTLINE, 0); // 1166 Printstring(" in file ".Include File) %if Include File # "" if ((_imp_strcmp(INCLUDEFILE, _imp_str_literal("")) == 0)) goto L_002d; _imp_PRINTSTRING(_imp_join((_imp_string)_imp_str_literal(" in file "),(_imp_string)INCLUDEFILE)); L_002d:; // 1167 newline _imp_NEWLINE(); // 1168 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SHOWWHERE at level 3 // 1169 // 1170 %routine Fail(%string(63) Why) void FAIL( _imp_string /*%string(63)*/ WHY ) { // 1171 // 1172 %routine Pcode(%integer S) void PCODE( int S ) { // 1173 %if S >= 128 %start if (((S) < (128))) goto L_002e; // 1174 Printstring("128+") _imp_PRINTSTRING(_imp_str_literal("128+")); // 1175 S = S-128 S = (((int)(S)) - (128)); // 1176 %finish L_002e:; // 1177 %if ' ' <= S <= 126 %start if ((((32) > (S))) || (((S) > (126)))) goto L_002f; // 1178 Printsymbol(''''); Printsymbol(S); Printsymbol('''') _imp_PRINTSYMBOL(39); _imp_PRINTSYMBOL(S); _imp_PRINTSYMBOL(39); // 1179 %finish L_002f:; // 1180 write(S, 3) _imp_WRITE(S, 3); // 1181 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PCODE at level 4 // 1182 // 1183 %routine Err(%integer Stream) void ERR( int STREAM ) { // 1184 %integer R int R; // 1185 %record(Stackfm)%name U, S STACKFM /*name*/*U; STACKFM /*name*/*S; // 1186 Select Output(Stream) _imp_SELECTOUTPUT(STREAM); // 1187 Newline _imp_NEWLINE(); // 1188 Printstring("====> Pass 2 fails -- "); Printstring(Why) _imp_PRINTSTRING(_imp_str_literal("====> Pass 2 fails -- ")); _imp_PRINTSTRING(WHY); // 1189 Show Where SHOWWHERE(); // 1190 Printstring("Code "); Pcode(Code) _imp_PRINTSTRING(_imp_str_literal("Code ")); PCODE(CODE); // 1191 Printstring(" Pending "); Pcode(Pending) _imp_PRINTSTRING(_imp_str_literal(" Pending ")); PCODE(PENDING); // 1192 Newline _imp_NEWLINE(); // 1193 %for R = R0, 1, R15 %cycle R = 0; if ((((16)-(1)) % (1)) != 0) _imp_signal(5,1,0,"Illegal cycle R = 1, 1, 16"); L_0030:; if (R == 16) goto L_0031; R += 1; // 1194 Show Reg(R) %unless Activity(R) <= 0 if (((ACTIVITY[R]) <= (0))) goto L_0033; SHOWREG(R); L_0033:; // 1195 %repeat goto L_0030; L_0031:; // 1196 S == Stack S = STACK; // 1197 %while S ## Nil %cycle L_0034:; if (((S) == (NIL))) goto L_0035; // 1198 Printstring("S:"); Display(S, 5) _imp_PRINTSTRING(_imp_str_literal("S:")); DISPLAY(S, 5); // 1199 S == S_Stack S = S->STACK; // 1200 %repeat goto L_0034; L_0035:; // 1201 U == Using U = USING; // 1202 %while U ## Nil %cycle L_0037:; if (((U) == (NIL))) goto L_0038; // 1203 Printstring("U:"); Display(U, 5) _imp_PRINTSTRING(_imp_str_literal("U:")); DISPLAY(U, 5); // 1204 U == U_Using U = U->USING; // 1205 %repeat goto L_0037; L_0038:; // 1206 Newline _imp_NEWLINE(); // 1207 %monitor _imp_monitor(0, (_imp_current_line != 0 ? _imp_current_line : __LINE__), (_imp_current_file != 0 ? _imp_current_file : __FILE__), __PRETTY_FUNCTION__); // 1208 %end /* Remove %on %event handler here if present for this block */ return; } // End of block ERR at level 4 // 1209 Err(Report) {terminal} ERR(0); // 1210 Err(Listing) {listing} ERR(7); // 1211 %stop exit(0); // 1212 %end return; } // End of block FAIL at level 3 // 1213 // 1214 %routine Warn(%integer Fault, %string(63) What) void WARN( int FAULT, _imp_string /*%string(63)*/ WHAT ) { // 1215 Select Output(Report) _imp_SELECTOUTPUT(0); // 1216 Interface_Faults = Interface_Faults+Fault INTERFACE->FAULTS = (((int)(INTERFACE->FAULTS)) + (FAULT)); // 1217 %if Fault = 0 %then Printstring("Warning: ") %c if (((FAULT) != (0))) goto L_003a; _imp_PRINTSTRING(_imp_str_literal("Warning: ")); goto L_003b; L_003a:; _imp_PRINTSTRING(_imp_str_literal("*Error: ")); L_003b:; // 1218 %else Printstring("*Error: ") // 1219 Printstring(What) _imp_PRINTSTRING(WHAT); // 1220 Show Where SHOWWHERE(); // 1221 Select Output(Directives Out) _imp_SELECTOUTPUT(2); // 1222 %end /* Remove %on %event handler here if present for this block */ return; } // End of block WARN at level 3 // 1223 // 1224 %routine Not in Yet void NOTINYET( void ) { // 1225 Fail("***Not implemented yet***") FAIL(_imp_str_literal("***Not implemented yet***")); // 1226 %end /* Remove %on %event handler here if present for this block */ return; } // End of block NOTINYET at level 3 // 1227 // 1228 %routine Dir1(%integer Code) void DIR1( int CODE ) { // 1229 Flush Code FLUSHCODE(); // 1230 Printsymbol(Code) _imp_PRINTSYMBOL(CODE); // 1231 Pending Auto = 0 PENDINGAUTO = 0; // 1232 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DIR1 at level 3 // 1233 // 1234 %routine Dir2(%integer Code, Arg1) void DIR2( int CODE, int ARG1 ) { // 1235 Flush Code FLUSHCODE(); // 1236 Printsymbol(Code) _imp_PRINTSYMBOL(CODE); // 1237 Dump Encoded(Arg1) DUMPENCODED(ARG1); // 1238 Pending Auto = 0 %unless Code = Dir Line if (((CODE) == (3))) goto L_003c; PENDINGAUTO = 0; L_003c:; // 1239 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DIR2 at level 3 // 1240 // 1241 %routine Dir3(%integer Code, Arg1, Arg2) void DIR3( int CODE, int ARG1, int ARG2 ) { // 1242 Flush Code FLUSHCODE(); // 1243 Printsymbol(Code) _imp_PRINTSYMBOL(CODE); // 1244 Dump Encoded(Arg1) DUMPENCODED(ARG1); // 1245 Dump Encoded(Arg2) DUMPENCODED(ARG2); // 1246 Pending Auto = 0 PENDINGAUTO = 0; // 1247 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DIR3 at level 3 // 1248 // 1249 %routine Dir4(%integer Code, Arg1, Arg2, Arg3) void DIR4( int CODE, int ARG1, int ARG2, int ARG3 ) { // 1250 Flush Code FLUSHCODE(); // 1251 Printsymbol(Code) _imp_PRINTSYMBOL(CODE); // 1252 Dump Encoded(Arg1) DUMPENCODED(ARG1); // 1253 Dump Encoded(Arg2) DUMPENCODED(ARG2); // 1254 Dump Encoded(Arg3) DUMPENCODED(ARG3); // 1255 Pending Auto = 0 PENDINGAUTO = 0; // 1256 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DIR4 at level 3 // 1257 // 1258 %record(Workfm)%map Work Area(%integer N) WORKFM /*map*/*WORKAREA( int N ) { // 1259 %record(WorkVfm)%name W WORKVFM /*name*/*W; // 1260 %integer E, S, X int E; int S; int X; // 1261 %on * %start if (!_imp_on_event(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)) goto L_003d; /* TO DO: Remove %on %event handler just before L_003d: if present for this block */ // 1262 E = Event_Event; S = Event_Sub; X = 0; ! Event_Extra not supported in bootstrapping compiler E = _imp_EVENT().EVENT; S = _imp_EVENT().SUB; X = 0; // 1263 Fail("too many work areas:".itos(E, 0)) FAIL(_imp_join((_imp_string)_imp_str_literal("too many work areas:"),(_imp_string)_imp_ITOS(E, 0))); // 1264 %finish L_003d:; // 1265 Monitor N(N, "work area") %if Diag&MonOperand # 0 if (((((DIAG) & (8))) == (0))) goto L_003e; MONITORN(N, _imp_str_literal("work area")); L_003e:; // 1266 W == Work List W = &WORKLIST; // 1267 %while N > 30 %cycle L_003f:; if (((N) <= (30))) goto L_0040; // 1268 N = N-30 N = (((int)(N)) - (30)); // 1269 %if W_Link == NIL %start if (((W->LINK) != (NIL))) goto L_0042; // 1270 W_Link == NEW(WorkVfmType) W->LINK = _imp_NEW(WORKVFMTYPE); // 1271 W_Link = 0 *W->LINK = (WORKVFM){ 0 } /* Assign 0's to all fields of record */; // 1272 %finish L_0042:; // 1273 W == W_Link W = W->LINK; // 1274 %repeat goto L_003f; L_0040:; // 1275 %result == W_W(N) /* Remove %on %event handler here if present for this block */ return &W->W[N]; // 1276 %end } // End of block WORKAREA at level 3 // 1277 // 1278 %record(Labelfm)%map Ilabel(%integer N) LABELFM /*map*/*ILABEL( int N ) { // 1279 %integer X, J int X; int J; // 1280 %record(Ilabelfm)%name I ILABELFM /*name*/*I; // 1281 %record(Labelfm)%name L LABELFM /*name*/*L; // 1282 Fail("internal label/1") %if N > Max Label if (((N) <= (8191))) goto L_0043; FAIL(_imp_str_literal("internal label/1")); L_0043:; // 1283 X = N>>8 X = (int)((((unsigned int)(N)) >> (8))); // 1284 !0.9! I == Ilabels(X) // 1285 {0.9} I == Ilabels(X)_Label I = ILABELS[X].LABEL; // 1286 %if I == NIL %start if (((I) != (NIL))) goto L_0044; // 1287 I == New(Ilabelfm Type) I = _imp_NEW(ILABELFMTYPE); // 1288 !0.9! Ilabels(X) == I // 1289 {0.9} Ilabels(X)_Label == I ILABELS[X].LABEL = I; // 1290 I_Link == Ilabel List; Ilabel List == I I->LINK = ILABELLIST; ILABELLIST = I; // 1291 %for J = 0, 1, 255 %cycle J = (-1); if ((((255)-(0)) % (1)) != 0) _imp_signal(5,1,0,"Illegal cycle J = 0, 1, 255"); L_0045:; if (J == 255) goto L_0046; J += 1; // 1292 L == I_Lab(J) L = &I->LAB[J]; // 1293 L_Lab = Defined L->LAB = (-2147483648); // 1294 L_Env == NIL L->ENV = NIL; // 1295 %repeat goto L_0045; L_0046:; // 1296 %finish L_0044:; // 1297 %result == I_Lab(N&255) /* Remove %on %event handler here if present for this block */ return &I->LAB[((N) & (255))]; // 1298 %end } // End of block ILABEL at level 3 // 1299 // 1300 %routine Select Area(%integer Area Id, %integername Base) void SELECTAREA( int AREAID, int /*name*/*BASE ) { // 1301 Dir3(Dir Area, Area Id>>8, Base) DIR3(27, (int)((((unsigned int)(AREAID)) >> (8))), *BASE); // 1302 Current Area = Area Id CURRENTAREA = AREAID; // 1303 Ca == Base CA = BASE; // 1304 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SELECTAREA at level 3 // 1305 // 1306 %routine Select Code Area void SELECTCODEAREA( void ) { // 1307 Select Area(Code Area, Code Base) SELECTAREA(0, &CODEBASE); // 1308 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SELECTCODEAREA at level 3 // 1309 // 1310 %routine Select Constant Area void SELECTCONSTANTAREA( void ) { // 1311 Select Area(Constant Area, Constant Base) SELECTAREA(512, &CONSTANTBASE); // 1312 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SELECTCONSTANTAREA at level 3 // 1313 // 1314 %routine Select Own Area void SELECTOWNAREA( void ) { // 1315 Select Area(Own Area, Own Base) SELECTAREA(256, &OWNBASE); // 1316 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SELECTOWNAREA at level 3 // 1317 // 1318 %routine Select Own Array Area void SELECTOWNARRAYAREA( void ) { // 1319 Select Area(Own Array Area, Own Array Base) SELECTAREA(768, &OWNARRAYBASE); // 1320 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SELECTOWNARRAYAREA at level 3 // 1321 // 1322 %include "plant.inc" // 1 %routine Dump Byte(%integer B) void DUMPBYTE( int B ) { // 2 Printsymbol(Dir Dump); Printsymbol(1) _imp_PRINTSYMBOL(31); _imp_PRINTSYMBOL(1); // 3 Printsymbol(B&255) _imp_PRINTSYMBOL(((B) & (255))); // 4 Ca = Ca+1 *CA = ((*(int *)(CA)) + (1)); // 5 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DUMPBYTE at level 3 // 6 // 7 %routine Dump Half(%integer H) void DUMPHALF( int H ) { // 8 Printsymbol(Dir Dump); Printsymbol(2) _imp_PRINTSYMBOL(31); _imp_PRINTSYMBOL(2); // 9 Printsymbol(H&255) _imp_PRINTSYMBOL(((H) & (255))); // 10 Printsymbol(H>>8&255) _imp_PRINTSYMBOL((((int)((((unsigned int)(H)) >> (8)))) & (255))); // 11 Ca = Ca+2 *CA = ((*(int *)(CA)) + (2)); // 12 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DUMPHALF at level 3 // 13 // 14 %routine Dump Word(%integer N) void DUMPWORD( int N ) { // 15 Printsymbol(Dir Dump); Printsymbol(4) _imp_PRINTSYMBOL(31); _imp_PRINTSYMBOL(4); // 16 Printsymbol(N&255) _imp_PRINTSYMBOL(((N) & (255))); // 17 Printsymbol(N>>8&255) _imp_PRINTSYMBOL((((int)((((unsigned int)(N)) >> (8)))) & (255))); // 18 Printsymbol(N>>16&255) _imp_PRINTSYMBOL((((int)((((unsigned int)(N)) >> (16)))) & (255))); // 19 Printsymbol(N>>24) _imp_PRINTSYMBOL((int)((((unsigned int)(N)) >> (24)))); // 20 Decode(Ca, N) %if Diag & Mon Code # 0 %and Current Area = Code Area if (((((DIAG) & (1))) == (0))) goto L_0048; if (((CURRENTAREA) != (0))) goto L_0048; DECODE(*CA, N); L_0048:; // 21 Ca = Ca+4 *CA = ((*(int *)(CA)) + (4)); // 22 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DUMPWORD at level 3 // 23 // 24 %integerfn Actual Register(%integer Base) int ACTUALREGISTER( int BASE ) { // 25 %record(Stackfm)%name T STACKFM /*name*/*T; // 26 %if Base >= 128 %start {base reigster not actual register} if (((BASE) < (128))) goto L_0049; // 27 %if Base = Local %start if (((BASE) != (LOCAL))) goto L_004a; // 28 Base = Fp BASE = 11; // 29 %else %if Base > 128 {???} goto L_004b; L_004a:; if (((BASE) <= (128))) goto L_004c; // 30 T == Display Info(Base) T = DISPLAYINFO(BASE); // 31 Loadup(T) LOADUP(T); // 32 Base = T_Base BASE = T->BASE; // 33 Release and Drop(T) {it will be used immediately ***?***} RELEASEANDDROP(T); // 34 %finish L_004c:; L_004b:; // 35 %finish L_0049:; // 36 %result = Actual(Base) /* Remove %on %event handler here if present for this block */ return ACTUAL[BASE]; // 37 %end } // End of block ACTUALREGISTER at level 3 // 38 // 39 %integerfn Just(%integer R) int JUST( int R ) { // 40 %result = Actual Register(R) /* Remove %on %event handler here if present for this block */ return ACTUALREGISTER(R); // 41 %end } // End of block JUST at level 3 // 42 // 43 %integerfn Nothing int NOTHING( void ) { // 44 %result = 16_0200 0000 /* Remove %on %event handler here if present for this block */ return 33554432; // 45 %end } // End of block NOTHING at level 3 // 46 // 47 %integerfn Immediate(%integer N) int IMMEDIATE( int N ) { // 48 %integer Rot = 16 int ROT; ROT = 16; // 49 %if N # 0 %start if (((N) == (0))) goto L_004d; // 50 Rot = Rot-1 %and N = N>>2 %while N&3 = 0 L_004e:; if (((((N) & (3))) != (0))) goto L_004f; ROT = (((int)(ROT)) - (1)); N = (int)((((unsigned int)(N)) >> (2))); goto L_004e; L_004f:; // 51 %result = -1 %if N>>8 # 0 if ((((int)((((unsigned int)(N)) >> (8)))) == (0))) goto L_0051; /* Remove %on %event handler here if present for this block */ return (-1); L_0051:; // 52 %finish L_004d:; // 53 %result = (Rot&15)<<8 ! N ! 16_0200 0000 /* Remove %on %event handler here if present for this block */ return ((((((((ROT) & (15))) << (8))) | (N))) | (33554432)); // 54 %end } // End of block IMMEDIATE at level 3 // 55 // 56 %integerfn Ishift(%integer Rm, By, How) int ISHIFT( int RM, int BY, int HOW ) { // 57 Fail("Bad immediate shift") %if How&2_1 000 0000 # 0 if (((((HOW) & (128))) == (0))) goto L_0052; FAIL(_imp_str_literal("Bad immediate shift")); L_0052:; // 58 %result = Actual Register(Rm) ! (By&2_11111)<<(3+4) ! How /* Remove %on %event handler here if present for this block */ return ((((ACTUALREGISTER(RM)) | (((((BY) & (31))) << (7))))) | (HOW)); // 59 %end } // End of block ISHIFT at level 3 // 60 // 61 %integerfn Rshift(%integer Rm, Rs, How) int RSHIFT( int RM, int RS, int HOW ) { // 62 Fail("Bad register shift") %if How&2_1 000 0000 = 0 if (((((HOW) & (128))) != (0))) goto L_0053; FAIL(_imp_str_literal("Bad register shift")); L_0053:; // 63 %result = Actual Register(Rm) ! Actual Register(Rs)<<(4+4) ! How&2_0 111 0000 /* Remove %on %event handler here if present for this block */ return ((((ACTUALREGISTER(RM)) | (((ACTUALREGISTER(RS)) << (8))))) | (((HOW) & (112)))); // 64 %end } // End of block RSHIFT at level 3 // 65 // 66 %integerfn Rot(%integer N, By) int ROT( int N, int BY ) { // 67 %result = (N&255 ! By<<8) ! 16_0200 0000 /* Remove %on %event handler here if present for this block */ return ((((((N) & (255))) | (((BY) << (8))))) | (33554432)); // 68 %end } // End of block ROT at level 3 // 69 // 70 %owninteger Pending Pop = 0 static int PENDINGPOP = 0; // 71 // 72 %routine Plant1(%integer Fn, Rn, Rd, X) void PLANT1( int FN, int RN, int RD, int X ) { // 73 Dump Word((Fn!!Invert Cond) ! Actual Register(Rn)<<16 %c DUMPWORD(((((((((FN) ^ ((-536870912)))) | (((ACTUALREGISTER(RN)) << (16))))) | (((ACTUALREGISTER(RD)) << (12))))) | (X))); // 74 ! Actual Register(Rd)<<12 ! X) // 75 Forget(Rd) %unless (Fn>>23)&3 = 2_10 if ((((((int)((((unsigned int)(FN)) >> (23)))) & (3))) == (2))) goto L_0054; FORGET(RD); L_0054:; // 76 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT1 at level 3 // 77 // 78 %routine Plant2(%integer Fn, Rd, %record(Stackfm)%name V) void PLANT2( int FN, int RD, STACKFM /*name*/*V ) { // 79 %integer N, Shift, Sign, D, P, Base, Vbase, Extra = 0 int N; int SHIFT; int SIGN; int D; int P; int BASE; int VBASE; int EXTRA; EXTRA = 0; // 80 %record(Stackfm)%name W STACKFM /*name*/*W; // 81 Fn = Fn ! Byte Op %if V_Type = Bytes if (((V->TYPE) != (4))) goto L_0055; FN = ((FN) | (4194304)); L_0055:; // 82 Simplify(V) SIMPLIFY(V); // 83 D = V_Disp D = V->DISP; // 84 %if V_Form = AutoI %start if (((V->FORM) != (2))) goto L_0056; // 85 D = Type Size(V_Type) D = TYPESIZE[V->TYPE]; // 86 Fn = Fn ! Post Indexed FN = ((FN) | (16777216)); // 87 %else %if V_Form = AutoD goto L_0057; L_0056:; if (((V->FORM) != (3))) goto L_0058; // 88 D = -Type Size(V_Type) D = (-(TYPESIZE[V->TYPE])); // 89 Fn = Fn ! Write Back FN = ((FN) | (2097152)); // 90 %else %if V_Form # Direct goto L_0057; L_0058:; if (((V->FORM) == (1))) goto L_0059; // 91 Fail("illegal load/store") FAIL(_imp_str_literal("illegal load/store")); // 92 %finish L_0059:; L_0057:; // 93 // 94 %if V_Index == NIL %start if (((V->INDEX) != (NIL))) goto L_005a; // 95 Fail("Bad displacement") %unless -16_0FFF <= D <= 16_0FFF if (((((-4095)) > (D))) || (((D) <= (4095)))) goto L_005b; L_0050:; FAIL(_imp_str_literal("Bad displacement")); L_005b:; // 96 %if D >= 0 %then Fn = Fn ! 16_0080 0000 %c if (((D) < (0))) goto L_005c; FN = ((FN) | (8388608)); goto L_005d; L_005c:; D = (-(D)); L_005d:; // 97 %else D = -D // 98 Fn = Fn ! D FN = ((FN) | (D)); // 99 %if D = 0 %start if (((D) != (0))) goto L_005e; // 100 Pending Auto N = 0 PENDINGAUTON = 0; // 101 Pending Auto = V_Base PENDINGAUTO = V->BASE; // 102 Pending Auto Ca = Ca PENDINGAUTOCA = *CA; // 103 %finish L_005e:; // 104 %else {V_Index ## NIL} goto L_005f; L_005a:; // 105 Fail("Bad index displacement") %unless D = 0 if (((D) == (0))) goto L_0060; FAIL(_imp_str_literal("Bad index displacement")); L_0060:; // 106 N = V_Xsize; Fail("Zero Xsize") %if N = 0 N = V->XSIZE; if (((N) != (0))) goto L_0061; FAIL(_imp_str_literal("Zero Xsize")); L_0061:; // 107 P = Power(N) P = POWER(N); // 108 %if P >= 0 %start if (((P) < (0))) goto L_0062; // 109 Loadup(V_Index) LOADUP(V->INDEX); // 110 %else goto L_0063; L_0062:; // 111 P = 0 P = 0; // 112 Sign = N&16_80000000 SIGN = ((N) & ((-2147483648))); // 113 P = P+1 %and N = (N>>1)!Sign %while N&1 = 0 L_0064:; if (((((N) & (1))) != (0))) goto L_0065; P = (((int)(P)) + (1)); N = (((int)((((unsigned int)(N)) >> (1)))) | (SIGN)); goto L_0064; L_0065:; // 114 Operate(MULx, V_Index, Literal(N)); V_Xsize = 1 OPERATE(6, V->INDEX, LITERAL(N)); V->XSIZE = 1; // 115 Loadup(V_Index) LOADUP(V->INDEX); // 116 %finish L_0063:; // 117 Fn = Fn ! 16_0080 0000 ! Reg Index ! Ishift(V_Index_Base, P, Logical Left) FN = ((((((FN) | (8388608))) | (33554432))) | (ISHIFT(V->INDEX->BASE, P, 0))); // 118 %finish L_005f:; // 119 %if V_Base = 0 %start {absolute!!} if (((V->BASE) != (0))) goto L_0067; // 120 %if V_Record == NIL %start if (((V->RECORD) != (NIL))) goto L_0068; // 121 %if V_Area < 0 %start if (((V->AREA) >= (0))) goto L_0069; // 122 Loadup(V) LOADUP(V); // 123 Fn = Fn ! Actual Register(V_Base)<<16 FN = ((FN) | (((ACTUALREGISTER(V->BASE)) << (16)))); // 124 %else goto L_006a; L_0069:; // 125 Fail("No absolute yet") FAIL(_imp_str_literal("No absolute yet")); // 126 %finish L_006a:; // 127 %else goto L_006b; L_0068:; // 128 Loadup(V_Record) LOADUP(V->RECORD); // 129 V_Base = V_Record_Base V->BASE = V->RECORD->BASE; // 130 Drop(V_Record); V_Record == NIL DROP(V->RECORD); V->RECORD = NIL; // 131 Fn = Fn ! Actual Register(V_Base)<<16 FN = ((FN) | (((ACTUALREGISTER(V->BASE)) << (16)))); // 132 %finish L_006b:; // 133 %else goto L_006c; L_0067:; // 134 Fn = Fn ! Actual Register(V_Base)<<16 FN = ((FN) | (((ACTUALREGISTER(V->BASE)) << (16)))); // 135 %finish L_006c:; // 136 Forget(V_Base) %if FN&(Post Indexed ! Write Back) # 0 if (((((FN) & (((16777216) | (2097152))))) == (0))) goto L_006d; FORGET(V->BASE); L_006d:; // 137 Fn = Fn !! Post Indexed ! Actual Register(Rd)<<12 FN = ((((FN) ^ (16777216))) | (((ACTUALREGISTER(RD)) << (12)))); // 138 Dump Word(Fn!!Invert Cond) DUMPWORD(((FN) ^ ((-536870912)))); // 139 Release(Extra) %if Extra # 0 if (((EXTRA) == (0))) goto L_006e; RELEASE(EXTRA); L_006e:; // 140 %if Fn&16_0010 0000 # 0 %start {load} if (((((FN) & (1048576))) == (0))) goto L_006f; // 141 Forget(Rd) FORGET(RD); // 142 %else {store} goto L_0070; L_006f:; // 143 Forget Destination(V) FORGETDESTINATION(V); // 144 Remember(Rd, V) REMEMBER(RD, V); // 145 %finish L_0070:; // 146 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT2 at level 3 // 147 // 148 %routine Plant3(%integer Fn, N) void PLANT3( int FN, int N ) { // 149 Dump Word((Fn!!Invert Cond) ! N&16_00FF FFFF) DUMPWORD(((((FN) ^ ((-536870912)))) | (((N) & (16777215))))); // 150 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT3 at level 3 // 151 // 152 %routine Plant4(%integer Fn, Rn, Operand) void PLANT4( int FN, int RN, int OPERAND ) { // 153 Dump Word((Fn!!Invert Cond) ! Actual Register(Rn)<<16 ! Operand&16_FFFF) DUMPWORD(((((((FN) ^ ((-536870912)))) | (((ACTUALREGISTER(RN)) << (16))))) | (((OPERAND) & (65535))))); // 154 Forget(Rn) %if Fn&Write Back # 0 if (((((FN) & (2097152))) == (0))) goto L_0071; FORGET(RN); L_0071:; // 155 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT4 at level 3 // 156 // 157 %routine Plant5(%integer Fn, Offset) void PLANT5( int FN, int OFFSET ) { // 158 Dump Word((Fn!!Invert Cond) ! Offset&16_00FF FFFF) DUMPWORD(((((FN) ^ ((-536870912)))) | (((OFFSET) & (16777215))))); // 159 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT5 at level 3 // 160 // 161 %routine Plant6(%integer Op, Fd, %record(Stackfm)%name V) void PLANT6( int OP, int FD, STACKFM /*name*/*V ) { // 162 {*** WARNING: the displacement is a WORD offset, not a byte one ***} // 163 %integer N, Shift, Sign, D, P, Base, Vbase int N; int SHIFT; int SIGN; int D; int P; int BASE; int VBASE; // 164 %record(Stackfm)%name W STACKFM /*name*/*W; // 165 Simplify(V) SIMPLIFY(V); // 166 D = V_Disp D = V->DISP; // 167 Fail("Floating-point alignment") %if D&3 # 0 if (((((D) & (3))) == (0))) goto L_0072; FAIL(_imp_str_literal("Floating-point alignment")); L_0072:; // 168 D = D//4 {convert to word displacement} D = (long)((long)((int)(D)) / (long)((int)(4))); // 169 %if V_Form = AutoI %start if (((V->FORM) != (2))) goto L_0073; // 170 D = Type Size(V_Type)>>2 D = (unsigned char)((((unsigned char)(TYPESIZE[V->TYPE])) >> (2))); // 171 Op = Op ! Post Indexed OP = ((OP) | (16777216)); // 172 %else %if V_Form = AutoD goto L_0074; L_0073:; if (((V->FORM) != (3))) goto L_0075; // 173 D = -(Type Size(V_Type)>>2) D = (-((unsigned char)((((unsigned char)(TYPESIZE[V->TYPE])) >> (2))))); // 174 Op = Op ! Write Back OP = ((OP) | (2097152)); // 175 %else %if V_Form # Direct goto L_0074; L_0075:; if (((V->FORM) == (1))) goto L_0076; // 176 Fail("illegal load/store") FAIL(_imp_str_literal("illegal load/store")); // 177 %finish L_0076:; L_0074:; // 178 %if V_Index ## NIL %start if (((V->INDEX) == (NIL))) goto L_0077; // 179 Fail("Fp Disp?") %unless -255 <= D <= 255 if (((((-255)) > (D))) || (((D) <= (255)))) goto L_0079; L_0078:; FAIL(_imp_str_literal("Fp Disp?")); L_0079:; // 180 W == Copy(V) {Note - this reverts to a byte displacement} W = COPY(V); // 181 Loadup Address(W) LOADUPADDRESS(W); // 182 W_Type = V_Type; W_Form = Direct W->TYPE = V->TYPE; W->FORM = 1; // 183 Plant6(Op, Fd, W) PLANT6(OP, FD, W); // 184 Release and Drop(W) RELEASEANDDROP(W); // 185 %return /* Remove %on %event handler here if present for this block */ return; // 186 %finish L_0077:; // 187 %if D >= 0 %then Op = Op ! 16_0080 0000 %c if (((D) < (0))) goto L_007a; OP = ((OP) | (8388608)); goto L_007b; L_007a:; D = (-(D)); L_007b:; // 188 %else D = -D // 189 Op = Op ! D OP = ((OP) | (D)); // 190 !!! %if D = 0 %start // 191 !!! Pending Auto N = 2 // 192 !!! Pending Auto = V_Base // 193 !!! Pending Auto Ca = Ca // 194 !!! %finish // 195 %if V_Base = 0 %start {absolute!!} if (((V->BASE) != (0))) goto L_007c; // 196 %if V_Record == NIL %start if (((V->RECORD) != (NIL))) goto L_007d; // 197 %if V_Area < 0 %start if (((V->AREA) >= (0))) goto L_007e; // 198 Fail("Bad external") %if V_Type # Integers if (((V->TYPE) == (1))) goto L_007f; FAIL(_imp_str_literal("Bad external")); L_007f:; // 199 Loadup(V) LOADUP(V); // 200 Op = Op ! Actual Register(V_Base)<<16 OP = ((OP) | (((ACTUALREGISTER(V->BASE)) << (16)))); // 201 %else goto L_0080; L_007e:; // 202 Fail("No absolute yet") FAIL(_imp_str_literal("No absolute yet")); // 203 %finish L_0080:; // 204 %else goto L_0081; L_007d:; // 205 Loadup(V_Record) LOADUP(V->RECORD); // 206 V_Base = V_Record_Base V->BASE = V->RECORD->BASE; // 207 Drop(V_Record); V_Record == NIL DROP(V->RECORD); V->RECORD = NIL; // 208 Op = Op ! Actual Register(V_Base)<<16 OP = ((OP) | (((ACTUALREGISTER(V->BASE)) << (16)))); // 209 %finish L_0081:; // 210 %else goto L_0082; L_007c:; // 211 Op = Op ! Actual Register(V_Base)<<16 OP = ((OP) | (((ACTUALREGISTER(V->BASE)) << (16)))); // 212 %finish L_0082:; // 213 Forget(V_Base) %if Op&(Post Indexed ! Write Back) # 0 if (((((OP) & (((16777216) | (2097152))))) == (0))) goto L_0083; FORGET(V->BASE); L_0083:; // 214 Op = Op !! Post Indexed ! Actual Register(Fd)<<12 OP = ((((OP) ^ (16777216))) | (((ACTUALREGISTER(FD)) << (12)))); // 215 Dump Word(Op!!Invert Cond) DUMPWORD(((OP) ^ ((-536870912)))); // 216 %if Op&16_0010 0000 # 0 %start {load} if (((((OP) & (1048576))) == (0))) goto L_0084; // 217 Forget(Fd) FORGET(FD); // 218 %else {store} goto L_0085; L_0084:; // 219 Forget Destination(V) FORGETDESTINATION(V); // 220 Remember(Fd, V) REMEMBER(FD, V); // 221 %finish L_0085:; // 222 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT6 at level 3 // 223 // 224 %routine Plant7(%integer Op, Fn, Rd, Fm) void PLANT7( int OP, int FN, int RD, int FM ) { // 225 Fm = Actual(Fm) %if Op&Small Constant = 0 if (((((OP) & (8))) != (0))) goto L_0086; FM = ACTUAL[FM]; L_0086:; // 226 Dump Word((Op!!Invert Cond) ! Actual(Fn)<<16 ! Actual(Rd)<<12 ! Fm) DUMPWORD(((((((((OP) ^ ((-536870912)))) | (((ACTUAL[FN]) << (16))))) | (((ACTUAL[RD]) << (12))))) | (FM))); // 227 %if Op&16_0010 0000 = 0 %then Forget(Fn) %else Forget(Rd) if (((((OP) & (1048576))) != (0))) goto L_0087; FORGET(FN); goto L_0088; L_0087:; FORGET(RD); L_0088:; // 228 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT7 at level 3 // 229 // 230 %routine Plant8(%integer Op, Fn, Fm) {CPST} void PLANT8( int OP, int FN, int FM ) { // 231 Fm = Actual(Fm) %if Op&Small Constant = 0 if (((((OP) & (8))) != (0))) goto L_0089; FM = ACTUAL[FM]; L_0089:; // 232 Dump Word((Op!!Invert Cond) ! Actual(Fn)<<16 ! Fm) DUMPWORD(((((((OP) ^ ((-536870912)))) | (((ACTUAL[FN]) << (16))))) | (FM))); // 233 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT8 at level 3 // 234 // 235 %routine Plant9(%integer Op, Fn, Fd, Fm) {CPDO} void PLANT9( int OP, int FN, int FD, int FM ) { // 236 Fm = Actual(Fm) %if Op&Small Constant = 0 if (((((OP) & (8))) != (0))) goto L_008a; FM = ACTUAL[FM]; L_008a:; // 237 Dump Word((Op!!Invert Cond) ! Actual(Fn)<<16 ! Actual(Fd)<<12 ! Fm) DUMPWORD(((((((((OP) ^ ((-536870912)))) | (((ACTUAL[FN]) << (16))))) | (((ACTUAL[FD]) << (12))))) | (FM))); // 238 Forget(Fd) FORGET(FD); // 239 %end /* Remove %on %event handler here if present for this block */ return; } // End of block PLANT9 at level 3 // 240 %endoffile // 1323 %include "load.inc" // 1 %recordformat Constfm(%integer N, Store, Type, V1, R1, V2, R2) typedef struct CONSTFM CONSTFM; struct CONSTFM { int N; int STORE; int TYPE; int V1; int R1; int V2; int R2; }; // 2 %constinteger Const Zero = 1, {constant is zero} // 3 Const Mone = 2, {constant is minus one} // 4 Const Rot = 3, {get with one rotate} // 5 Const Not Rot = 4, {get with two rotates} // 6 Const None = 5 {must go via store} // 7 // 8 %routine Test Assigned void TESTASSIGNED( void ) { // 9 Dir1(Dir Assigned); Ca = Ca+4; Refs = Refs+1 DIR1(24); *CA = ((*(int *)(CA)) + (4)); REFS = (((int)(REFS)) + (1)); // 10 %end /* Remove %on %event handler here if present for this block */ return; } // End of block TESTASSIGNED at level 3 // 11 // 12 %routine Float(%record(Stackfm)%name V, %integer R) void FLOAT( STACKFM /*name*/*V, int R ) { // 13 %integer N int N; // 14 %longreal Long double LONG; // 15 R = FPR %if R = AnyF if (((R) != (26))) goto L_008b; R = FPR(); L_008b:; // 16 %if Iconst(V) %start if (!(ICONST(V))) goto L_008c; // 17 %if 0 <= V_Disp <= 5 %or V_Disp = 10 %start if ((((0) > (V->DISP))) || (((V->DISP) <= (5)))) goto L_008e; L_008d:; if (((V->DISP) != (10))) goto L_008f; L_008e:; // 18 N = V_Disp; N = 7 %if V_Disp = 10 N = V->DISP; if (((V->DISP) != (10))) goto L_0090; N = 7; L_0090:; // 19 Plant9(MVF ! Small Constant, 0, R, N) PLANT9(((234914176) | (8)), 0, R, N); // 20 %else %if -5 <= V_Disp <= 0 %or V_Disp = -10 goto L_0091; L_008f:; if (((((-5)) > (V->DISP))) || (((V->DISP) <= (0)))) goto L_0093; L_0092:; if (((V->DISP) != ((-10)))) goto L_0094; L_0093:; // 21 N = -V_Disp; N = 7 %if N = 10 N = (-(V->DISP)); if (((N) != (10))) goto L_0095; N = 7; L_0095:; // 22 Plant9(MNF ! Small Constant, 0, R, N) PLANT9(((235962752) | (8)), 0, R, N); // 23 %else goto L_0091; L_0094:; // 24 Long = V_Disp; V_Rval = Long LONG = V->DISP; V->RVAL = LONG; // 25 Convert Format(V, Lreals) CONVERTFORMAT(V, 7); // 26 Store Real Constant(V) STOREREALCONSTANT(V); // 27 Dir4(Dir Real Load, Actual(R), V_Disp, 1); Forget(R) DIR4(12, ACTUAL[R], V->DISP, 1); FORGET(R); // 28 Refs = Refs+1; Ca = Ca+4 REFS = (((int)(REFS)) + (1)); *CA = ((*(int *)(CA)) + (4)); // 29 %finish L_0091:; // 30 %else goto L_0096; L_008c:; // 31 Loadup(V) LOADUP(V); // 32 Plant7(FLT, R, V_Base, 0); Release(V_Base) PLANT7(235405584, R, V->BASE, 0); RELEASE(V->BASE); // 33 %finish L_0096:; // 34 V_Type = Lreals; V_Form = Address V->TYPE = 7; V->FORM = 0; // 35 V_Base = R; V_Disp = 0 V->BASE = R; V->DISP = 0; // 36 V_Area = 0 V->AREA = 0; // 37 Claim(R) CLAIM(R); // 38 %end /* Remove %on %event handler here if present for this block */ return; } // End of block FLOAT at level 3 // 39 // 40 %routine Load Safely(%record(Stackfm)%name V, %integer R) void LOADSAFELY( STACKFM /*name*/*V, int R ) { // 41 %if R = Any %start if (((R) != (17))) goto L_0097; // 42 Load Protected(V) LOADPROTECTED(V); // 43 %else %if R = AnyF goto L_0098; L_0097:; if (((R) != (26))) goto L_0099; // 44 Float(V, AnyF) %unless Floating(V) if (FLOATING(V)) goto L_009a; FLOAT(V, 26); L_009a:; // 45 Load Protected(V) LOADPROTECTED(V); // 46 %else goto L_0098; L_0099:; // 47 Hazard(R) %unless Activity(R) = 1 %and V_Base = R if (((ACTIVITY[R]) != (1))) goto L_009b; if (((V->BASE) == (R))) goto L_009c; L_009b:; HAZARD(R); L_009c:; // 48 Load(V, R) LOAD(V, R); // 49 %finish L_0098:; // 50 %end /* Remove %on %event handler here if present for this block */ return; } // End of block LOADSAFELY at level 3 // 51 // 52 %routine Characterise Constant(%integer N, %record(Constfm)%name C) void CHARACTERISECONSTANT( int N, CONSTFM /*name*/*C ) { // 53 %integer Sh, V, S, X int SH; int V; int S; int X; // 54 %constbytearray Bits(0:15) = 0, 1, 1, 2, 1, 2, 2, 3, const unsigned char BITS[16] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, }; // 55 1, 2, 2, 3, 2, 3, 3, 4 // 56 C_N = N C->N = N; // 57 V = N V = N; // 58 %if V = 0 %start if (((V) != (0))) goto L_009d; // 59 C_Type = Const Zero; %return C->TYPE = 1; /* Remove %on %event handler here if present for this block */ return; // 60 %else %if V = -1 L_009d:; if (((V) != ((-1)))) goto L_009e; // 61 C_Type = Const Mone; %return C->TYPE = 2; /* Remove %on %event handler here if present for this block */ return; // 62 %else L_009e:; // 63 X = V; S = 0 {count 1 bits} X = V; S = 0; // 64 %cycle L_009f:; // 65 S = S+Bits(X&15); X = X>>4 S = ((S) + ((int)(BITS[((X) & (15))]))); X = (int)((((unsigned int)(X)) >> (4))); // 66 %repeat %until X = 0 if (((X) == (0))) goto L_00a0; goto L_009f; L_00a0:; // 67 // 68 C_Type = Const Rot C->TYPE = 3; // 69 C_Type = Const Not Rot %and V = ~V %if S > 16 if (((S) <= (16))) goto L_00a2; C->TYPE = 4; V = (~(V)); L_00a2:; // 70 // 71 %if V # 0 %start if (((V) == (0))) goto L_00a3; // 72 Sh = 16 SH = 16; // 73 Sh = Sh-1 %and V = V>>2 %while V&3 = 0 L_00a4:; if (((((V) & (3))) != (0))) goto L_00a5; SH = (((int)(SH)) - (1)); V = (int)((((unsigned int)(V)) >> (2))); goto L_00a4; L_00a5:; // 74 C_R1 = Sh&15; C_V1 = V&255; V = V>>8 C->R1 = ((SH) & (15)); C->V1 = ((V) & (255)); V = (int)((((unsigned int)(V)) >> (8))); // 75 C_R2 = 0; C_V2 = 0 C->R2 = 0; C->V2 = 0; // 76 %if V # 0 %start if (((V) == (0))) goto L_00a7; // 77 Sh = Sh-4 SH = (((int)(SH)) - (4)); // 78 Sh = Sh-1 %and V = V>>2 %while V&3 = 0 L_00a8:; if (((((V) & (3))) != (0))) goto L_00a9; SH = (((int)(SH)) - (1)); V = (int)((((unsigned int)(V)) >> (2))); goto L_00a8; L_00a9:; // 79 C_R2 = Sh&15; C_V2 = V&255; V = V>>8 C->R2 = ((SH) & (15)); C->V2 = ((V) & (255)); V = (int)((((unsigned int)(V)) >> (8))); // 80 %finish L_00a7:; // 81 %finish L_00a3:; // 82 C_Type = Const None %if V # 0 if (((V) == (0))) goto L_00ab; C->TYPE = 5; L_00ab:; // 83 %finish // 84 %end /* Remove %on %event handler here if present for this block */ return; } // End of block CHARACTERISECONSTANT at level 3 // 85 // 86 %routine Now in Register(%record(Stackfm)%name V, %integer R, Inherit) void NOWINREGISTER( STACKFM /*name*/*V, int R, int INHERIT ) { // 87 Remember(R, V) %if Inherit # 0 if (((INHERIT) == (0))) goto L_00ac; REMEMBER(R, V); L_00ac:; // 88 %if V_Index ## Nil %start if (((V->INDEX) == (NIL))) goto L_00ad; // 89 Release and Drop(V_Index); V_Index == Nil RELEASEANDDROP(V->INDEX); V->INDEX = NIL; // 90 %finish L_00ad:; // 91 %if V_Record ## Nil %start if (((V->RECORD) == (NIL))) goto L_00ae; // 92 Release and Drop(V_Record); V_Record == Nil RELEASEANDDROP(V->RECORD); V->RECORD = NIL; // 93 %finish L_00ae:; // 94 Release(V_Base) RELEASE(V->BASE); // 95 V_Data = 0; V_Base = R; V_Form = Address; V_Type = Rtype(R) V->DATA = (DATAFM){ 0 } /* Assign 0's to all fields of record */; V->BASE = R; V->FORM = 0; V->TYPE = RTYPE[R]; // 96 Claim(R) CLAIM(R); // 97 %end /* Remove %on %event handler here if present for this block */ return; } // End of block NOWINREGISTER at level 3 // 98 // 99 %routine Simple Load(%record(Stackfm)%name V, %integer R) void SIMPLELOAD( STACKFM /*name*/*V, int R ) { // 100 %record(Stackfm)%name W, B1, B2 STACKFM /*name*/*W; STACKFM /*name*/*B1; STACKFM /*name*/*B2; // 101 %record(Constfm) C CONSTFM C; // 102 %integer P, N, X, T, Check int P; int N; int X; int T; int CHECK; // 103 // 104 Optimise(V, 1) OPTIMISE(V, 1); // 105 %if InReg(V) %start if (!(INREG(V))) goto L_00af; // 106 %return %if V_Base = R %or (R = Any %and V_Base <= Any) %c if (((V->BASE) == (R))) goto L_00a1; if (((R) != (17))) goto L_00b0; if (((V->BASE) <= (17))) goto L_00a1; L_00b0:; if (((R) != (26))) goto L_00b1; if (((V->BASE) < (18))) goto L_00b1; L_00a1:; /* Remove %on %event handler here if present for this block */ return; L_00b1:; // 107 %or (R = AnyF %and V_Base >= F0) // 108 %finish L_00af:; // 109 // 110 %if R = Any %then R = Gpr %else %if R = AnyF %then R = Fpr if (((R) != (17))) goto L_00b2; R = GPR(); goto L_00b3; L_00b2:; if (((R) != (26))) goto L_00b4; R = FPR(); L_00b4:; L_00b3:; // 111 Hazard(R) %unless V_Base = R %and Activity(R) = 1 if (((V->BASE) != (R))) goto L_0041; if (((ACTIVITY[R]) == (1))) goto L_00b5; L_0041:; HAZARD(R); L_00b5:; // 112 // 113 Simplify(V) SIMPLIFY(V); // 114 // 115 Float(V, R) %and %return %if R >= F0 %and %not Floating(V) if (((R) < (18))) goto L_00b6; if (FLOATING(V)) goto L_00b6; FLOAT(V, R); /* Remove %on %event handler here if present for this block */ return; L_00b6:; // 116 // 117 %if Iconst(V) %start if (!(ICONST(V))) goto L_00b7; // 118 Characterise Constant(V_Disp, C) CHARACTERISECONSTANT(V->DISP, &C); // 119 %if C_Type = Const Zero %start if (((C.TYPE) != (1))) goto L_00b8; // 120 Plant1(MOV, 0, R, Rot(0, 0)) PLANT1(27262976, 0, R, ROT(0, 0)); // 121 %else %if C_Type = Const Mone goto L_00b9; L_00b8:; if (((C.TYPE) != (2))) goto L_00ba; // 122 Plant1(MVN, 0, R, Rot(0, 0)) PLANT1(31457280, 0, R, ROT(0, 0)); // 123 %else %if C_Type = Const Rot goto L_00b9; L_00ba:; if (((C.TYPE) != (3))) goto L_00bb; // 124 Plant1(MOV, 0, R, Rot(C_V1, C_R1)) PLANT1(27262976, 0, R, ROT(C.V1, C.R1)); // 125 Plant1(ORR, R, R, Rot(C_V2, C_R2)) %if C_V2 # 0 if (((C.V2) == (0))) goto L_00bc; PLANT1(25165824, R, R, ROT(C.V2, C.R2)); L_00bc:; // 126 %else %if C_Type = Const Not Rot goto L_00b9; L_00bb:; if (((C.TYPE) != (4))) goto L_00bd; // 127 Plant1(MVN, 0, R, Rot(C_V1, C_R1)) PLANT1(31457280, 0, R, ROT(C.V1, C.R1)); // 128 Plant1(EOR, R, R, Rot(C_V2, C_R2)) %if C_V2 # 0 if (((C.V2) == (0))) goto L_00be; PLANT1(2097152, R, R, ROT(C.V2, C.R2)); L_00be:; // 129 %else{%if C_Type = Const None} goto L_00b9; L_00bd:; // 130 Constant Base = (Constant Base+3)&(\3) CONSTANTBASE = (((((int)(CONSTANTBASE)) + (3))) & ((~(3)))); // 131 W == Literal(Constant Base); W_Form = Direct; W_Area = Constant Area W = LITERAL(CONSTANTBASE); W->FORM = 1; W->AREA = 512; // 132 Select Constant Area SELECTCONSTANTAREA(); // 133 Dump Word(C_N) DUMPWORD(C.N); // 134 Select Code Area SELECTCODEAREA(); // 135 Dir3(Dir Const Load, Actual(R), Constant Base-4); Forget(R) DIR3(11, ACTUAL[R], (((int)(CONSTANTBASE)) - (4))); FORGET(R); // 136 Refs = Refs+1; Ca = Ca+4 REFS = (((int)(REFS)) + (1)); *CA = ((*(int *)(CA)) + (4)); // 137 Release and Drop(W) RELEASEANDDROP(W); // 138 %finish L_00b9:; // 139 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 140 %else %if V_Form = Address goto L_00bf; L_00b7:; if (((V->FORM) != (0))) goto L_00c0; // 141 %if InReg(V) %start if (!(INREG(V))) goto L_00c1; // 142 %if V_Type >= Reals %start if (((V->TYPE) < (6))) goto L_00c2; // 143 Plant9(MVF, 0, R, V_Base) PLANT9(234914176, 0, R, V->BASE); // 144 %else goto L_00c3; L_00c2:; // 145 Plant1(MOV, 0, R, Just(V_Base)) PLANT1(27262976, 0, R, JUST(V->BASE)); // 146 %finish L_00c3:; // 147 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 148 %return /* Remove %on %event handler here if present for this block */ return; // 149 %finish L_00c1:; // 150 %if V_Type >= Reals %start if (((V->TYPE) < (6))) goto L_00c4; // 151 Store Real Constant(V) STOREREALCONSTANT(V); // 152 Dir4(Dir Real Load, Actual(R), V_Disp, 1); Forget(R) DIR4(12, ACTUAL[R], V->DISP, 1); FORGET(R); // 153 Refs = Refs+1; Ca = Ca+4 REFS = (((int)(REFS)) + (1)); *CA = ((*(int *)(CA)) + (4)); // 154 Remember(R, V) REMEMBER(R, V); // 155 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 156 %return /* Remove %on %event handler here if present for this block */ return; // 157 %finish L_00c4:; // 158 %if V_Area = Constant Area %start if (((V->AREA) != (512))) goto L_00c5; // 159 Dir3(Dir Const Addr, Actual(R), V_Disp); Forget(R) DIR3(10, ACTUAL[R], V->DISP); FORGET(R); // 160 Refs = Refs+1; Ca = Ca+4 REFS = (((int)(REFS)) + (1)); *CA = ((*(int *)(CA)) + (4)); // 161 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 162 %return /* Remove %on %event handler here if present for this block */ return; // 163 %finish L_00c5:; // 164 %if V_Index ## NIL %start if (((V->INDEX) == (NIL))) goto L_00c6; // 165 %if V_Record ## NIL %and V_Base = 0 %start if (((V->RECORD) == (NIL))) goto L_00c7; if (((V->BASE) != (0))) goto L_00c7; // 166 Loadup(V_Record) LOADUP(V->RECORD); // 167 V_Base = V_Record_Base V->BASE = V->RECORD->BASE; // 168 Drop(V_Record); V_Record == NIL DROP(V->RECORD); V->RECORD = NIL; // 169 %finish L_00c7:; // 170 %if V_Base = 0 %start if (((V->BASE) != (0))) goto L_00c8; // 171 Not in Yet NOTINYET(); // 172 %else L_00c8:; // 173 P = Power(V_Xsize) P = POWER(V->XSIZE); // 174 %if P >= 0 %start {can use logical shift} if (((P) < (0))) goto L_00c9; // 175 Loadup(V_Index) LOADUP(V->INDEX); // 176 Plant1(ADD, V_Base, R, Ishift(V_Index_Base, P, Logical Left)) PLANT1(8388608, V->BASE, R, ISHIFT(V->INDEX->BASE, P, 0)); // 177 %else {must use multiply} goto L_00ca; L_00c9:; // 178 Operate(MULx, V_Index, Literal(V_Xsize)) OPERATE(6, V->INDEX, LITERAL(V->XSIZE)); // 179 Loadup(V_Index); V_Xsize = 1 LOADUP(V->INDEX); V->XSIZE = 1; // 180 Plant1(ADD, V_Base, R, Just(V_Index_Base)) PLANT1(8388608, V->BASE, R, JUST(V->INDEX->BASE)); // 181 %finish L_00ca:; // 182 %finish // 183 {at this point R contains BASE + scaled*INDEX} // 184 %if V_Disp > 0 %start if (((V->DISP) <= (0))) goto L_00cb; // 185 Characterise Constant(V_Disp, C) CHARACTERISECONSTANT(V->DISP, &C); // 186 %if C_Type = Const Rot %start if (((C.TYPE) != (3))) goto L_00cc; // 187 Plant1(ADD, R, R, Rot(C_V1, C_R1)) PLANT1(8388608, R, R, ROT(C.V1, C.R1)); // 188 Plant1(ADD, R, R, Rot(C_V2, C_R2)) %if C_V2 # 0 if (((C.V2) == (0))) goto L_00cd; PLANT1(8388608, R, R, ROT(C.V2, C.R2)); L_00cd:; // 189 %else %if C_Type = Const None goto L_00ce; L_00cc:; if (((C.TYPE) != (5))) goto L_00cf; // 190 Nasty: Constant Base = (Constant Base+3)&(\3) U_1000:; CONSTANTBASE = (((((int)(CONSTANTBASE)) + (3))) & ((~(3)))); // 191 Select Constant Area SELECTCONSTANTAREA(); // 192 Dump Word(V_Disp) DUMPWORD(V->DISP); // 193 Select Code Area SELECTCODEAREA(); // 194 X = GPR X = GPR(); // 195 Dir3(Dir Const Load, Actual(X), Constant Base-4); Forget(X) DIR3(11, ACTUAL[X], (((int)(CONSTANTBASE)) - (4))); FORGET(X); // 196 Refs = Refs+1; Ca = Ca+4 REFS = (((int)(REFS)) + (1)); *CA = ((*(int *)(CA)) + (4)); // 197 Plant1(ADD, V_Base, R, Just(X)) PLANT1(8388608, V->BASE, R, JUST(X)); // 198 %else goto L_00ce; L_00cf:; // 199 Fail("Bad displacement") FAIL(_imp_str_literal("Bad displacement")); // 200 %finish L_00ce:; // 201 %else %if V_Disp < 0 goto L_00d0; L_00cb:; if (((V->DISP) >= (0))) goto L_00d1; // 202 Characterise Constant(-V_Disp, C) CHARACTERISECONSTANT((-(V->DISP)), &C); // 203 %if C_Type = Const Rot %start if (((C.TYPE) != (3))) goto L_00d2; // 204 Plant1(SUB, R, R, Rot(C_V1, C_R1)) PLANT1(4194304, R, R, ROT(C.V1, C.R1)); // 205 Plant1(SUB, R, R, Rot(C_V2, C_R2)) %if C_V2 # 0 if (((C.V2) == (0))) goto L_00d3; PLANT1(4194304, R, R, ROT(C.V2, C.R2)); L_00d3:; // 206 %else %if C_Type = Const None goto L_00d4; L_00d2:; if (((C.TYPE) != (5))) goto L_00d5; // 207 W == Literal(V_Disp); W_Form = Direct; W_Base = Pc W = LITERAL(V->DISP); W->FORM = 1; W->BASE = 16; // 208 Loadup(W) LOADUP(W); // 209 Plant1(SUB, R, R, Just(W_Base)) PLANT1(4194304, R, R, JUST(W->BASE)); // 210 Release and Drop(W) RELEASEANDDROP(W); // 211 %else goto L_00d4; L_00d5:; // 212 ->Nasty goto U_1000; // 213 %finish L_00d4:; // 214 %finish L_00d1:; L_00d0:; // 215 %else {V_Index==NIL} goto L_00d6; L_00c6:; // 216 N = V_Disp; P = ADD N = V->DISP; P = 8388608; // 217 N = -N %and P = SUB %if N < 0 if (((N) >= (0))) goto L_00d7; N = (-(N)); P = 4194304; L_00d7:; // 218 Characterise Constant(N, C) CHARACTERISECONSTANT(N, &C); // 219 %if C_Type = Const Zero %start if (((C.TYPE) != (1))) goto L_00d8; // 220 Plant1(MOV, 0, R, Just(V_Base)) PLANT1(27262976, 0, R, JUST(V->BASE)); // 221 %else %if C_Type = Const Rot goto L_00d9; L_00d8:; if (((C.TYPE) != (3))) goto L_00da; // 222 Plant1(P, V_Base, R, Rot(C_V1, C_R1)) PLANT1(P, V->BASE, R, ROT(C.V1, C.R1)); // 223 Plant1(P, R, R, Rot(C_V2, C_R2)) %if C_V2 # 0 if (((C.V2) == (0))) goto L_00db; PLANT1(P, R, R, ROT(C.V2, C.R2)); L_00db:; // 224 %else %if C_Type = Const None goto L_00d9; L_00da:; if (((C.TYPE) != (5))) goto L_00dc; // 225 W == Literal(C_N); Loadup(W) W = LITERAL(C.N); LOADUP(W); // 226 Plant1(P, V_Base, R, Just(W_Base)) PLANT1(P, V->BASE, R, JUST(W->BASE)); // 227 Release and Drop(W) RELEASEANDDROP(W); // 228 %else goto L_00d9; L_00dc:; // 229 Fail("negate error") FAIL(_imp_str_literal("negate error")); // 230 %finish L_00d9:; // 231 %finish L_00d6:; // 232 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 233 %else %if V_Form = Direct goto L_00bf; L_00c0:; if (((V->FORM) != (1))) goto L_00dd; // 234 Check = V_Flags & Checkable CHECK = ((V->FLAGS) & (1048576)); // 235 Check = 0 %if Unassigned = 0 %or V_Flags & Known Ass # 0 if (((UNASSIGNED) == (0))) goto L_00de; if (((((V->FLAGS) & (128))) == (0))) goto L_00df; L_00de:; CHECK = 0; L_00df:; // 236 %if V_Area # 0 %start if (((V->AREA) == (0))) goto L_00e0; // 237 %if V_Area = Constant Area %start if (((V->AREA) != (512))) goto L_00e1; // 238 %if V_Type = Integers %start if (((V->TYPE) != (1))) goto L_00e2; // 239 Dir3(Dir Const Load, Actual(R), V_Disp) DIR3(11, ACTUAL[R], V->DISP); // 240 %else %if V_Type = Lreals goto L_00e3; L_00e2:; if (((V->TYPE) != (7))) goto L_00e4; // 241 Dir4(Dir Real Load, Actual(R), V_Disp, 1) DIR4(12, ACTUAL[R], V->DISP, 1); // 242 %else %if V_Type = Reals goto L_00e3; L_00e4:; if (((V->TYPE) != (6))) goto L_00e5; // 243 Dir4(Dir Real Load, Actual(R), V_Disp, 0) DIR4(12, ACTUAL[R], V->DISP, 0); // 244 %else %if V_Type = Bytes %or V_Type = Shorts goto L_00e3; L_00e5:; if (((V->TYPE) == (4))) goto L_00aa; if (((V->TYPE) != (2))) goto L_00e6; L_00aa:; // 245 T = V_Type T = V->TYPE; // 246 Amap(V); Load(V, R) AMAP(V); LOAD(V, R); // 247 V_Type = T; V_Form = Direct; Load(V, R) V->TYPE = T; V->FORM = 1; LOAD(V, R); // 248 %return /* Remove %on %event handler here if present for this block */ return; // 249 %else L_00e6:; // 250 Fail("Bad constant type") FAIL(_imp_str_literal("Bad constant type")); // 251 %finish L_00e3:; // 252 Refs = Refs+1; Ca = Ca+4 REFS = (((int)(REFS)) + (1)); *CA = ((*(int *)(CA)) + (4)); // 253 Forget(R) FORGET(R); // 254 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 255 %return /* Remove %on %event handler here if present for this block */ return; // 256 %finish L_00e1:; // 257 %if V_Area < 0 %start if (((V->AREA) >= (0))) goto L_00e7; // 258 Fail("Bad external spec type") %if V_Type # Integers if (((V->TYPE) == (1))) goto L_00e8; FAIL(_imp_str_literal("Bad external spec type")); L_00e8:; // 259 Dir3(Dir Spec Load, Actual(R), -V_Area); Forget(R) DIR3(13, ACTUAL[R], (-(V->AREA))); FORGET(R); // 260 Refs = Refs+1; Ca = Ca+4 REFS = (((int)(REFS)) + (1)); *CA = ((*(int *)(CA)) + (4)); // 261 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 262 %return /* Remove %on %event handler here if present for this block */ return; // 263 %finish L_00e7:; // 264 %finish L_00e0:; // 265 // 266 %if V_Type = Bytes %start if (((V->TYPE) != (4))) goto L_00e9; // 267 Plant2(LDR, R, V) PLANT2(68157440, R, V); // 268 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 269 %if Check # 0 %start if (((CHECK) == (0))) goto L_00ea; // 270 Plant1(CMP ! Scc, R, 0, Immediate(16_80)) PLANT1(((22020096) | (1048576)), R, 0, IMMEDIATE(128)); // 271 Test Assigned TESTASSIGNED(); // 272 %finish L_00ea:; // 273 %else %if V_Type = Shorts goto L_00eb; L_00e9:; if (((V->TYPE) != (2))) goto L_00ec; // 274 Simplify(V) SIMPLIFY(V); // 275 %if V_Index ## NIL %or V_Record ## NIL %start if (((V->INDEX) != (NIL))) goto L_00a6; if (((V->RECORD) == (NIL))) goto L_00ed; L_00a6:; // 276 Loadup Address(V); V_Type = Shorts; V_Form = Direct LOADUPADDRESS(V); V->TYPE = 2; V->FORM = 1; // 277 %finish L_00ed:; // 278 {Be careful to load [base+1] before [base+0] to leave} // 279 {the possibility of auto increment} // 280 B1 == Copy(V); Advance(B1, Bytes, 0) {low byte} B1 = COPY(V); ADVANCE(B1, 4, 0); // 281 B2 == Copy(V); Advance(B2, Bytes, 1) {high byte} B2 = COPY(V); ADVANCE(B2, 4, 1); // 282 B1_Flags = B1_Flags ! Known Ass B1->FLAGS = ((B1->FLAGS) | (128)); // 283 B2_Flags = B2_Flags ! Known Ass B2->FLAGS = ((B2->FLAGS) | (128)); // 284 Load(B2, R14); Load(B1, R); Loadup(B2) {in case of hazard} LOAD(B2, 15); LOAD(B1, R); LOADUP(B2); // 285 %if Check # 0 %start if (((CHECK) == (0))) goto L_00ee; // 286 Plant1(CMP ! Scc, B1_Base, 0, Immediate(16_80)) PLANT1(((22020096) | (1048576)), B1->BASE, 0, IMMEDIATE(128)); // 287 Plant1(CMP ! Scc ! Cond EQ, B2_Base, 0, Immediate(16_80)) PLANT1(((((22020096) | (1048576))) | ((-536870912))), B2->BASE, 0, IMMEDIATE(128)); // 288 Test Assigned TESTASSIGNED(); // 289 %finish L_00ee:; // 290 Plant1(MOV, 0, B2_Base, Ishift(B2_Base, 24, Logical Left)) PLANT1(27262976, 0, B2->BASE, ISHIFT(B2->BASE, 24, 0)); // 291 Plant1(ORR, B1_Base, R, Ishift(B2_Base, 16, Arithmetic Right)) PLANT1(25165824, B1->BASE, R, ISHIFT(B2->BASE, 16, 64)); // 292 Release and Drop Pair(B1, B2) RELEASEANDDROPPAIR(B1, B2); // 293 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 294 %else %if V_Type = Reals goto L_00eb; L_00ec:; if (((V->TYPE) != (6))) goto L_00ef; // 295 Plant6(LDFS, R, V) PLANT6(202375424, R, V); // 296 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 297 %if Check # 0 %start if (((CHECK) == (0))) goto L_00f0; // 298 B1 == Literal(0) B1 = LITERAL(0); // 299 B1_Type = Lreals; B1_Form = Direct; B1_Base = SB B1->TYPE = 7; B1->FORM = 1; B1->BASE = 10; // 300 Loadup(B1); Release and Drop(B1) LOADUP(B1); RELEASEANDDROP(B1); // 301 Plant8(CMF, B1_Base, R) PLANT8(244379920, B1->BASE, R); // 302 Test Assigned TESTASSIGNED(); // 303 %finish L_00f0:; // 304 %else %if V_Type = Lreals goto L_00eb; L_00ef:; if (((V->TYPE) != (7))) goto L_00f1; // 305 Plant6(LDFD, R, V) PLANT6(202408192, R, V); // 306 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 307 %if Check # 0 %start if (((CHECK) == (0))) goto L_00f2; // 308 B1 == Literal(0) B1 = LITERAL(0); // 309 B1_Type = Lreals; B1_Form = Direct; B1_Base = SB B1->TYPE = 7; B1->FORM = 1; B1->BASE = 10; // 310 Loadup(B1); Release and Drop(B1) LOADUP(B1); RELEASEANDDROP(B1); // 311 Plant8(CMF, B1_Base, R) PLANT8(244379920, B1->BASE, R); // 312 Test Assigned TESTASSIGNED(); // 313 %finish L_00f2:; // 314 %else goto L_00eb; L_00f1:; // 315 Plant2(LDR, R, V) {default to integer} PLANT2(68157440, R, V); // 316 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 317 %if Check # 0 %start if (((CHECK) == (0))) goto L_00f3; // 318 B1 == Literal(0) B1 = LITERAL(0); // 319 B1_Form = Direct; B1_Base = SB B1->FORM = 1; B1->BASE = 10; // 320 Loadup(B1); Release and Drop(B1) LOADUP(B1); RELEASEANDDROP(B1); // 321 Plant1(CMP ! Scc, B1_Base, 0, Just(R)) PLANT1(((22020096) | (1048576)), B1->BASE, 0, JUST(R)); // 322 Test Assigned TESTASSIGNED(); // 323 %finish L_00f3:; // 324 %finish L_00eb:; // 325 %else %if V_Form = AutoD goto L_00bf; L_00dd:; if (((V->FORM) != (3))) goto L_00f4; // 326 Plant2(LDR, R, V); Forget(V_Base) PLANT2(68157440, R, V); FORGET(V->BASE); // 327 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 328 %else %if V_Form = AutoI goto L_00bf; L_00f4:; if (((V->FORM) != (2))) goto L_00f5; // 329 Plant2(LDR, R, V); Forget(V_Base) PLANT2(68157440, R, V); FORGET(V->BASE); // 330 Now in Register(V, R, 1) NOWINREGISTER(V, R, 1); // 331 %else goto L_00bf; L_00f5:; // 332 Fail("Unknown type for LOAD") FAIL(_imp_str_literal("Unknown type for LOAD")); // 333 %finish L_00bf:; // 334 %end /* Remove %on %event handler here if present for this block */ return; } // End of block SIMPLELOAD at level 3 // 335 // 336 %routine Multiply(%record(Stackfm)%name V, W, %integer R) void MULTIPLY( STACKFM /*name*/*V, STACKFM /*name*/*W, int R ) { // 337 {BEWARE: this uses TEST ZERO and can there for alter INVERT, but} // 338 { multiply can occur during a condition evaluation therefore} // 339 { INVERT needs to be preserved across this call} // 340 // 341 %routine Cmul(%integer From, To, By) void CMUL( int FROM, int TO, int BY ) { // 342 %integer X, Op, With, T int X; int OP; int WITH; int T; // 343 %if By&1 = 0 %start if (((((BY) & (1))) != (0))) goto L_00f6; // 344 Op = MOV; With = 0 OP = 27262976; WITH = 0; // 345 %else %if By&3 = 1 goto L_00f7; L_00f6:; if (((((BY) & (3))) != (1))) goto L_00f8; // 346 Op = ADD; With = From OP = 8388608; WITH = FROM; // 347 %else {By&3 = 3} goto L_00f7; L_00f8:; // 348 By = By+1 BY = (((int)(BY)) + (1)); // 349 Op = RSB; With = From OP = 6291456; WITH = FROM; // 350 %finish L_00f7:; // 351 X = 0; X = X+1 %and By = By>>1 %until By&1 # 0 X = 0; L_00f9:; X = (((int)(X)) + (1)); BY = (int)((((unsigned int)(BY)) >> (1))); if (((((BY) & (1))) != (0))) goto L_00fa; goto L_00f9; L_00fa:; // 352 %if By = 1 %start if (((BY) != (1))) goto L_00fc; // 353 T = From T = FROM; // 354 %else goto L_00fd; L_00fc:; // 355 T = Gpr T = GPR(); // 356 Cmul(From, T, By) CMUL(FROM, T, BY); // 357 %finish L_00fd:; // 358 Plant1(Op, With, To, Ishift(T, X, Logical Left)) PLANT1(OP, WITH, TO, ISHIFT(T, X, 0)); // 359 %end /* Remove %on %event handler here if present for this block */ return; } // End of block CMUL at level 4 // 360 // 361 %integer L, Inv int L; int INV; // 362 %record(Stackfm)%name Z STACKFM /*name*/*Z; // 363 %if Iconst(W) %start if (!(ICONST(W))) goto L_00fe; // 364 Load Safely(V, R) LOADSAFELY(V, R); // 365 Fail("Zero multiply") %if W_Disp = 0 if (((W->DISP) != (0))) goto L_00ff; FAIL(_imp_str_literal("Zero multiply")); L_00ff:; // 366 Cmul(V_Base, V_Base, W_Disp) CMUL(V->BASE, V->BASE, W->DISP); // 367 %else goto L_0100; L_00fe:; // 368 Optimise(V, 1) OPTIMISE(V, 1); // 369 Optimise(W, 1) OPTIMISE(W, 1); // 370 Z == Literal(0) Z = LITERAL(0); // 371 %if R = Any %or R = AnyF %or Activity(R) # 0 %start {SCR/87/448} if (((R) == (17))) goto L_0101; if (((R) == (26))) goto L_0101; if (((ACTIVITY[R]) == (0))) goto L_0102; L_0101:; // 372 Load Protected(Z) LOADPROTECTED(Z); // 373 %else goto L_0103; L_0102:; // 374 Load(Z, R) LOAD(Z, R); // 375 %finish L_0103:; // 376 Load Protected(V) LOADPROTECTED(V); // 377 Load Protected(W) LOADPROTECTED(W); // 378 Inv = Invert; Invert = 0 INV = INVERT; INVERT = 0; // 379 L = New label L = NEWLABEL(); // 380 Define Label(L) DEFINELABEL(L); // 381 Plant1(MOV!Scc, 0, W_Base, Ishift(W_Base, 1, Logical Right)) PLANT1(((27262976) | (1048576)), 0, W->BASE, ISHIFT(W->BASE, 1, 32)); // 382 Plant1(ADD ! Cond CS, Z_Base, Z_Base, Just(V_Base)) PLANT1(((8388608) | ((-1073741824))), Z->BASE, Z->BASE, JUST(V->BASE)); // 383 Plant1(MOV, 0, V_Base, Ishift(V_Base, 1, Logical Left)) PLANT1(27262976, 0, V->BASE, ISHIFT(V->BASE, 1, 0)); // 384 Jump To(L, NE) JUMPTO(L, 6); // 385 Release(V_Base); V_Base = Z_Base; Drop(Z) RELEASE(V->BASE); V->BASE = Z->BASE; DROP(Z); // 386 Load(V, R) LOAD(V, R); // 387 Invert = Inv INVERT = INV; // 388 %finish L_0100:; // 389 Release and Drop(W) RELEASEANDDROP(W); // 390 %end /* Remove %on %event handler here if present for this block */ return; } // End of block MULTIPLY at level 3 // 391 // 392 %routine Divide(%record(Stackfm)%name V, W, %integer R, Q, U) void DIVIDE( STACKFM /*name*/*V, STACKFM /*name*/*W, int R, int Q, int U ) { // 393 {Q = 0 for quotient, 1 for remainder} // 394 {U = 0 for unsigned} // 395 %integer P, L, Op int P; int L; int OP; // 396 %if (Q = 0 %or U = 0) %and Iconst(W) %start if (((Q) == (0))) goto L_0104; if (((U) != (0))) goto L_0105; L_0104:; if (!(ICONST(W))) goto L_0105; // 397 P = Power(W_Disp) P = POWER(W->DISP); // 398 %if P > 0 %start if (((P) <= (0))) goto L_0106; // 399 %if U = 0 %start {unsigned} if (((U) != (0))) goto L_0107; // 400 %if Q = 0 %start {divide} if (((Q) != (0))) goto L_0108; // 401 W_Disp = P W->DISP = P; // 402 Op = RSHx OP = 15; // 403 %else {REM} goto L_0109; L_0108:; // 404 W_Disp = \((-1)<DISP = (~((((-1)) << (P)))); // 405 Op = ANDx OP = 9; // 406 %finish L_0109:; // 407 Operate(Op, V, W) OPERATE(OP, V, W); // 408 Load(V, R) LOAD(V, R); // 409 %return /* Remove %on %event handler here if present for this block */ return; // 410 %finish L_0107:; // 411 %if P <= 8 %start if (((P) > (8))) goto L_010a; // 412 Load Safely(V, R) LOADSAFELY(V, R); // 413 Plant1(CMP!Scc, V_Base, 0, Nothing) PLANT1(((22020096) | (1048576)), V->BASE, 0, NOTHING()); // 414 L = New Label L = NEWLABEL(); // 415 Jump To(L, GE) JUMPTO(L, 5); // 416 Plant1(ADD, V_Base, V_Base, Rot(W_Disp-1, 0)) PLANT1(8388608, V->BASE, V->BASE, ROT((((int)(W->DISP)) - (1)), 0)); // 417 Define label(L) DEFINELABEL(L); // 418 Plant1(MOV, 0, V_Base, Ishift(V_Base, P, Arithmetic Right)) PLANT1(27262976, 0, V->BASE, ISHIFT(V->BASE, P, 64)); // 419 Drop(W) DROP(W); // 420 %return /* Remove %on %event handler here if present for this block */ return; // 421 %finish L_010a:; // 422 %finish L_0106:; // 423 %finish L_0105:; // 424 %if U = 0 %then Op = Prim Udiv %else Op = Prim Div if (((U) != (0))) goto L_010b; OP = 49; goto L_010c; L_010b:; OP = 38; L_010c:; // 425 Load Safely(V, R1) LOADSAFELY(V, 2); // 426 Load Pair(V, R1, W, R2) LOADPAIR(V, 2, W, 3); // 427 Prim(Op) PRIM(OP); // 428 %if Q = 0 %start {quotient wanted} if (((Q) != (0))) goto L_010d; // 429 Release(R1); Claim(R0); V_Base = R0 RELEASE(2); CLAIM(1); V->BASE = 1; // 430 %finish L_010d:; // 431 Load(V, R) LOAD(V, R); // 432 Release and Drop(W) RELEASEANDDROP(W); // 433 %end /* Remove %on %event handler here if present for this block */ return; } // End of block DIVIDE at level 3 // 434 // 435 %routine Complex Load(%record(Stackfm)%name V, %integer R) void COMPLEXLOAD( STACKFM /*name*/*V, int R ) { // 436 %switch C,C2(NOTx:REXPx) static int sw1_C_idx; static const void * /*SWITCH*/ sw1_C[29] = { &&sw1_C_1, &&sw1_C_2, &&sw1_C_3, &&sw1_C_4, &&sw1_C_5, &&sw1_C_6, &&sw1_C_7, &&sw1_C_8, &&sw1_C_9, &&sw1_C_10, &&sw1_C_11, &&sw1_C_12, &&sw1_C_13, &&sw1_C_14, &&sw1_C_15, &&sw1_C_16, &&sw1_C_17, &&sw1_C_18, &&sw1_C_19, &&sw1_C_20, &&sw1_C_21, &&sw1_C_22, &&sw1_C_23, &&sw1_C_24, &&sw1_C_25, &&sw1_C_26, &&sw1_C_27, &&sw1_C_28, &&sw1_C_29, }; static int sw2_C2_idx; static const void * /*SWITCH*/ sw2_C2[29] = { &&sw2_C2_1, &&sw2_C2_2, &&sw2_C2_3, &&sw2_C2_4, &&sw2_C2_5, &&sw2_C2_6, &&sw2_C2_7, &&sw2_C2_8, &&sw2_C2_9, &&sw2_C2_10, &&sw2_C2_11, &&sw2_C2_12, &&sw2_C2_13, &&sw2_C2_14, &&sw2_C2_15, &&sw2_C2_16, &&sw2_C2_17, &&sw2_C2_18, &&sw2_C2_19, &&sw2_C2_20, &&sw2_C2_21, &&sw2_C2_22, &&sw2_C2_23, &&sw2_C2_24, &&sw2_C2_25, &&sw2_C2_26, &&sw2_C2_27, &&sw2_C2_28, &&sw2_C2_29, }; // 437 %constintegerarray Real Op(RNEGx:REXPx) = MNF, ABS, ADF, SUF, MUF, DVF, POW const int REALOP[7] = { 235962752, 237011328, 234881408, 236978560, 235929984, 239075712, 241172864, }; // 438 %record(Stackfm)%name W, B STACKFM /*name*/*W; STACKFM /*name*/*B; // 439 %record(Constfm) Cx CONSTFM CX; // 440 %integer Oper, Op, Reg2, N, Pa int OPER; int OP; int REG2; int N; int PA; // 441 // 442 W == V_Link; V_Link == NIL W = V->LINK; V->LINK = NIL; // 443 Oper = V_Oper; V_Oper = 0 OPER = V->OPER; V->OPER = 0; // 444 // 445 %if Oper >= RNEGx %or R >= F0 %start if (((OPER) >= (23))) goto L_010e; if (((R) < (18))) goto L_010f; L_010e:; // 446 Fail("real load?") %if R <= Any if (((R) > (17))) goto L_0110; FAIL(_imp_str_literal("real load?")); L_0110:; // 447 %if Oper = REXPx %start if (((OPER) != (29))) goto L_0111; // 448 Load Safely(V, F0) LOADSAFELY(V, 18); // 449 Load Pair(V, F0, W, R0) LOADPAIR(V, 18, W, 1); // 450 Prim(Real Exp) PRIM(6); // 451 Release and Drop(W) {done here in case of HAZARD corrupting it} RELEASEANDDROP(W); // 452 Load(V, R) LOAD(V, R); // 453 %return /* Remove %on %event handler here if present for this block */ return; // 454 %finish L_0111:; // 455 %if Oper < RNEGx %start if (((OPER) >= (23))) goto L_0112; // 456 V_Link == W; V_Oper = Oper; Load(V, Any) {integer operation} V->LINK = W; V->OPER = OPER; LOAD(V, 17); // 457 Load(V, R) LOAD(V, R); // 458 %return /* Remove %on %event handler here if present for this block */ return; // 459 %finish L_0112:; // 460 Load Safely(V, R) LOADSAFELY(V, R); // 461 Op = Real Op(Oper) OP = (REALOP-23)[OPER]; // 462 %if W == NIL %start {neg, abs} if (((W) != (NIL))) goto L_0113; // 463 Plant9(Op, 0, V_Base, V_Base) PLANT9(OP, 0, V->BASE, V->BASE); // 464 %else goto L_0114; L_0113:; // 465 %if Iconst(W) %and (0 <= W_Disp <= 5 %or W_Disp = 10) %start if (!(ICONST(W))) goto L_0115; if ((((0) > (W->DISP))) || (((W->DISP) <= (5)))) goto L_0117; L_0116:; if (((W->DISP) != (10))) goto L_0115; L_0117:; // 466 Reg2 = W_Disp; Reg2 = 7 %if Reg2 = 10 REG2 = W->DISP; if (((REG2) != (10))) goto L_0118; REG2 = 7; L_0118:; // 467 Op = Op ! Small Constant OP = ((OP) | (8)); // 468 %else goto L_0119; L_0115:; // 469 Load(W, AnyF) LOAD(W, 26); // 470 Reg2 = W_Base REG2 = W->BASE; // 471 %finish L_0119:; // 472 Plant9(Op, V_Base, V_Base, Reg2) PLANT9(OP, V->BASE, V->BASE, REG2); // 473 %finish L_0114:; // 474 ->OK goto U_1001; // 475 %finish L_010f:; // 476 // 477 %if Oper = EXPx %start if (((OPER) != (8))) goto L_011a; // 478 Load Safely(V, R1) LOADSAFELY(V, 2); // 479 Load Pair(V, R1, W, R2) LOADPAIR(V, 2, W, 3); // 480 Prim(IntExp) PRIM(5); // 481 Release and Drop(W) {done here in case of HAZARD} RELEASEANDDROP(W); // 482 Load(V, R) LOAD(V, R); // 483 %return /* Remove %on %event handler here if present for this block */ return; // 484 %finish L_011a:; // 485 // 486 %if Oper = MODx %start if (((OPER) != (17))) goto L_011b; // 487 Load Safely(V, R1) LOADSAFELY(V, 2); // 488 Load Pair(V, R1, W, R2) LOADPAIR(V, 2, W, 3); // 489 Prim(MODULUS) PRIM(42); // 490 Release and Drop(W) RELEASEANDDROP(W); // 491 %return /* Remove %on %event handler here if present for this block */ return; // 492 %finish L_011b:; // 493 // 494 Multiply(V, W, R) %and %return %if Oper = MULx if (((OPER) != (6))) goto L_011c; MULTIPLY(V, W, R); /* Remove %on %event handler here if present for this block */ return; L_011c:; // 495 Divide (V, W, R, 0, 1) %and %return %if Oper = DIVx if (((OPER) != (7))) goto L_011d; DIVIDE(V, W, R, 0, 1); /* Remove %on %event handler here if present for this block */ return; L_011d:; // 496 Divide (V, W, R, 1, 1) %and %return %if Oper = REMx if (((OPER) != (16))) goto L_011e; DIVIDE(V, W, R, 1, 1); /* Remove %on %event handler here if present for this block */ return; L_011e:; // 497 Divide (V, W, R, 0, 0) %and %return %if Oper = UDIVx if (((OPER) != (19))) goto L_011f; DIVIDE(V, W, R, 0, 0); /* Remove %on %event handler here if present for this block */ return; L_011f:; // 498 Divide (V, W, R, 1, 0) %and %return %if Oper = UREMx if (((OPER) != (20))) goto L_0120; DIVIDE(V, W, R, 1, 0); /* Remove %on %event handler here if present for this block */ return; L_0120:; // 499 // 500 %if Oper = SUBx %and Iconst(V) %start if (((OPER) != (5))) goto L_0121; if (!(ICONST(V))) goto L_0121; // 501 Characterise Constant(V_Disp, Cx) CHARACTERISECONSTANT(V->DISP, &CX); // 502 %if Cx_Type = Const Rot %start if (((CX.TYPE) != (3))) goto L_0122; // 503 Load(W, R); R = W_Base LOAD(W, R); R = W->BASE; // 504 Plant1(RSB, W_Base, R, Rot(Cx_V1, Cx_R1)) PLANT1(6291456, W->BASE, R, ROT(CX.V1, CX.R1)); // 505 Plant1(ADD, R, R, Rot(Cx_V2, Cx_R2)) %if Cx_V2 # 0; ->OK Set if (((CX.V2) == (0))) goto L_0123; PLANT1(8388608, R, R, ROT(CX.V2, CX.R2)); L_0123:; goto U_1002; // 506 %else %if Cx_Type = Const Mone L_0122:; if (((CX.TYPE) != (2))) goto L_0124; // 507 Load Safely(W, R); R = W_Base LOADSAFELY(W, R); R = W->BASE; // 508 Plant1(MVN, 0, R, Just(W_Base)) PLANT1(31457280, 0, R, JUST(W->BASE)); // 509 OK Set: V_Base = R; V_Disp = 0; W_Base = 0; ->OK U_1002:; V->BASE = R; V->DISP = 0; W->BASE = 0; goto U_1001; // 510 %finish L_0124:; // 511 %finish L_0121:; // 512 // 513 %if Pending Auto # 0 %and Oper = ADDx %and Iconst(W) %c if (((PENDINGAUTO) == (0))) goto L_0125; if (((OPER) != (4))) goto L_0125; if (!(ICONST(W))) goto L_0125; if (((((-4095)) > (W->DISP))) || (((W->DISP) > (4095)))) goto L_0125; // 514 %and -4095 <= W_Disp <= 4095 %start // 515 Pa = Pending Auto {the optimise will destroy it} PA = PENDINGAUTO; // 516 Optimise(V, 1) OPTIMISE(V, 1); // 517 %if Inreg(V) %and V_Base = Pa %c if (!(INREG(V))) goto L_0126; if (((V->BASE) != (PA))) goto L_0126; if (((PENDINGAUTON) == (0))) goto L_0127; if (((_imp_IMOD((int)((((unsigned int)(W->DISP)) >> (2))))) > (255))) goto L_0126; L_0127:; // 518 %and (Pending Auto N = 0 %or |W_Disp>>2| <= 255) %start // 519 Dir3(Dir Modify, Ca-Pending Auto Ca, W_Disp>>Pending Auto N) DIR3(16, ((*(int *)(CA)) - (PENDINGAUTOCA)), (int)((((unsigned int)(W->DISP)) >> (PENDINGAUTON)))); // 520 Forget(Pa) FORGET(PA); // 521 Drop(W) DROP(W); // 522 Load Safely(V, R) LOADSAFELY(V, R); // 523 %return /* Remove %on %event handler here if present for this block */ return; // 524 %finish L_0126:; // 525 %finish L_0125:; // 526 // 527 %if V_Type = Shorts %and (Oper = ANDx %or Oper = BICx) %and Iconst(W) %start if (((V->TYPE) != (2))) goto L_0128; if (((OPER) == (9))) goto L_0129; if (((OPER) != (12))) goto L_0128; L_0129:; if (!(ICONST(W))) goto L_0128; // 528 N = W_Disp N = W->DISP; // 529 N = \N %if Oper = BICx if (((OPER) != (12))) goto L_012a; N = (~(N)); L_012a:; // 530 %if N>>16 = 0 %start if ((((int)((((unsigned int)(N)) >> (16)))) != (0))) goto L_012b; // 531 Release and Drop(W) RELEASEANDDROP(W); // 532 %if N <= 255 %start if (((N) > (255))) goto L_012c; // 533 Advance(V, Bytes, 0) {low byte} ADVANCE(V, 4, 0); // 534 Operate(ANDx, V, Literal(N)) %if N # 255 if (((N) == (255))) goto L_012d; OPERATE(9, V, LITERAL(N)); L_012d:; // 535 Load(V, R) LOAD(V, R); // 536 %else %if N&255 = 0 goto L_012e; L_012c:; if (((((N) & (255))) != (0))) goto L_012f; // 537 V_Oper = 0; V_Link = 0 V->OPER = 0; *V->LINK = (STACKFM){ 0 } /* Assign 0's to all fields of record */; // 538 Advance(V, Bytes, 1) {high byte} ADVANCE(V, 4, 1); // 539 Operate(ANDx, V, Literal(N>>8)) %if N>>8 # 255 if ((((int)((((unsigned int)(N)) >> (8)))) == (255))) goto L_0130; OPERATE(9, V, LITERAL((int)((((unsigned int)(N)) >> (8))))); L_0130:; // 540 Operate(LSHx, V, Literal(8)) OPERATE(14, V, LITERAL(8)); // 541 Load(V, R) LOAD(V, R); // 542 %else goto L_012e; L_012f:; // 543 B == Copy(V); Advance(B, Bytes, 1) {high byte} B = COPY(V); ADVANCE(B, 4, 1); // 544 Operate(ANDx, B, Literal(N>>8)) %if N>>8 # 255 if ((((int)((((unsigned int)(N)) >> (8)))) == (255))) goto L_0131; OPERATE(9, B, LITERAL((int)((((unsigned int)(N)) >> (8))))); L_0131:; // 545 Advance(V, Bytes, 0) {low byte} ADVANCE(V, 4, 0); // 546 Operate(ANDx, V, Literal(N&255)) %if N&255 # 255 if (((((N) & (255))) == (255))) goto L_0132; OPERATE(9, V, LITERAL(((N) & (255)))); L_0132:; // 547 {be careful to load [b+1] before [b+0] to leave} // 548 {the possibility of auto increment} // 549 Loadup(B); Load Safely(V, R) LOADUP(B); LOADSAFELY(V, R); // 550 Loadup(B); Load Safely(V, R) {in case of hazard} LOADUP(B); LOADSAFELY(V, R); // 551 Plant1(ORR, V_Base, V_Base, Ishift(B_Base, 8, Logical Left)) PLANT1(25165824, V->BASE, V->BASE, ISHIFT(B->BASE, 8, 0)); // 552 Release and Drop(B) RELEASEANDDROP(B); // 553 %finish L_012e:; // 554 %return /* Remove %on %event handler here if present for this block */ return; // 555 %finish L_012b:; // 556 %finish L_0128:; // 557 // 558 Load Safely(V, R); R = V_Base LOADSAFELY(V, R); R = V->BASE; // 559 %if W ## NIL %start if (((W) == (NIL))) goto L_0133; // 560 %if Iconst(W) %start if (!(ICONST(W))) goto L_0134; // 561 %if Oper = EXTx %start if (((OPER) != (21))) goto L_0135; // 562 Plant1(MOV, 0, R, Ishift(V_Base, W_Disp&16_FFFF, Logical Right)) PLANT1(27262976, 0, R, ISHIFT(V->BASE, ((W->DISP) & (65535)), 32)); // 563 N = (-1)<<(W_Disp>>16) N = (((-1)) << ((int)((((unsigned int)(W->DISP)) >> (16))))); // 564 Plant1(AND, R, R, Immediate(\N)) PLANT1(0, R, R, IMMEDIATE((~(N)))); // 565 ->OK goto U_1001; // 566 %finish L_0135:; // 567 %if Oper = ANDx %and Immediate(W_Disp) < 0 %start if (((OPER) != (9))) goto L_0136; if (((IMMEDIATE(W->DISP)) >= (0))) goto L_0136; // 568 Oper = BICx; W_Disp = \W_Disp OPER = 12; W->DISP = (~(W->DISP)); // 569 %finish L_0136:; // 570 Characterise Constant(W_Disp, Cx) CHARACTERISECONSTANT(W->DISP, &CX); // 571 %if Cx_Type = Const Mone %start if (((CX.TYPE) != (2))) goto L_0137; // 572 Plant1(SUB, V_Base, R, Rot(1, 0)) %and ->OK %if Oper = ADDx if (((OPER) != (4))) goto L_0138; PLANT1(4194304, V->BASE, R, ROT(1, 0)); goto U_1001; L_0138:; // 573 Plant1(ADD, V_Base, R, Rot(1, 0)) %and ->OK %if Oper = SUBx if (((OPER) != (5))) goto L_0139; PLANT1(8388608, V->BASE, R, ROT(1, 0)); goto U_1001; L_0139:; // 574 Plant1(MVN, 0, R, Just(V_Base)) %and ->OK %if Oper = XORx if (((OPER) != (11))) goto L_013a; PLANT1(31457280, 0, R, JUST(V->BASE)); goto U_1001; L_013a:; // 575 %else %if Cx_Type = Const Rot goto L_013b; L_0137:; if (((CX.TYPE) != (3))) goto L_013c; // 576 ->C2(Oper) sw2_C2_idx = OPER; if ((1 <= sw2_C2_idx) && (sw2_C2_idx <= 29)) goto *(sw2_C2-1)[sw2_C2_idx]; /* Bounds=1:29 */ else { /*_imp_signal(8, 2, sw2_C2_idx);*/ fprintf(stderr, "%%SWITCH index C2(%d) not in range 1:29 at %s:%d\n", sw2_C2_idx, (_imp_current_file != 0 ? _imp_current_file : __FILE__), (_imp_current_line != 0 ? _imp_current_line : __LINE__)); exit(1); } // 577 // 578 C2(ADDx): Op = ADD; ->C2OK sw2_C2_4:; OP = 8388608; goto U_1003; // 579 C2(SUBx): Op = SUB; ->C2OK sw2_C2_5:; OP = 4194304; goto U_1003; // 580 C2(BICx): Op = BIC; ->C2OK sw2_C2_12:; OP = 29360128; goto U_1003; // 581 C2( ORx): Op = ORR; ->C2OK sw2_C2_10:; OP = 25165824; goto U_1003; // 582 C2(XORx): Op = EOR; ->C2OK sw2_C2_11:; OP = 2097152; goto U_1003; // 583 C2(ANDx): Op = AND %and ->C2OK %if Cx_V2 = 0 sw2_C2_9:; if (((CX.V2) != (0))) goto L_013d; OP = 0; goto U_1003; L_013d:; // 584 ->Hard goto U_1004; // 585 // 586 C2OK: Plant1(Op, V_Base, R, Rot(Cx_V1, Cx_R1)) U_1003:; PLANT1(OP, V->BASE, R, ROT(CX.V1, CX.R1)); // 587 Plant1(Op, R, R, Rot(Cx_V2, Cx_R2)) %if Cx_V2 # 0 if (((CX.V2) == (0))) goto L_013e; PLANT1(OP, R, R, ROT(CX.V2, CX.R2)); L_013e:; // 588 ->OK goto U_1001; // 589 // 590 C2(LSHx): Warn(1, "Dubious shift") %if W_Disp>>5 # 0 sw2_C2_14:; if ((((int)((((unsigned int)(W->DISP)) >> (5)))) == (0))) goto L_013f; WARN(1, _imp_str_literal("Dubious shift")); L_013f:; // 591 Plant1(MOV, 0, R, Ishift(V_Base, W_Disp&31, Logical Left)); ->OK PLANT1(27262976, 0, R, ISHIFT(V->BASE, ((W->DISP) & (31)), 0)); goto U_1001; // 592 C2(RSHx): Warn(1, "Dubious shift") %if W_Disp>>5 # 0 sw2_C2_15:; if ((((int)((((unsigned int)(W->DISP)) >> (5)))) == (0))) goto L_0140; WARN(1, _imp_str_literal("Dubious shift")); L_0140:; // 593 Plant1(MOV, 0, R, Ishift(V_Base, W_Disp&31, Logical Right)); ->OK PLANT1(27262976, 0, R, ISHIFT(V->BASE, ((W->DISP) & (31)), 32)); goto U_1001; // 594 %else %if Cx_Type = Const Not Rot L_013c:; if (((CX.TYPE) != (4))) goto L_0141; // 595 Characterise Constant(-W_Disp, Cx) CHARACTERISECONSTANT((-(W->DISP)), &CX); // 596 ->Hard %unless Cx_Type = Const Rot if (((CX.TYPE) == (3))) goto L_0142; goto U_1004; L_0142:; // 597 Op = SUB %and ->C2OK %if Oper = ADDx if (((OPER) != (4))) goto L_0143; OP = 4194304; goto U_1003; L_0143:; // 598 Op = ADD %and ->C2OK %if Oper = SUBx if (((OPER) != (5))) goto L_0144; OP = 8388608; goto U_1003; L_0144:; // 599 Warn(1, "Dubious shift") %if Oper = RSHx %or Oper = LSHx if (((OPER) == (15))) goto L_0145; if (((OPER) != (14))) goto L_0146; L_0145:; WARN(1, _imp_str_literal("Dubious shift")); L_0146:; // 600 %finish L_0141:; L_013b:; // 601 %finish L_0134:; // 602 %finish L_0133:; // 603 // 604 Hard: U_1004:; // 605 C2(*): sw2_C2_default:; // 606 // 607 Loadup(W) %unless W == NIL if (((W) == (NIL))) goto L_0147; LOADUP(W); L_0147:; // 608 ->C(Oper) sw1_C_idx = OPER; if ((1 <= sw1_C_idx) && (sw1_C_idx <= 29)) goto *(sw1_C-1)[sw1_C_idx]; /* Bounds=1:29 */ else { /*_imp_signal(8, 2, sw1_C_idx);*/ fprintf(stderr, "%%SWITCH index C(%d) not in range 1:29 at %s:%d\n", sw1_C_idx, (_imp_current_file != 0 ? _imp_current_file : __FILE__), (_imp_current_line != 0 ? _imp_current_line : __LINE__)); exit(1); } // 609 // 610 C(NOTx): Plant1(MVN, 0, R, Just(V_Base)); ->OUT sw1_C_1:; PLANT1(31457280, 0, R, JUST(V->BASE)); goto U_1005; // 611 C(NEGx): Plant1(RSB, V_Base, R, Nothing); ->OUT sw1_C_2:; PLANT1(6291456, V->BASE, R, NOTHING()); goto U_1005; // 612 C(ABSx): Plant1(ADD!Scc, R, R, Nothing) {set CC} {SCR/87/422} sw1_C_3:; PLANT1(((8388608) | (1048576)), R, R, NOTHING()); // 613 %begin void _BLOCK_1_LEVEL_3_(void) { // 614 %integer Label int LABEL; // 615 Label = New Label LABEL = NEWLABEL(); // 616 Jump To(Label, GE) JUMPTO(LABEL, 5); // 617 Plant1(RSB, R, R, Nothing) PLANT1(6291456, R, R, NOTHING()); // 618 Define Label(Label) DEFINELABEL(LABEL); // 619 %end return; } // End of block _BLOCK_1_LEVEL_3_ at level 4 _BLOCK_1_LEVEL_3_(); // 620 ->OUT goto U_1005; // 621 // 622 C(ADDx): Plant1(ADD, V_Base, R, Just(W_Base)); ->OK sw1_C_4:; PLANT1(8388608, V->BASE, R, JUST(W->BASE)); goto U_1001; // 623 C(SUBx): Plant1(SUB, V_Base, R, Just(W_Base)); ->OK sw1_C_5:; PLANT1(4194304, V->BASE, R, JUST(W->BASE)); goto U_1001; // 624 C(BICx): Plant1(BIC, V_Base, R, Just(W_Base)); ->OK sw1_C_12:; PLANT1(29360128, V->BASE, R, JUST(W->BASE)); goto U_1001; // 625 C(ANDx): Plant1(AND, V_Base, R, Just(W_Base)); ->OK sw1_C_9:; PLANT1(0, V->BASE, R, JUST(W->BASE)); goto U_1001; // 626 C( ORx): Plant1(ORR, V_Base, R, Just(W_Base)); ->OK sw1_C_10:; PLANT1(25165824, V->BASE, R, JUST(W->BASE)); goto U_1001; // 627 C(XORx): Plant1(EOR, V_Base, R, Just(W_Base)); ->OK sw1_C_11:; PLANT1(2097152, V->BASE, R, JUST(W->BASE)); goto U_1001; // 628 C(LSHx): Plant1(MOV, 0, R, Rshift(V_Base, W_Base, Logical Left R)); ->OK sw1_C_14:; PLANT1(27262976, 0, R, RSHIFT(V->BASE, W->BASE, 144)); goto U_1001; // 629 C(RSHx): Plant1(MOV, 0, R, Rshift(V_Base, W_Base, Logical Right R)); ->OK sw1_C_15:; PLANT1(27262976, 0, R, RSHIFT(V->BASE, W->BASE, 176)); goto U_1001; // 630 // 631 C(*): Not in Yet sw1_C_default:; NOTINYET(); // 632 // 633 OK: Release and Drop(W) %if W ## NIL U_1001:; if (((W) == (NIL))) goto L_0148; RELEASEANDDROP(W); L_0148:; // 634 OUT: U_1005:; // 635 %end /* Remove %on %event handler here if present for this block */ return; sw2_C2_1:; sw2_C2_2:; sw2_C2_3:; sw2_C2_6:; sw2_C2_7:; sw2_C2_8:; sw2_C2_13:; sw2_C2_16:; sw2_C2_17:; sw2_C2_18:; sw2_C2_19:; sw2_C2_20:; sw2_C2_21:; sw2_C2_22:; sw2_C2_23:; sw2_C2_24:; sw2_C2_25:; sw2_C2_26:; sw2_C2_27:; sw2_C2_28:; sw2_C2_29:; goto sw2_C2_default; sw1_C_6:; sw1_C_7:; sw1_C_8:; sw1_C_13:; sw1_C_16:; sw1_C_17:; sw1_C_18:; sw1_C_19:; sw1_C_20:; sw1_C_21:; sw1_C_22:; sw1_C_23:; sw1_C_24:; sw1_C_25:; sw1_C_26:; sw1_C_27:; sw1_C_28:; sw1_C_29:; goto sw1_C_default; } // End of block COMPLEXLOAD at level 3 // 636 // 637 %routine Load(%record(Stackfm)%name V, %integer R) void LOAD( STACKFM /*name*/*V, int R ) { // 638 ! Monitor(V, "->Load ".RegId(R)) %if Diag&MonMove # 0 // 639 %if V_Oper = 0 %then Simple Load(V, R) %c if (((V->OPER) != (0))) goto L_0149; SIMPLELOAD(V, R); goto L_014a; L_0149:; COMPLEXLOAD(V, R); L_014a:; // 640 %else Complex Load(V, R) // 641 Monitor(V, "<-Load") %if Diag&MonMove # 0 if (((((DIAG) & (32))) == (0))) goto L_014b; MONITOR(V, _imp_str_literal("<-Load")); L_014b:; // 642 %end /* Remove %on %event handler here if present for this block */ return; } // End of block LOAD at level 3 // 643 // 644 %routine Load Pair(%record(Stackfm)%name A, %integer Ar, void LOADPAIR( STACKFM /*name*/*A, int AR, STACKFM /*name*/*B, int BR ) { // 645 %record(Stackfm)%name B, %integer Br) // 646 %if B_Oper # 0 %or B_Record ## NIL %or B_Index ## NIL %start if (((B->OPER) != (0))) goto L_014c; if (((B->RECORD) != (NIL))) goto L_014c; if (((B->INDEX) == (NIL))) goto L_014d; L_014c:; // 647 Load(B, Br) LOAD(B, BR); // 648 Load(A, Ar) LOAD(A, AR); // 649 Load(B, Br) LOAD(B, BR); // 650 %else goto L_014e; L_014d:; // 651 Load(A, Ar) LOAD(A, AR); // 652 Load(B, Br) LOAD(B, BR); // 653 Load(A, Ar) LOAD(A, AR); // 654 %finish L_014e:; // 655 %end /* Remove %on %event handler here if present for this block */ return; } // End of block LOADPAIR at level 3 // 656 // 657 %routine Load Trio(%record(Stackfm)%name A, %integer Ar, void LOADTRIO( STACKFM /*name*/*A, int AR, STACKFM /*name*/*B, int BR, STACKFM /*name*/*C, int CR ) { // 658 %record(Stackfm)%name B, %integer Br, // 659 %record(Stackfm)%name C, %integer Cr) // 660 %if B_Oper # 0 %or B_Record ## NIL %or B_Index ## NIL %start if (((B->OPER) != (0))) goto L_014f; if (((B->RECORD) != (NIL))) goto L_014f; if (((B->INDEX) == (NIL))) goto L_0150; L_014f:; // 661 Load(B, Br) LOAD(B, BR); // 662 Load Pair(A, Ar, C, Cr) LOADPAIR(A, AR, C, CR); // 663 %else %if C_Oper # 0 %or C_Record ## NIL %or C_Index ## NIL goto L_0151; L_0150:; if (((C->OPER) != (0))) goto L_0152; if (((C->RECORD) != (NIL))) goto L_0152; if (((C->INDEX) == (NIL))) goto L_0153; L_0152:; // 664 Load(C, Br) LOAD(C, BR); // 665 Load Pair(A, Ar, B, Br) LOADPAIR(A, AR, B, BR); // 666 %else goto L_0151; L_0153:; // 667 Load(A, Ar) LOAD(A, AR); // 668 Load Pair(B, Br, C, Cr) LOADPAIR(B, BR, C, CR); // 669 %finish L_0151:; // 670 Load(A, Ar); Load(B, Br); Load(C, Cr) LOAD(A, AR); LOAD(B, BR); LOAD(C, CR); // 671 %end /* Remove %on %event handler here if present for this block */ return; } // End of block LOADTRIO at level 3 // 672 %endoffile // 1324 %include "repeat.inc" /* Procedure parameter. probably no args given yet. */ // 1 %routine Repeat(%routine Body, %record(Stackfm)%name Times, %integer Inc, How) void REPEAT( void BODY(