#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 %routine read ch(%integername ch)
static void READCH(int *CH) {
// 2 read symbol(ch)
_imp_READSYMBOL(CH);
// 3 %end
return;
} /* end of READCH */
// 4
// 5 !#if e(=true)
// 6 !#else(=false)
// 7 {#report ASS11 - DEIMOS version}
// 8 !#fi
// 9 {############################################}
// 10 {# PDP11 I-code Assembler for IMP77 #}
// 11 {# #}
// 12 {# Copyright November 1981 #}
// 13 {# Peter S. Robertson #}
// 14 {# All rights reserved #}
// 15 {# #}
// 16 {############################################}
// 17
// 18 %Constinteger McOps = 118
// 19 %constinteger Absf = 1, Adc = 2, Adcb = 3, Add = 4,
// 20+ Addf = 5, Ash = 6, Ashc = 7, Asl = 8,
// 21+ Aslb = 9, Asr = 10, Asrb = 11, Bcc = 12,
// 22+ Bcs = 13, Beq = 14, Bge = 15, Bgt = 16,
// 23+ Bhi = 17, Bhis = 18, Bic = 19, Bicb = 20,
// 24+ Bis = 21, Bisb = 22, Bit = 23, Bitb = 24,
// 25+ Ble = 25, Blo = 26, Blos = 27, Blt = 28,
// 26+ Bmi = 29, Bne = 30, Bpl = 31, Bpt = 32,
// 27+ Br = 33, Bvc = 34, Bvs = 35, Ccc = 36,
// 28+ Cfcc = 37, Clc = 38, Cln = 39, Clr = 40
// 29 %constinteger Clrb = 41, Clrf = 42, Clv = 43, Clz = 44,
// 30+ Cmp = 45, Cmpb = 46, Cmpf = 47, Com = 48,
// 31+ Comb = 49, Dec = 50, Decb = 51, Div = 52,
// 32+ Divf = 53, Emt = 54, Fadd = 55, Fdiv = 56,
// 33+ Fmul = 57, Fsub = 58, Halt = 59, Inc = 60,
// 34+ Incb = 61, Iot = 62, Jmp = 63, Jsr = 64,
// 35+ Ldb = 65, Ldcfd = 66, Ldcif = 67, Ldf = 68,
// 36+ Ldfps = 69, Mfpd = 70, Mfpi = 71, Modf = 72,
// 37+ Mov = 73, Movb = 74, Mtpd = 75, Mtpi = 76,
// 38+ Mul = 77, Mulf = 78, Neg = 79, Negb = 80
// 39 %constinteger Negf = 81, Nop = 82, Reset = 83, Rol = 84,
// 40+ Rolb = 85, Ror = 86, Rorb = 87, Rti = 88,
// 41+ Rts = 89, Rtt = 90, Sbc = 91, Sbcb = 92,
// 42+ Scc = 93, Sec = 94, Sen = 95, Setd = 96,
// 43+ Setf = 97, Seti = 98, Setl = 99, Sev =100,
// 44+ Sez =101, Sob =102, Spl =103, Stcfd =104,
// 45+ Stcfi =105, Stf =106, Stfps =107, Stst =108,
// 46+ Sub =109, Subf =110, Swab =111, Sxt =112,
// 47+ Trap =113, Tst =114, Tstb =115, Tstf =116,
// 48+ Wait =117, Xor =118
// 49
// 50 %constintegerarray Optable(1:McOps) = %c
const int OPTABLE[118] = {
61824, 2880, 35648, 24576, 62464, 29696, 30208, 3264, 36032, 3200, 35968, 34304, 34560, 768, 1024,
1536, 33280, 34304, 16384, 49152, 20480, 53248, 12288, 45056, 1792, 34560, 33536, 1280, 33024, 512,
32768, 3, 256, 33792, 34048, 175, 61440, 161, 168, 2560, 35328, 61696, 162, 164, 8192,
40960, 63232, 2624, 35392, 2752, 35520, 29184, 63744, 34816, 31232, 31256, 31248, 31240, 0, 2688,
35456, 4, 64, 2048, 0, 65280, 65024, 62720, 61504, 36160, 3392, 62208, 4096, 36864, 36224,
3456, 28672, 61952, 2816, 35584, 61888, 160, 5, 3136, 35904, 3072, 35840, 2, 128, 6,
2944, 35712, 191, 177, 184, 61449, 61441, 61442, 61450, 178, 180, 32256, 152, 64512, 64256,
63488, 61568, 61632, 57344, 62976, 192, 3520, 35072, 3008, 35776, 61760, 1, 30720};
// 51+ 8_170600, {absf} 8_005500, {adc} 8_105500, {adcb} 8_060000, {add}
// 52+ 8_172000, {addf} 8_072000, {ash} 8_073000, {ashc} 8_006300, {asl}
// 53+ 8_106300, {aslb} 8_006200, {asr} 8_106200, {asrb} 8_103000, {bcc}
// 54+ 8_103400, {bcs} 8_001400, {beq} 8_002000, {bge} 8_003000, {bgt}
// 55+ 8_101000, {bhi} 8_103000, {bhis} 8_040000, {bic} 8_140000, {bicb}
// 56+ 8_050000, {bis} 8_150000, {bisb} 8_030000, {bit} 8_130000, {bitb}
// 57+ 8_003400, {ble} 8_103400, {blo} 8_101400, {blos} 8_002400, {blt}
// 58+ 8_100400, {bmi} 8_001000, {bne} 8_100000, {bpl} 8_000003, {bpt}
// 59+ 8_000400, {br} 8_102000, {bvc} 8_102400, {bvs} 8_000257, {ccc}
// 60+ 8_170000, {cfcc} 8_000241, {clc} 8_000250, {cln} 8_005000, {clr}
// 61+ 8_105000, {clrb} 8_170400, {clrf} 8_000242, {clv} 8_000244, {clz}
// 62+ 8_020000, {cmp} 8_120000, {cmpb} 8_173400, {cmpf} 8_005100, {com}
// 63+ 8_105100, {comb} 8_005300, {dec} 8_105300, {decb} 8_071000, {div}
// 64+ 8_174400, {divf} 8_104000, {emt} 8_075000, {fadd} 8_075030, {fdiv}
// 65+ 8_075020, {fmul} 8_075010, {fsub} 8_000000, {halt} 8_005200, {inc}
// 66+ 8_105200, {incb} 8_000004, {iot} 8_000100, {jmp} 8_004000, {jsr}
// 67+ 8_000000, {ldb} 8_177400, {ldcfd} 8_177000, {ldcif} 8_172400, {ldf}
// 68+ 8_170100, {ldfps} 8_106500, {mfpd} 8_006500, {mfpi} 8_171400, {modf}
// 69+ 8_010000, {mov} 8_110000, {movb} 8_106600, {mtpd} 8_006600, {mtpi}
// 70+ 8_070000, {mul} 8_171000, {mulf} 8_005400, {neg} 8_105400, {negb}
// 71+ 8_170700, {negf} 8_000240, {nop} 8_000005, {reset} 8_006100, {rol}
// 72+ 8_106100, {rolb} 8_006000, {ror} 8_106000, {rorb} 8_000002, {rti}
// 73+ 8_000200, {rts} 8_000006, {rtt} 8_005600, {sbc} 8_105600, {sbcb}
// 74+ 8_000277, {scc} 8_000261, {sec} 8_000270, {sen} 8_170011, {setd}
// 75+ 8_170001, {setf} 8_170002, {seti} 8_170012, {setl} 8_000262, {sev}
// 76+ 8_000264, {sez} 8_077000, {sob} 8_000230, {spl} 8_176000, {stcfd}
// 77+ 8_175400, {stcfi} 8_174000, {stf} 8_170200, {stfps} 8_170300, {stst}
// 78+ 8_160000, {sub} 8_173000, {subf} 8_000300, {swab} 8_006700, {sxt}
// 79+ 8_104400, {trap} 8_005700, {tst} 8_105700, {tstb} 8_170500, {tstf}
// 80+ 8_000001, {wait} 8_074000 {xor}
// 81
// 82 %Constbytearray OpType(1:McOps) = %c
const unsigned char OPTYPE[118] = {65, 16, 16, 33, 68, 52, 52, 16, 16, 16, 16, 0, 0, 0, 0, 0, 0, 0, 33, 33,
33, 33, 37, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 16,
16, 65, 0, 0, 37, 37, 69, 16, 16, 16, 16, 52, 68, 0, 0, 0, 0, 0, 0, 16,
16, 0, 16, 0, 180, 196, 196, 196, 0, 0, 0, 68, 161, 161, 0, 0, 52, 68, 16, 16,
65, 0, 0, 16, 16, 16, 16, 0, 0, 0, 16, 16, 0, 0, 0, 0, 0, 0, 0, 0,
0, 56, 0, 65, 65, 65, 0, 0, 33, 68, 16, 16, 0, 17, 17, 69, 0, 49};
// 83+ 2_01000001, {absf} 2_00010000, {adc} 2_00010000, {adcb} 2_00100001, {add}
// 84+ 2_01000100, {addf} 2_00110100, {ash} 2_00110100, {ashc} 2_00010000, {asl}
// 85+ 2_00010000, {aslb} 2_00010000, {asr} 2_00010000, {asrb} 2_00000000, {bcc}
// 86+ 2_00000000, {bcs} 2_00000000, {beq} 2_00000000, {bge} 2_00000000, {bgt}
// 87+ 2_00000000, {bhi} 2_00000000, {bhis} 2_00100001, {bic} 2_00100001, {bicb}
// 88+ 2_00100001, {bis} 2_00100001, {bisb} 2_00100101, {bit} 2_00100101, {bitb}
// 89+ 2_00000000, {ble} 2_00000000, {blo} 2_00000000, {blos} 2_00000000, {blt}
// 90+ 2_00000000, {bmi} 2_00000000, {bne} 2_00000000, {bpl} 2_00000000, {bpt}
// 91+ 2_00000000, {br} 2_00000000, {bvc} 2_00000000, {bvs} 2_00000000, {ccc}
// 92+ 2_00000000, {cfcc} 2_00000000, {clc} 2_00000000, {cln} 2_00010000, {clr}
// 93+ 2_00010000, {clrb} 2_01000001, {clrf} 2_00000000, {clv} 2_00000000, {clz}
// 94+ 2_00100101, {cmp} 2_00100101, {cmpb} 2_01000101, {cmpf} 2_00010000, {com}
// 95+ 2_00010000, {comb} 2_00010000, {dec} 2_00010000, {decb} 2_00110100, {div}
// 96+ 2_01000100, {divf} 2_00000000, {emt} 2_00000000, {fadd} 2_00000000, {fdiv}
// 97+ 2_00000000, {fmul} 2_00000000, {fsub} 2_00000000, {halt} 2_00010000, {inc}
// 98+ 2_00010000, {incb} 2_00000000, {iot} 2_00010000, {jmp} 2_00000000, {jsr}
// 99+ 2_10110100, {ldb} 2_11000100, {ldcfd} 2_11000100, {ldcif} 2_11000100, {ldf}
// 100+ 2_00000000, {ldfps} 2_00000000, {mfpd} 2_00000000, {mfpi} 2_01000100, {modf}
// 101+ 2_10100001, {mov} 2_10100001, {movb} 2_00000000, {mtpd} 2_00000000, {mtpi}
// 102+ 2_00110100, {mul} 2_01000100, {mulf} 2_00010000, {neg} 2_00010000, {negb}
// 103+ 2_01000001, {negf} 2_00000000, {nop} 2_00000000, {reset} 2_00010000, {rol}
// 104+ 2_00010000, {rolb} 2_00010000, {ror} 2_00010000, {rorb} 2_00000000, {rti}
// 105+ 2_00000000, {rts} 2_00000000, {rtt} 2_00010000, {sbc} 2_00010000, {sbcb}
// 106+ 2_00000000, {scc} 2_00000000, {sec} 2_00000000, {sen} 2_00000000, {setd}
// 107+ 2_00000000, {setf} 2_00000000, {seti} 2_00000000, {setl} 2_00000000, {sev}
// 108+ 2_00000000, {sez} 2_00111000, {sob} 2_00000000, {spl} 2_01000001, {stcfd}
// 109+ 2_01000001, {stcfi} 2_01000001, {stf} 2_00000000, {stfps} 2_00000000, {stst}
// 110+ 2_00100001, {sub} 2_01000100, {subf} 2_00010000, {swab} 2_00010000, {sxt}
// 111+ 2_00000000, {trap} 2_00010001, {tst} 2_00010001, {tstb} 2_01000101, {tstf}
// 112+ 2_00000000, {wait} 2_00110001 {xor}
// 113 %Constintegerarray Val1(1:McOps) = %c
const int VAL1[118] = {3219, 3267, 3267, 3268, 3268, 3752, 3752, 3756, 3756, 3762, 3762, 4259, 4275, 4337,
4389, 4404, 4425, 4425, 4451, 4451, 4467, 4467, 4468, 4468, 4549, 4559, 4559, 4564,
4585, 4613, 4684, 4692, 4704, 4867, 4883, 5283, 5379, 5571, 5582, 5586, 5586, 5586,
5590, 5594, 5616, 5616, 5616, 5677, 5677, 6371, 6371, 6518, 6518, 7668, 8292, 8393,
8693, 8885, 10348, 11779, 11779, 11828, 12784, 12978, 14530, 14531, 14531, 14534, 14534, 15632,
15632, 15908, 15926, 15926, 16080, 16080, 16108, 16108, 16615, 16615, 16615, 16944, 20723, 21036,
21036, 21042, 21042, 21193, 21203, 21204, 21635, 21635, 21667, 21731, 21742, 21748, 21748, 21748,
21748, 21750, 21754, 22050, 22092, 22211, 22211, 22214, 22214, 22227, 22242, 22242, 22305, 22356,
23169, 23220, 23220, 23220, 25705, 27186};
// 114+ 8_006223, 8_006303, 8_006303, 8_006304,
// 115+ 8_006304, 8_007250, 8_007250, 8_007254,
// 116+ 8_007254, 8_007262, 8_007262, 8_010243,
// 117+ 8_010263, 8_010361, 8_010445, 8_010464,
// 118+ 8_010511, 8_010511, 8_010543, 8_010543,
// 119+ 8_010563, 8_010563, 8_010564, 8_010564,
// 120+ 8_010705, 8_010717, 8_010717, 8_010724,
// 121+ 8_010751, 8_011005, 8_011114, 8_011124,
// 122+ 8_011140, 8_011403, 8_011423, 8_012243,
// 123+ 8_012403, 8_012703, 8_012716, 8_012722,
// 124+ 8_012722, 8_012722, 8_012726, 8_012732,
// 125+ 8_012760, 8_012760, 8_012760, 8_013055,
// 126+ 8_013055, 8_014343, 8_014343, 8_014566,
// 127+ 8_014566, 8_016764, 8_020144, 8_020311,
// 128+ 8_020765, 8_021265, 8_024154, 8_027003,
// 129+ 8_027003, 8_027064, 8_030760, 8_031262,
// 130+ 8_034302, 8_034303, 8_034303, 8_034306,
// 131+ 8_034306, 8_036420, 8_036420, 8_037044,
// 132+ 8_037066, 8_037066, 8_037320, 8_037320,
// 133+ 8_037354, 8_037354, 8_040347, 8_040347,
// 134+ 8_040347, 8_041060, 8_050363, 8_051054,
// 135+ 8_051054, 8_051062, 8_051062, 8_051311,
// 136+ 8_051323, 8_051324, 8_052203, 8_052203,
// 137+ 8_052243, 8_052343, 8_052356, 8_052364,
// 138+ 8_052364, 8_052364, 8_052364, 8_052366,
// 139+ 8_052372, 8_053042, 8_053114, 8_053303,
// 140+ 8_053303, 8_053306, 8_053306, 8_053323,
// 141+ 8_053342, 8_053342, 8_053441, 8_053524,
// 142+ 8_055201, 8_055264, 8_055264, 8_055264,
// 143+ 8_062151, 8_065062
// 144 %Constintegerarray Val2(1:McOps) = %c
const int VAL2[118] = {2272, 1056, 2144, 1056, 2272, 1056, 2176, 1056, 2144, 1056, 2144, 1056, 1056, 1056, 1056,
1056, 1056, 2688, 1056, 2144, 1056, 2144, 1056, 2144, 1056, 1056, 2688, 1056, 1056, 1056,
1056, 1056, 1056, 1056, 1056, 1056, 2176, 1056, 1056, 1056, 2144, 2272, 1056, 1056, 1056,
2144, 2272, 1056, 2144, 1056, 2144, 1056, 2272, 1056, 2208, 2784, 2464, 2144, 2720, 1056,
2144, 1056, 1056, 1056, 1056, 2308, 2406, 1056, 2643, 2208, 2368, 2272, 1056, 2144, 2208,
2368, 1056, 2272, 1056, 2144, 2272, 1056, 2292, 1056, 2144, 1056, 2144, 1056, 1056, 1056,
1056, 2144, 1056, 1056, 1056, 2208, 2272, 2368, 2464, 1056, 1056, 1056, 1056, 2308, 2313,
1056, 2643, 2720, 1056, 2272, 2144, 1056, 2592, 1056, 2144, 2272, 2720, 1056};
// 145+ 8_004340, 8_002040, 8_004140, 8_002040,
// 146+ 8_004340, 8_002040, 8_004200, 8_002040,
// 147+ 8_004140, 8_002040, 8_004140, 8_002040,
// 148+ 8_002040, 8_002040, 8_002040, 8_002040,
// 149+ 8_002040, 8_005200, 8_002040, 8_004140,
// 150+ 8_002040, 8_004140, 8_002040, 8_004140,
// 151+ 8_002040, 8_002040, 8_005200, 8_002040,
// 152+ 8_002040, 8_002040, 8_002040, 8_002040,
// 153+ 8_002040, 8_002040, 8_002040, 8_002040,
// 154+ 8_004200, 8_002040, 8_002040, 8_002040,
// 155+ 8_004140, 8_004340, 8_002040, 8_002040,
// 156+ 8_002040, 8_004140, 8_004340, 8_002040,
// 157+ 8_004140, 8_002040, 8_004140, 8_002040,
// 158+ 8_004340, 8_002040, 8_004240, 8_005340,
// 159+ 8_004640, 8_004140, 8_005240, 8_002040,
// 160+ 8_004140, 8_002040, 8_002040, 8_002040,
// 161+ 8_002040, 8_004404, 8_004546, 8_002040,
// 162+ 8_005123, 8_004240, 8_004500, 8_004340,
// 163+ 8_002040, 8_004140, 8_004240, 8_004500,
// 164+ 8_002040, 8_004340, 8_002040, 8_004140,
// 165+ 8_004340, 8_002040, 8_004364, 8_002040,
// 166+ 8_004140, 8_002040, 8_004140, 8_002040,
// 167+ 8_002040, 8_002040, 8_002040, 8_004140,
// 168+ 8_002040, 8_002040, 8_002040, 8_004240,
// 169+ 8_004340, 8_004500, 8_004640, 8_002040,
// 170+ 8_002040, 8_002040, 8_002040, 8_004404,
// 171+ 8_004411, 8_002040, 8_005123, 8_005240,
// 172+ 8_002040, 8_004340, 8_004140, 8_002040,
// 173+ 8_005040, 8_002040, 8_004140, 8_004340,
// 174+ 8_005240, 8_002040
// 175 %Constbytearray Mc Type(1:McOps) =
const unsigned char MCTYPE[118] = {1, 1, 1, 2, 3, 7, 7, 1, 1, 1, 1, 8, 8, 8, 8, 8, 8, 8, 2, 2, 2, 2, 2, 2,
8, 8, 8, 8, 8, 8, 8, 0, 136, 8, 8, 0, 0, 0, 0, 1, 1, 1, 0, 0, 2, 2, 3, 1,
1, 1, 1, 7, 3, 5, 9, 9, 9, 9, 128, 1, 1, 0, 129, 7, 0, 3, 3, 3, 1, 1, 1, 3,
2, 2, 1, 1, 7, 3, 1, 1, 3, 0, 0, 1, 1, 1, 1, 128, 137, 128, 1, 1, 0, 0, 0, 0,
0, 0, 0, 0, 0, 6, 9, 3, 3, 3, 1, 1, 2, 3, 1, 1, 5, 1, 1, 1, 0, 7};
// 176+ 1, 1, 1, 2,
// 177+ 3, 7, 7, 1,
// 178+ 1, 1, 1, 8,
// 179+ 8, 8, 8, 8,
// 180+ 8, 8, 2, 2,
// 181+ 2, 2, 2, 2,
// 182+ 8, 8, 8, 8,
// 183+ 8, 8, 8, 0,
// 184+ 136, 8, 8, 0,
// 185+ 0, 0, 0, 1,
// 186+ 1, 1, 0, 0,
// 187+ 2, 2, 3, 1,
// 188+ 1, 1, 1, 7,
// 189+ 3, 5, 9, 9,
// 190+ 9, 9, 128, 1,
// 191+ 1, 0, 129, 7,
// 192+ 0, 3, 3, 3,
// 193+ 1, 1, 1, 3,
// 194+ 2, 2, 1, 1,
// 195+ 7, 3, 1, 1,
// 196+ 3, 0, 0, 1,
// 197+ 1, 1, 1, 128,
// 198+ 137, 128, 1, 1,
// 199+ 0, 0, 0, 0,
// 200+ 0, 0, 0, 0,
// 201+ 0, 6, 9, 3,
// 202+ 3, 3, 1, 1,
// 203+ 2, 3, 1, 1,
// 204+ 5, 1, 1, 1,
// 205+ 0, 7
// 206
// 207 %constinteger Op Mask = 2_0 000 00 11,
// 208+ Type Mask = 2_0 111 00 00,
// 209+ ToReg = 2_1 000 00 00,
// 210+
// 211+ Zero Instruction = 0<<4, {zero operands}
// 212+ Single Instruction = 1<<4, {one operand}
// 213+ Double Instruction = 2<<4, {two operands}
// 214+ Register Instruction = 3<<4, {register+operand}
// 215+ Floating Instruction = 4<<4 {floating register+operand}
// 216
// 217 {User control options}
// 218
// 219 %constinteger Trusted = 1<< 0,
// 220+ No Eis = 1<< 8,
// 221+ Stack Check = 1<< 9,
// 222+ Profiling = 1<<10,
// 223+ Check Jumps = 1<<11
// 224 !#if e(=true)
// 225
// 226 %constinteger Max Stack = 50,
// 227+ Max Vars = 1000,
// 228+ Max Stack Items = 40,
// 229+ Max Knowing = 60,
// 230+ Max Fors = 8,
// 231+ Max Label = 50,
// 232+ Max Nesting = 8
// 233 !#else(=false)
// 234 {}
// 235 { %constinteger Max Stack = 50,}
// 236 { Max Vars = 500,}
// 237 { Max Stack Items = 40,}
// 238 { Max Knowing = 60,}
// 239 { Max Fors = 8,}
// 240 { Max Label = 50,}
// 241 { Max Nesting = 8}
// 242 {}
// 243 %constrecord(*)%name Null == 0
const struct W4 *NULL = 0;
// 244 %externalroutinespec Print ch {%alias "PRINTSYMBOL"} (%integer i)
extern void PRINTCH(int I);
// 245 !#fi
// 246
// 247 {Monitoring control bits}
// 248
// 249 %constinteger MonCode = 1<<0,
// 250+ MonStack = 1<<1,
// 251+ MonReg = 1<<2,
// 252+ MonOperand = 1<<3,
// 253+ MonOperate = 1<<4,
// 254+ MonMove = 1<<5,
// 255+ MonLine = 1<<6,
// 256+ MonOpt = 1<<7,
// 257+ MonCond = 1<<8
// 258
// 259 %begin
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 260
// 261 %constinteger Word Length = 2, {in bytes}
// 262+ Alignment = Word Length-1
// 263
// 264 !#if e(=true)
// 265 !%dynamicroutinespec Decode11(%integer Ca, Op, R, Sp)
// 266 %externalstring(255)%fnspec ItoS {%alias "S#ITOS"} (%integer N); !THE CONLIB SPEC
extern _imp_string255 ITOS(int N);
// 267 !#fi
// 268 %routine Print Octal(%integer N)
void PRINTOCTAL(int N) {
// 269 %integer j
int J;
// 270 Printch((N>>J)&7+'0') %for J = 15,-3,0
// %for J = 15, -3, 0 %cycle
{
J = 18;
L_0001:
if (J == 0) goto L_0002;
J -= 3;
PRINTCH(((unsigned int)N >> J & 7) + 48);
goto L_0001;
}
L_0002:;
// 271 %end
return;
} /* end of PRINTOCTAL */
// 272
// 273
// 274 %constinteger R0 = 1, R1 = 2, R2 = 3, R3 = 4, {work registers}
// 275+ LNB = 5, DS = 6, SP = 7, PC = 8, {dedicated regs}
// 276+ AnyG = 9, {any of R0-R3}
// 277+ F0 = 10, F1 = 11, F2 = 12, F3 = 13, {floating regs}
// 278+ AnyF = 14, {any of F0-F3}
// 279+ Cc Lhs = 15, {condition code}
// 280+ Cc Rhs = 16,
// 281+ Iresult = R2 {fn/map result}
// 282
// 283 %constbytearray Actual(0:AnyF) = 0,
const unsigned char ACTUAL[15] = {0, 0, 1, 2, 3, 4, 5, 6, 7, 255, 0, 1, 2, 3, 255};
// 284+ 0, 1, 2, 3,
// 285+ 4, 5, 6, 7,
// 286+ 255,
// 287+ 0, 1, 2, 3,
// 288+ 255
// 289
// 290 %conststring(3)%array RegId(0:CcRhs) = "",
const _imp_string3 REGID[17] = {
_imp_str_init(""), _imp_str_init("R0 "), _imp_str_init("R1 "), _imp_str_init("R2 "), _imp_str_init("R3 "),
_imp_str_init("LNB"), _imp_str_init("DS"), _imp_str_init("SP "), _imp_str_init("PC "), _imp_str_init("R* "),
_imp_str_init("F0 "), _imp_str_init("F1 "), _imp_str_init("F2 "), _imp_str_init("F3 "), _imp_str_init("F* "),
_imp_str_init("CCl"), _imp_str_init("CCr")};
// 291+ "R0 ", "R1 ", "R2 ", "R3 ",
// 292+ "LNB", "DS", "SP ", "PC ",
// 293+ "R* ",
// 294+ "F0 ", "F1 ", "F2 ", "F3 ",
// 295+ "F* ",
// 296+ "CCl", "CCr"
// 297
// 298
// 299 %constinteger VinR = 0, { Value = Base+Disp }
// 300+ VinS = 1, { Value = Loc(Base+Disp) }
// 301+ Ainc = 2, { Value = (Base)+ }
// 302+ Adec = 3, { Value = -(Base) }
// 303+ VinX = 4, { Value = Loc(Loc(Base+Extra)+Disp) }
// 304+ AinX = 5, { Value = Loc(Loc(Loc(Base+Extra)+Disp)) }
// 305+ Proc = 6 { Procedure, no value }
// 306
// 307 %conststring(4)%array FormId(VinR:Proc) = "VinR", "VinS", "()+", "-()",
const _imp_string4 FORMID[7] = {_imp_str_init("VinR"), _imp_str_init("VinS"), _imp_str_init("()+"),
_imp_str_init("-()"), _imp_str_init("VinX"), _imp_str_init("AinX"),
_imp_str_init("Proc")};
// 308+ "VinX", "AinX", "Proc"
// 309
// 310
// 311 %constinteger Undefined = 0,
// 312+ Integers = 1, {2-byte integers}
// 313+ Bytes = 2, {1-byte unsigned}
// 314+ Reals = 3, {4-byte real}
// 315+ Lreals = 4, {8-byte real}
// 316+ Strings = 5, {unsigned byte + data bytes}
// 317+ Records = 6, {word-aligned for now}
// 318+ Generals = 7, {general type - 3 words}
// 319+ Labels = 8,
// 320+ Alhs = 9
// 321
// 322 %conststring(7)%array TypeId(Undefined:Alhs) = %c
const _imp_string7 TYPEID[10] = {_imp_str_init("Unknown"), _imp_str_init("Integer"), _imp_str_init("Byte "),
_imp_str_init("Real "), _imp_str_init("Lreal "), _imp_str_init("String "),
_imp_str_init("Record "), _imp_str_init("General"), _imp_str_init("Label "),
_imp_str_init("Alhs ")};
// 323+ "Unknown", "Integer", "Byte ", "Real ",
// 324+ "Lreal ", "String ", "Record ", "General", "Label ",
// 325+ "Alhs "
// 326
// 327 %constbytearray Type Code(Undefined:Labels) = 0,1,5,2,8,3,4,0,10
const unsigned char TYPECODE[9] = {0, 1, 5, 2, 8, 3, 4, 0, 10};
// 328
// 329 %constbytearray Clear op(Integers:Lreals) = Clr, Clrb, Clrf, Clrf
const unsigned char CLEAROP[4] = {40, 41, 42, 42};
// 330 %constbytearray Move op(Integers:Lreals) = Mov, Movb, Ldf, Ldf
const unsigned char MOVEOP[4] = {73, 74, 68, 68};
// 331
// 332 %recordformat Opfm(%integer More, Extra, Modereg)
struct OPFM {
union {
struct {
int MORE;
int EXTRA;
int MODEREG;
};
};
};
// 333
// 334 %recordformat Varfm(%byte Type, Form, Base, Flags,
struct VARFM {
union {
struct {
unsigned char TYPE;
unsigned char FORM;
unsigned char BASE;
unsigned char FLAGS;
int DISP;
int AREA;
int EXTRA;
union {
struct {
int FORMAT;
};
struct {
int SCALE;
};
};
};
};
};
// 335+ %integer Disp, Area, Extra,
// 336+ (%integer Format %or %integer Scale))
// 337
// 338 %recordformat Datafm(%record(Varfm) V,
struct DATAFM {
union {
struct {
struct VARFM V;
union {
struct {
int BIAS;
};
struct {
int DOPE;
};
struct {
unsigned char REG;
unsigned char LABEL;
};
};
int OPER;
struct VARFM A;
struct DATAFM *LINK;
};
};
};
// 339+ (%integer Bias %or %integer Dope %c
// 340+ %or %byte Reg, Label),
// 341+ %integer Oper,
// 342+ %record(Varfm) A,
// 343+ %record(Datafm)%name Link)
// 344
// 345 {Note: Link should be Stackfm but IMP80 refuses to allow the}
// 346 { necessary recordformatspec - how convenient!}
// 347
// 348 %recordformat Stackfm( %c
struct STACKFM {
union {
struct {
union {
struct {
union {
struct {
struct VARFM V;
};
struct {
unsigned char TYPE;
unsigned char FORM;
unsigned char BASE;
unsigned char FLAGS;
int DISP;
int AREA;
int EXTRA;
union {
struct {
int FORMAT;
};
struct {
int SCALE;
};
};
};
};
union {
struct {
int BIAS;
};
struct {
int DOPE;
};
struct {
unsigned char REG;
unsigned char LABEL;
};
};
int OPER;
struct VARFM A;
struct STACKFM *LINK;
};
struct {
struct DATAFM DATA;
};
};
struct STACKFM *USING;
struct STACKFM *STACK;
struct STACKFM *PARAMS;
union {
struct {
int PREG;
};
struct {
int CCCA;
};
};
};
};
};
// 349+ ( ( %record(Varfm) V %c
// 350+ %or %byte Type,
// 351+ Form,
// 352+ Base,
// 353+ Flags,
// 354+ %integer Disp,
// 355+ Area,
// 356+ Extra,
// 357+ ( %integer Format %c
// 358+ %or %integer Scale )),
// 359+ ( %integer Bias %c
// 360+ %or %integer Dope %c
// 361+ %or %byte Reg,
// 362+ Label),
// 363+ %integer Oper,
// 364+ %record(Varfm) A,
// 365+ %record(Stackfm)%name Link %c
// 366+ %or %record(Datafm) Data),
// 367+ %record(Stackfm)%name Using,
// 368+ Stack,
// 369+ Params,
// 370+ ( %integer Preg %c
// 371+ %or %integer Cc Ca))
// 372
// 373 {*------*}
// 374 {| Dope |}
// 375 {*---*------*------*---*------*-------*-------*--------*------*}
// 376 {| V | Bias | Oper | A | Link | Using | Stack | Params | Preg |}
// 377 {*---*------*------*---*------*-------*-------*--------*------*}
// 378 {| D A T A | | CcCa |}
// 379 {*----------------------------* *------*}
// 380
// 381
// 382 !#if e(=true)
// 383 {%constrecord(Stackfm)%name Null = 0
// 384 !#fi
// 385 %ownrecord(Stackfm) Cc1, Cc2
static struct STACKFM CC1;
static struct STACKFM CC2;
// 386
// 387 %recordformat EnvFm(%record(Datafm)%name E)
struct ENVFM {
union {
struct {
struct DATAFM *E;
};
};
};
// 388
// 389 %recordformat Forfm(%byte Label, Entry, Reg,
struct FORFM {
union {
struct {
unsigned char LABEL;
unsigned char ENTRY;
unsigned char REG;
struct DATAFM CONTROL;
struct DATAFM FINAL;
};
};
};
// 390+ %record(Datafm) Control, Final)
// 391
// 392 %record(Forfm)%array Fors(0:Max Fors)
struct FORFM FORS[9];
// 393 %owninteger ForP = 0
static int FORP = 0;
// 394
// 395 %ownrecord(Stackfm)%name Stack
static struct STACKFM *STACK;
// 396 %record(Stackfm)%array Stack Item(0:Max Stack Items)
struct STACKFM STACKITEM[41];
// 397 %ownrecord(Stackfm)%name Using,
static struct STACKFM *USING;
static struct STACKFM *DASL;
// 398+ Dasl
// 399
// 400 %recordformat Realfm(%longreal R %or %integer W1, W2, W3, W4)
struct REALFM {
union {
struct {
double R;
};
struct {
int W1;
int W2;
int W3;
int W4;
};
};
};
// 401
// 402 %ownrecord(Realfm) Real Value = 0
static struct REALFM REALVALUE = {0};
// 403 %owninteger Integer Value = 0
static int INTEGERVALUE = 0;
// 404 %ownstring(255) String Value = ""
static _imp_string255 STRINGVALUE = _imp_str_init("");
// 405
// 406 {Flag bits}
// 407
// 408 %constinteger In Work = 1<<0,
// 409+ Array = 1<<1, Simple P = 1<<1,
// 410+ Parameter = 1<<2,
// 411+ Indirect = 1<<3,
// 412+
// 413+ Answer = 1<<4, Hazarded = 1<<4, Awanted = 1<<4,
// 414+ Primitive = 1<<5, Static = 1<<5,
// 415+ Xproc = 1<<6, Arrayname = 1<<6,
// 416+ Closed = 1<<7, Safe Byte = 1<<7
// 417
// 418 {Operand modes}
// 419
// 420 %constinteger Reg = 0<<3,
// 421+ Defer = 1<<3,
// 422+ AutoI = 2<<3, Immediate = AutoI+7,
// 423+ AutoI Defer = 3<<3, Absolute = AutoI Defer+7,
// 424+ AutoD = 4<<3,
// 425+ AutoD Defer = 5<<3,
// 426+ Index = 6<<3, Relative = Index+7,
// 427+ Index Defer = 7<<3, Relative Defer = Index Defer+7
// 428
// 429 {Internal operations}
// 430
// 431 %constinteger Real Shift = 14
// 432
// 433 %constinteger NOTx = 1, {Integer operations}
// 434+ NEGx = 2,
// 435+ ADDx = 3,
// 436+ SUBx = 4,
// 437+ MULx = 5,
// 438+ DIVx = 6,
// 439+ EXPx = 7,
// 440+ ANDx = 8,
// 441+ ORx = 9,
// 442+ XORx = 10,
// 443+ BICx = 11,
// 444+ LSHx = 12,
// 445+ RSHx = 13,
// 446+ REMx = 14,
// 447+ CONCx = 15,
// 448+
// 449+ RNEGx = NEGx+Real Shift, {floating-point operations}
// 450+ RADDx = ADDx+Real Shift,
// 451+ RSUBx = SUBx+Real Shift,
// 452+ RMULx = MULx+Real Shift,
// 453+ RDIVx = DIVx+Real Shift,
// 454+ REXPx = EXPx+Real Shift
// 455
// 456
// 457 %conststring(4)%array OperId(NOTx:REXPx) = %c
const _imp_string4 OPERID[21] = {
_imp_str_init("not "), _imp_str_init("neg "), _imp_str_init("add "), _imp_str_init("sub "), _imp_str_init("mul "),
_imp_str_init("div "), _imp_str_init("exp "), _imp_str_init("and "), _imp_str_init("or "), _imp_str_init("xor "),
_imp_str_init("bic "), _imp_str_init("lsh "), _imp_str_init("rsh "), _imp_str_init("rem "), _imp_str_init("conc"),
_imp_str_init("negr"), _imp_str_init("addr"), _imp_str_init("subr"), _imp_str_init("mulr"), _imp_str_init("divr"),
_imp_str_init("expr")};
// 458+ "not ", "neg ", "add ", "sub ", "mul ", "div ", "exp ",
// 459+ "and ", "or ", "xor ", "bic ", "lsh ", "rsh ", "rem ",
// 460+ "conc", "negr", "addr", "subr", "mulr", "divr", "expr"
// 461
// 462 {Oper flags}
// 463
// 464 %constinteger Commutative = 1<<0,
// 465+ InPrim = 1<<1,
// 466+ Easy = 1<<2,
// 467+ Selfop = 1<<3,
// 468+ Byteself = 1<<4,
// 469+ Unary = 1<<5,
// 470+ Incdec = 1<<6,
// 471+ No Assoc = 1<<7,
// 472+ Weak Assoc = 1<<8, Assoc Mask = No Assoc!Weak Assoc,
// 473+ Nullop = 1<<9
// 474
// 475 %ownintegerarray Oper Flags(NOTx:REXPx) = {altered by %Control}
static int OPERFLAGS[21] = {60, 60, 605, 604, 769, 768, 642, 793, 797, 777, 796,
664, 664, 128, 128, 168, 129, 128, 129, 128, 130};
// 476+ {NOTx} Unary!Easy!Selfop!ByteSelf,
// 477+ {NEGx} Unary!Easy!Selfop!ByteSelf,
// 478+ {ADDx} Commutative!Easy!Selfop!Byteself!Nullop!Incdec,
// 479+ {SUBx} Easy!Selfop!Byteself!Nullop!Incdec,
// 480+ {MULx} Commutative!Weak Assoc!Nullop,
// 481+ {DIVx} Weak Assoc!Nullop,
// 482+ {EXPx} InPrim!No Assoc!Nullop,
// 483+ {ANDx} Weak Assoc!Nullop!Selfop!Byteself!Commutative,
// 484+ {ORx} Weak Assoc!Nullop!Selfop!Byteself!Easy!Commutative,
// 485+ {XORx} Weak Assoc!Nullop!Selfop!Commutative,
// 486+ {BICx} Weak Assoc!Nullop!Selfop!Byteself!Easy,
// 487+ {LSHx} No Assoc!Nullop!Selfop!Byteself,
// 488+ {RSHx} No Assoc!Nullop!Selfop!Byteself,
// 489+ {REMx} No Assoc,
// 490+ {CONCx} No Assoc,
// 491+ {RNEGx} No Assoc!Unary!Selfop,
// 492+ {RADDx} No Assoc!Commutative,
// 493+ {RSUBx} No Assoc,
// 494+ {RMULx} No Assoc!Commutative,
// 495+ {RDIVx} No Assoc,
// 496+ {REXPx} No Assoc!Inprim
// 497
// 498 %constintegerarray Null Value(ADDx:RSHx) = %c
const int NULLVALUE[11] = {0, 0, 1, 1, 1, 65535, 0, 0, 0, 0, 0};
// 499+ 0, {ADDx} 0, {SUBx} 1, {MULx}
// 500+ 1, {DIVx} 1, {EXPx} x'FFFF', {ANDx}
// 501+ 0, {ORx} 0, {XORx} 0, {BICx}
// 502+ 0, {LSHx} 0 {RSHx}
// 503
// 504 %constbytearray Inc op(ADDx<<1+Integers:SUBx<<1+Bytes) = Inc, Incb,
const unsigned char INCOP[4] = {60, 61, 50, 51};
// 505+ Dec, Decb
// 506
// 507 %constbytearray Operation(NOTx<<1+Integers:REMx<<1+Bytes) = %c
const unsigned char OPERATION[28] = {48, 49, 79, 80, 4, 0, 109, 0, 0, 0, 0, 0, 0, 0,
19, 20, 21, 22, 0, 0, 19, 20, 0, 0, 0, 0, 0, 0};
// 508+ Com, Comb, {NOTx}
// 509+ Neg, Negb, {NEGx}
// 510+ Add, 0, {ADDx}
// 511+ Sub, 0, {SUBx}
// 512+ 0, 0, {MULx}
// 513+ 0, 0, {DIVx}
// 514+ 0, 0, {EXPx}
// 515+ Bic, Bicb, {ANDx}
// 516+ Bis, Bisb, {ORx}
// 517+ 0, 0, {XORx}
// 518+ Bic, Bicb, {BICx}
// 519+ 0, 0, {LSHx}
// 520+ 0, 0, {RSHx}
// 521+ 0, 0 {REMx}
// 522
// 523 %constbytearray Fop(RADDx:RDIVx) = Addf, Subf, Mulf, Divf
const unsigned char FOP[4] = {5, 110, 78, 53};
// 524
// 525 %constbytearray Unary op(NOTx<<1+Integers: NEGx<<1+Bytes) = Com, Comb,
const unsigned char UNARYOP[4] = {48, 49, 79, 80};
// 526+ Neg, Negb
// 527
// 528 {Condition codes}
// 529
// 530 %constinteger EQ = 1, LT = 2, GT = 4, TT = 8, Always = 7,
// 531+ NE = 6, LE = 3, GE = 5, FF = 9
// 532
// 533 %constbytearray Reverse(EQ:FF) = EQ {EQ}, GT {LT}, GE {LE},
const unsigned char REVERSE[9] = {1, 4, 5, 2, 3, 6, 7, 8, 9};
// 534+ LT {GT}, LE {GE}, NE {NE},
// 535+ Always, TT {TT}, FF {FF}
// 536
// 537
// 538 %constinteger Own = 1, EqualsEquals = 1,
// 539+ Con = 2, Equals = 0,
// 540+ External = 3, Jam = -1,
// 541+ System = 4,
// 542+ Dynamic = 5,
// 543+ Primrt = 6,
// 544+ Permrt = 7
// 545
// 546 {Procedure end codes}
// 547
// 548 %constinteger Routine = 0,
// 549+ True = 1,
// 550+ False = 2,
// 551+ Fn = 3,
// 552+ Map = 4
// 553
// 554 {Perm routines}
// 555
// 556 %constinteger Pr0 = 1<< 8, {preserves R0}
// 557+ Pr1 = 1<< 9, {preserves R1}
// 558+ Pr2 = 1<<10, {preserves R2}
// 559+ Pr3 = 1<<11, {preserves R3}
// 560+ Pall = Pr0+Pr1+Pr2+Pr3 {preserves all registers}
// 561
// 562 %constinteger Signal = 1, {%signal}
// 563+ CheckSp = 2, {stack check}
// 564+ Aset = 3, {set array header}
// 565+ Sw Jump = 4, {switch jump}
// 566+ Intexp = 5, {integer exponentiation}
// 567+ RealExp = 6, {real exponentiation}
// 568+ Smove = 7+Pr2, {string move}
// 569+ Sconc = 8+Pr2, {string concatenation}
// 570+ Scomp = 9, {string comparison}
// 571+ Sjam1 = 10+Pr2, {string jam transfer, length known}
// 572+ Spmove = 11+Pr2, {string parameter move}
// 573+ Sres = 12, {string resolution}
// 574+ Pcall = 13, {procedure parameter entry}
// 575+ Adecl = 14, {1-dim array declaration}
// 576+ Aref = 15, {n-dim array reference}
// 577+ Multi Dec = 17, {n-dim array declaraion}
// 578+ Resflop = 18+Pall, {check for resolution fails}
// 579+ RtMonitor = 19, {invoke run-time monitor}
// 580+ Const Sig = 20, {cheap signal call}
// 581+ Eis Mul = 21, {software multiply}
// 582+ Eis Div = 22, {software divide}
// 583+ Eis Rem = 23, {software remainder}
// 584+ Sjam2 = 24+Pr2, {string jam transfer, length unknown}
// 585+ Getch = 25, {Readsymbol function}
// 586+ ShiftL = 26+Pr0+Pr3,{variable left shift}
// 587+ ShiftR = 27+Pr0+Pr3 {variable right shift}
// 588
// 589 %conststring(9)%array PermId(Signal&255:ShiftR&255) = %c
const _imp_string9 PERMID[27] = {
_imp_str_init("P#SIGNAL"), _imp_str_init("P#CHECKSP"), _imp_str_init("P#ASET"), _imp_str_init("P#SWJUMP"),
_imp_str_init("P#INTEXP"), _imp_str_init("P#REALEXP"), _imp_str_init("P#SMOVE"), _imp_str_init("P#SCONC"),
_imp_str_init("P#SCOMP"), _imp_str_init("P#SJAM1"), _imp_str_init("P#SPMOVE"), _imp_str_init("P#SRES"),
_imp_str_init("P#PCALL"), _imp_str_init("P#ADEC"), _imp_str_init("P#AREF"), _imp_str_init("??????"),
_imp_str_init("P#MULTI"), _imp_str_init("P#RESFLOP"), _imp_str_init("P#MONITOR"), _imp_str_init("P#CONSIG"),
_imp_str_init("P#EISMUL"), _imp_str_init("P#EISDIV"), _imp_str_init("P#EISREM"), _imp_str_init("P#SJAM2"),
_imp_str_init("P#READCH"), _imp_str_init("P#SHIFTL"), _imp_str_init("P#SHIFTR")};
// 590+ { 1} "P#SIGNAL", "P#CHECKSP", "P#ASET",
// 591+ { 4} "P#SWJUMP", "P#INTEXP", "P#REALEXP",
// 592+ { 7} "P#SMOVE", "P#SCONC", "P#SCOMP",
// 593+ {10} "P#SJAM1", "P#SPMOVE", "P#SRES",
// 594+ {13} "P#PCALL", "P#ADEC", "P#AREF",
// 595+ {16} "??????", "P#MULTI", "P#RESFLOP",
// 596+ {19} "P#MONITOR", "P#CONSIG", "P#EISMUL",
// 597+ {22} "P#EISDIV", "P#EISREM", "P#SJAM2",
// 598+ {25} "P#READCH", "P#SHIFTL", "P#SHIFTR"
// 599
// 600 %ownintegerarray Perm Used(Signal&255:ShiftR&255) = 0(*)
static int PERMUSED[27] = {[0 ... 26] = 0};
// 601
// 602 %constintegerarray Perm Op(NOTx:REXPx) = %c
const int PERMOP[21] = {0, 0, 0, 0, 21, 22, 5, 0, 0, 0, 0, 2330, 2331, 23, 0, 0, 0, 9, 0, 0, 6};
// 603+ 0, {NOT} 0, {NEG} 0, {ADD} 0, {SUB}
// 604+ EisMul, {MUL} EisDiv, {DIV} IntExp, {EXP} 0, {AND}
// 605+ 0, {OR} 0, {XOR} 0, {BIC} ShiftL, {LSH}
// 606+ ShiftR, {RSH} EisRem, {REM} 0, {CONC} 0, {RNEG}
// 607+ 0, {RADD} 9, {RSUB} 0, {RMUL} 0, {RDIV}
// 608+ RealExp {REXP}
// 609
// 610 {File data}
// 611 !#if e(=true)
// 612 %constinteger Obj = 2, Dir = 3, Icode = 1
// 613 !#else(=false)
// 614 { %constinteger Obj = 1, Dir = 2, Icode = 1}
// 615 !#fi
// 616 {Object stream} {Directive stream}
// 617
// 618 %constinteger Obj Select = 31, Dir Ujump = 1,
// 619+ Obj End = 33, Dir Cjump = 2,
// 620+ Obj Byte = 34, Dir Return = 4,
// 621+ Obj Dummy = 35, Dir Label = 5,
// 622+ Obj Call = 36, Dir Block = 6,
// 623+ Obj Switch = 37, Dir End = 7,
// 624+ Obj Jump = 38, Dir Spec = 8,
// 625+ Obj Return = 39,
// 626+ Obj Line = 40, Dir Notex = 10,
// 627+ Obj External = 42, Dir Xdef = 12,
// 628+ Obj PcRel = 43, Dir Ddef = 13,
// 629+ Obj Block = 44, Dir Mcused = 14,
// 630+ Obj Label = 45, Dir Section = 15,
// 631+ Obj Word = 46, Dir Entry1 = 16,
// 632+ Obj LNB1 = 47, Dir Entry2 = 17,
// 633+ Obj LNB2 = 48, Dir Slab = 18,
// 634+ Obj Branch = 49, Dir Switch = 19,
// 635+ Obj Sob = 50, {calculated from Obj Branch}
// 636+ Obj Modlab = 51, Dir Call = 20,
// 637+ Obj Entry1 = 52, Dir Prefix1 = 21,
// 638+ Obj Entry2 = 53, Dir Prefix2 = 22,
// 639+ Obj LNB10 = 54
// 640 {also 23,24,25}
// 641
// 642 {Block attributes}
// 643
// 644 %constinteger Attr R1 = 1<< 8, {has a parameter in R1}
// 645+ Attr R2 = 1<< 9, {has a parameter in R2}
// 646+ Attr Inner Uses = 1<<10, {locals are used as globals}
// 647+ Attr Uses Locals = 1<<11, {local stack frame is used}
// 648+ Attr Dynamic = 1<<12 {needs a consistent stack}
// 649
// 650 {Instruction modification}
// 651
// 652 %constinteger No Relocation = -1,
// 653+ Test Single = -Obj LNB1,
// 654+ Test Double = -Obj LNB2,
// 655+ Test One = -Obj LNB10
// 656
// 657
// 658 %constinteger Code Area = 0<<1+0,
// 659+ Constant Area = 1<<1+0,
// 660+ Own Area = 2<<1+0
// 661
// 662 %owninteger Uses Display = 0
static int USESDISPLAY = 0;
// 663
// 664 %owninteger Own Base = 0, {current own area address}
static int OWNBASE = 0;
static int CONSTANTBASE = 0;
static int CURRENTAREA = 0;
static int EXTERNALSPEC;
static int EVENTCOUNT = 0;
// 665+ Constant Base = 0, {current constant area address}
// 666+ Current Area = Code Area, {currently selected area}
// 667+ External Spec,
// 668+ Event Count = 0
// 669
// 670 %ownintegerarray Frame Use(128:128+Max Nesting) = 0(*)
static int FRAMEUSE[9] = {[0 ... 8] = 0};
// 671 %owninteger Fmark = 0
static int FMARK = 0;
// 672
// 673 {Global Variables}
// 674
// 675 %integer J
int J;
// 676 %owninteger Code = 0, {current I-code symbol}
static int CODE = 0;
static int PENDING = 0;
static int PENDINGTAG = 0;
static int LANGUAGEFLAGS = 0;
static int FALIGN = 0;
static int DSBIAS = 0;
// 677+ Pending = 0, {next I-code symbol}
// 678+ Pending Tag = 0, {optimise 0<=N<=...}
// 679+ Language Flags = 0,
// 680+ Falign = 0, {worst internal alignment}
// 681+ Ds Bias = 0 {displacement of DS from true}
// 682
// 683 %owninteger Invert = 0,
static int INVERT = 0;
static int UNSIGNED = 0;
static int FREELABEL;
// 684+ Unsigned = 0,
// 685+ Free Label
// 686
// 687 %constinteger Defined = x'8000',
// 688+ Label Mask = \Defined,
// 689+ Inverted = 1
// 690
// 691 %ownintegerarray Ilabel(1:Max Label) = Defined(*)
static int ILABEL[50] = {[0 ... 49] = 32768};
// 692 %ownrecord(EnvFm)%array Env(1:Max Label) = 0(*)
static struct ENVFM ENV[50] = {[0 ... 49] = 0};
// 693 {should be a Namearray, IMP80 screws it up again}
// 694
// 695 %ownrecord(Datafm) Kasl = 0
static struct DATAFM KASL = {0};
// 696 %ownrecord(Datafm)%name KTail,
static struct DATAFM *KTAIL;
static struct DATAFM *KNOWING;
// 697+ Knowing
// 698
// 699 %ownintegerarray Ktimes(0:Cc Rhs) = 0(*)
static int KTIMES[17] = {[0 ... 16] = 0};
// 700 %record(Datafm)%array Known(0:Max Knowing)
struct DATAFM KNOWN[61];
// 701
// 702 %owninteger Diag = 0,
static int DIAG = 0;
static int CONTROL = 0;
// 703+ Control = 0
// 704
// 705 %ownintegerarray Used(0:Cc Rhs) = 0(*)
static int USED[17] = {[0 ... 16] = 0};
// 706 %ownintegerarray Activity(0:Cc Rhs) = %c
static int ACTIVITY[17] = {-1, 0, 0, 0, 0, -1, -1, -1, -1, -1, 0, 0, 0, 0, -1, 0, 0};
// 707+ {0} -1, {R0} 0, {R1} 0,
// 708+ {R2} 0, {R3} 0, {LNB} -1,
// 709+ {DS} -1, {SP} -1, {PC} -1,
// 710+ {ANYG} -1, {F0} 0, {F1} 0,
// 711+ {F2} 0, {F3} 0, {ANYF} -1,
// 712+ {CCLHS} 0, {CCRHS} 0
// 713 %ownrecord(Stackfm)%array RegV(R0:AnyF)
static struct STACKFM REGV[14];
// 714 %owninteger Active Registers = 0
static int ACTIVEREGISTERS = 0;
// 715
// 716 %ownstring(15) Alias = "",
static _imp_string15 ALIAS = _imp_str_init("");
static _imp_string15 INTERNALID = _imp_str_init("");
static _imp_string15 EXTERNALID = _imp_str_init("");
static _imp_string15 SECTIONID = _imp_str_init("");
// 717+ Internal Id = "",
// 718+ External Id = "",
// 719+ Section Id = ""
// 720
// 721 %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;
static int FPMODE = 0;
// 722+ Vlb, Vub,
// 723+ Ostate,
// 724+ OwnType,
// 725+ OwnForm,
// 726+ OwnExtra,
// 727+ Constant Type,
// 728+ Init Flag = 0,
// 729+ FP Mode = Undefined
// 730
// 731 %record(Varfm)%name DefV
struct VARFM *DEFV;
// 732 %record(Varfm)%array Var(0:Max Vars)
struct VARFM VAR[1001];
// 733 %owninteger Parms
static int PARMS;
// 734 %owninteger Section = 0
static int SECTION = 0;
// 735
// 736
// 737 %routine Put(%integer N)
void PUT(int N) {
// 738 Printch(N&255)
PRINTCH(N & 255);
// 739 Printch(N>>8)
PRINTCH((unsigned int)N >> 8);
// 740 %end
return;
} /* end of PUT */
// 741 %routine Put Text(%string(*)%name S)
void PUTTEXT(_imp_string * S) {
// 742 %integer J, L
int J;
int L;
// 743 L = Length(S)
L = *_imp_LENGTH((_imp_string255 *)/*p*/ S);
// 744 Printch(L)
PRINTCH(L);
// 745 Printch(Charno(S, J)) %for J = 1,1,L
// %for J = 1, 1, L %cycle
{
int _final = L;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, L");
J = 0;
L_0004:
if (J == _final) goto L_0005;
J += 1;
PRINTCH(*_imp_CHARNO((_imp_string255 *)/*p*/ S, J));
goto L_0004;
}
L_0005:;
// 746 %end
return;
} /* end of PUTTEXT */
// 747 %routine Ocode(%integer Item)
void OCODE(int ITEM) {
// 748 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 749 Printch(Item)
PRINTCH(ITEM);
// 750 %end
return;
} /* end of OCODE */
// 751 %routine Dcode(%integer Item)
void DCODE(int ITEM) {
// 752 Select Output(Dir)
_imp_SELECTOUTPUT(3);
// 753 Printch(Item)
PRINTCH(ITEM);
// 754 %end
return;
} /* end of DCODE */
// 755
// 756 !==============================================================================
// 757 %routine Assemble(%record(Varfm)%name Avar,
void ASSEMBLE(struct VARFM * AVAR, int AMODE, int VARS, int LOCAL, int PARAMETERLIST) {
auto int CONST(struct STACKFM * V);
auto int SAME(struct STACKFM * A, struct STACKFM * B);
auto int INREG(struct STACKFM * V);
auto int INSAFEREG(struct STACKFM * V);
auto int INFREEREG(struct STACKFM * V);
auto int FLOATING(struct STACKFM * V);
auto int POWER(int N);
auto int GPR(void);
auto int FPR(void);
auto int ITEMSIZE(int F);
auto int REGISTER(int REG);
auto void CLAIM(int REGISTER);
auto void RELEASE(int REGISTER);
auto void RELEASEANDDROP(struct STACKFM * V);
auto void RELEASEANDCLEAR(struct STACKFM * V);
auto void HAZARD(int REGISTER);
auto void FORGET(int REGISTER);
auto void FORGETDESTINATION(struct STACKFM * V);
auto void FORGETEVERYTHING(void);
auto void REMEMBER(int REGISTER, struct STACKFM *V);
auto void PROMOTE(int REG);
auto void OPTIMISE(struct STACKFM * V, int MODE);
auto void ADDRESS(struct STACKFM * V, int MODE);
auto void REDUCE(struct STACKFM * V);
auto void AMAP(struct STACKFM * V);
auto void VMAP(struct STACKFM * V, int NEWTYPE);
auto void LOAD(struct STACKFM * V, int R);
auto void LOADUP(struct STACKFM * V);
auto void LOADPAIR(struct STACKFM * V1, struct STACKFM * V2);
auto void LOADBASE(struct STACKFM * V);
auto void MOVE(struct STACKFM * FROM, struct STACKFM * TO);
auto void STORE(struct STACKFM * L, struct STACKFM * R);
auto void OPERATE(int OPER, struct STACKFM *LHS, struct STACKFM *RHS);
auto void ARRAYACCESS(void);
auto void COMPARE(struct STACKFM * LEFT, struct STACKFM * RIGHT);
auto int SPAREREGISTER(void);
auto void TESTZERO(struct STACKFM * V);
auto void CLEARVARS(int LIMIT);
auto void DUMPEXTERNAL(int C, struct VARFM *V);
auto int DESCRIPTOR(void);
auto int TEMPORARY(void);
auto void DROP(struct STACKFM * V);
auto int LITERAL(int N);
auto int COPY(struct STACKFM * V);
auto int TAG(void);
auto int FOURBYTES(void);
auto void PERM(int N);
auto void PERMOPERATION(int OPER, struct STACKFM *A, struct STACKFM *B);
auto void PLANT(int OP, int RELOC);
auto void PLANT0(int OP);
auto void PLANT1(int OP, struct STACKFM *V1);
auto void PLANT2(int OP, struct STACKFM *V1, struct STACKFM *V2);
auto void PLANTR(int OP, int REG, struct STACKFM *V);
auto void PLANTF(int OP, int REG, struct STACKFM *V);
auto void SETREAL(struct STACKFM * V);
auto void DUMPREAL(int TYPE);
auto void DUMPTEXT(int MAX);
auto void ASSIGN(int HOW);
// 758+ %integer Amode, Vars, Local, Parameter List)
// 759 !==============================================================================
// 760 {Amode = -16 - Initial call }
// 761 { -2 - Alternate format start}
// 762 { -1 - Recordformat }
// 763 { 0 - Procedure }
// 764 { >0 - Procedure spec }
// 765 !==============================================================================
// 766 {%predicate}
// 767 %integerfnspec Const(%record(Stackfm)%name V)
// 768 {%predicate}
// 769 %integerfnspec Same(%record(Stackfm)%name A, B)
// 770 {%predicate}
// 771 %integerfnspec InReg(%record(Stackfm)%name V)
// 772 {%predicate}
// 773 %integerfnspec In Safe Reg(%record(Stackfm)%name V)
// 774 {%predicate}
// 775 %integerfnspec In Free Reg(%record(Stackfm)%name V)
// 776 {%predicate}
// 777 %integerfnspec Floating(%record(Stackfm)%name V)
// 778 %integerfnspec Power(%integer N)
// 779 %integerfnspec Gpr
// 780 %integerfnspec Fpr
// 781 %integerfnspec Item Size(%integer T)
// 782 {%record(Stackfm)%map}
// 783 %integerfnspec Register(%integer R)
// 784 %routinespec Claim(%integer Register)
// 785 %routinespec Release(%integer Register)
// 786 %routinespec Release and Drop(%record(Stackfm)%name V)
// 787 %routinespec Release and Clear(%record(Stackfm)%name V)
// 788 %routinespec Hazard(%integer Register)
// 789 %routinespec Forget(%integer Register)
// 790 %routinespec Forget Destination(%record(Stackfm)%name V)
// 791 %routinespec Forget Everything
// 792 %routinespec Remember(%integer Register, %record(Stackfm)%name V)
// 793 %routinespec Promote(%integer Reg)
// 794 %routinespec Optimise(%record(Stackfm)%name V, %integer Mode)
// 795
// 796 %routinespec Address(%record(Stackfm)%name V, %integer Mode)
// 797 %routinespec Reduce(%record(Stackfm)%name V)
// 798 %routinespec Amap(%record(Stackfm)%name V)
// 799 %routinespec Vmap(%record(Stackfm)%name V, %integer Type)
// 800 %routinespec Load(%record(Stackfm)%name V, %integer Register)
// 801 %routinespec Loadup(%record(Stackfm)%name V)
// 802 %routinespec Load Pair(%record(Stackfm)%name V1, V2)
// 803 %routinespec Load Base(%record(Stackfm)%name V)
// 804 %routinespec Move(%record(Stackfm)%name From, To)
// 805 %routinespec Store(%record(Stackfm)%name L, R)
// 806 %routinespec Operate(%integer Op, %record(Stackfm)%name L, R)
// 807 %routinespec Array Access
// 808 %routinespec Compare(%record(Stackfm)%name L, R)
// 809 %integerfnspec Spare Register
// 810 %routinespec Test Zero(%record(Stackfm)%name V)
// 811 %routinespec Clear Vars(%integer Limit)
// 812 %routinespec Dump External(%integer C, %record(Varfm)%name V)
// 813
// 814 {%record(Stackfm)%map}
// 815 %integerfnspec Descriptor
// 816 {%record(Stackfm)%map}
// 817 %integerfnspec Temporary
// 818 %routinespec Drop(%record(Stackfm)%name V)
// 819 {%record(Stackfm)%map}
// 820 %integerfnspec Literal(%integer N)
// 821 {%record(Stackfm)%map}
// 822 %integerfnspec Copy(%record(Stackfm)%name V)
// 823
// 824 %integerfnspec Tag
// 825 %integerfnspec Four Bytes
// 826
// 827 %routinespec Perm(%integer N)
// 828 %routinespec Perm Operation(%integer Op, %record(Stackfm)%name A, B)
// 829 %routinespec Plant(%integer Op, Reloc)
// 830 %routinespec Plant0(%integer X)
// 831 %routinespec Plant1(%integer X, %record(Stackfm)%name V1)
// 832 %routinespec Plant2(%integer X, %record(Stackfm)%name V1, V2)
// 833 %routinespec PlantR(%integer X, R, %record(Stackfm)%name V)
// 834 %routinespec PlantF(%integer X, R, %record(Stackfm)%name V)
// 835 %routinespec Set Real(%record(Stackfm)%name V)
// 836 %routinespec Dump Real(%integer Type)
// 837 %routinespec Dump Text(%integer Max)
// 838 %routinespec Assign(%integer How)
// 839 !==============================================================================
// 840
// 841 %owninteger Frame = 0
static int FRAME = 0;
// 842
// 843 %integer Current Line,
int CURRENTLINE;
int BLOCKTYPE;
int CODEBASE;
int UNCONDJUMP;
int ZCA;
int ZREG;
int D;
int N;
int PARAMETERMODE;
int VARBASE;
int FIRSTALT;
int FRAMEBASE;
int OLDFRAME;
int ALTALIGN;
int FRAMEEXTRA;
int MAXFRAME;
// 844+ Block Type,
// 845+ Code Base,
// 846+ Uncond Jump,
// 847+ Z Ca, Z Reg,
// 848+ D,
// 849+ N,
// 850+ Parameter Mode,
// 851+ VarBase,
// 852+ First Alt,
// 853+ Frame Base,
// 854+ Old Frame,
// 855+ Alt Align, {Worst alignment of record alternatives}
// 856+ Frame Extra, {putative padding at front of alternative}
// 857+ Max Frame {largest alternative so far}
// 858
// 859 %integer Parameter Frame,
int PARAMETERFRAME;
int RESULTREG;
int SPSIZE;
int ATTRIBUTES;
int MYMARK;
int OPEN;
int EVENTLABEL;
int EVENTBODY;
int EVENTBITS;
int JLAB;
// 860+ Result Reg,
// 861+ SpSize,
// 862+ Attributes,
// 863+ MyMark,
// 864+ Open,
// 865+ Event Label, Event Body, Event Bits, Jlab
// 866 {***** these are nicer as initialised declarations - SOD IMP80}
// 867
// 868 Current Line = 0
CURRENTLINE = 0;
// 869 Block Type = 0
BLOCKTYPE = 0;
// 870 Code Base = 0
CODEBASE = 0;
// 871 Uncond Jump = -1
UNCONDJUMP = -1;
// 872 Var Base = Vars
VARBASE = VARS;
// 873 First Alt = Parms-1
FIRSTALT = PARMS - 1;
// 874 Parameter Frame = 0
PARAMETERFRAME = 0;
// 875 SpSize = 0
SPSIZE = 0;
// 876 Attributes = 0
ATTRIBUTES = 0;
// 877 Open = Closed {assume in cannot return}
OPEN = 128;
// 878 Event Bits = 0
EVENTBITS = 0;
// 879 Result Reg = Iresult
RESULTREG = 3;
// 880 Result Reg = F0 %if Reals <= Avar_Type <= Lreals %c
{
// Double-sided test on AVAR->TYPE (Part I)
int tmp;
if (3 > (tmp = AVAR->TYPE)) goto L_0006;
// Double-sided test on AVAR->TYPE (Part II)
if (tmp > 4) goto L_0006;
}
if (AVAR->FLAGS & 8 != 0) goto L_0006;
RESULTREG = 10;
L_0006:;
// 881+ %and Avar_Flags&Indirect = 0 {not a real map}
// 882
// 883
// 884 %integername Ca; Ca == Code Base {current Address}
int *CA;
CA = (int *)/*?*/ &CODEBASE;
// 885
// 886 %routine Put with CA(%integer X)
void PUTWITHCA(int X) {
// 887 Put(X)
PUT(X);
// 888 Put(Ca)
PUT(*CA);
// 889 %end
return;
} /* end of PUTWITHCA */
// 890 %routine BD(%integer Base, Disp)
void BD(int BASE, int DISP) {
// 891 Write(Disp, 1)
_imp_WRITE(DISP, 1);
// 892 Printch('(')
PRINTCH(40);
// 893 %if R0 <= Base <= AnyF %start
{
// Double-sided test on BASE (Part I)
int tmp;
if (1 > (tmp = BASE)) goto L_0007;
// Double-sided test on BASE (Part II)
if (tmp > 14) goto L_0007;
}
// 894 Printstring(Regid(Base))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string3) tmp = REGID[BASE] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 895 %finish %else %start
goto L_0008;
L_0007:;
// 896 Printch('L') %and Base = Base-128 %if Base >= 128
if (BASE < 128) goto L_0009;
PRINTCH(76);
BASE = BASE - 128;
L_0009:;
// 897 Write(Base, 0)
_imp_WRITE(BASE, 0);
// 898 %finish
L_0008:;
// 899 Printch(')')
PRINTCH(41);
// 900 %end
return;
} /* end of BD */
// 901 %routine Show(%integer N, %string(15) Text)
void SHOW(int N, _imp_string15 TEXT) {
// 902 %if N # 0 %start
if (N == 0) goto L_000A;
// 903 Space; Printstring(Text)
_imp_SPACE();
_imp_PRINTSTRING(
*({
__typeof__(_imp_string15) tmp = TEXT /*q*/;
(_imp_string255 *)&tmp;
})
);
// 904 Write(n, 1)
_imp_WRITE(N, 1);
// 905 %finish
L_000A:;
// 906 %end
return;
} /* end of SHOW */
// 907 %routine Common(%record(Varfm)%name V, %integer X)
void COMMON(struct VARFM * V, int X) {
// 908 Space; Printstring(Typeid(V_Type))
_imp_SPACE();
_imp_PRINTSTRING(
*({
__typeof__(_imp_string7) tmp = TYPEID[V->TYPE] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 909 Space; Printstring(Formid(V_Form))
_imp_SPACE();
_imp_PRINTSTRING(
*({
__typeof__(_imp_string4) tmp = FORMID[V->FORM] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 910 %if V_Form >= VinX %start
if (V->FORM < 4) goto L_000B;
// 911 BD(V_Base, X)
BD(V->BASE, X);
// 912 %if V_Disp >= 0 %then Printstring("++") %else Printch('-')
if (V->DISP < 0) goto L_000C;
_imp_PRINTSTRING(_imp_str_literal("++"));
goto L_000D;
L_000C:;
PRINTCH(45);
L_000D:;
// 913 Write(V_Disp, 0)
_imp_WRITE(V->DISP, 0);
// 914 %finish %else %start
goto L_000E;
L_000B:;
// 915 BD(V_Base, V_Disp)
BD(V->BASE, V->DISP);
// 916 %finish
L_000E:;
// 917 Show(V_Format, "Fm:")
SHOW(V->FORMAT, _imp_str_literal_size(15, "Fm:"));
// 918 Show(V_Flags, "Fl:")
SHOW(V->FLAGS, _imp_str_literal_size(15, "Fl:"));
// 919 Show(V_Area, "R:")
SHOW(V->AREA, _imp_str_literal_size(15, "R:"));
// 920 %end
return;
} /* end of COMMON */
// 921
// 922 %routine Show Data(%record(Datafm)%name D)
void SHOWDATA(struct DATAFM * D) {
// 923 Common(D_V, D_V_Extra)
COMMON(/*?*/ &D->V, D->V.EXTRA);
// 924 %if D_A_Scale # 0 %start
if (D->A.SCALE == 0) goto L_000F;
// 925 Printstring(" A: ")
_imp_PRINTSTRING(_imp_str_literal(" A: "));
// 926 Common(D_A, 0)
COMMON(/*?*/ &D->A, 0);
// 927 Show(D_Bias, "Bias")
SHOW(D->BIAS, _imp_str_literal_size(15, "Bias"));
// 928 %finish
L_000F:;
// 929 %end
return;
} /* end of SHOWDATA */
// 930 %routine Display(%record(Stackfm)%name V, %integer Bias)
void DISPLAY(struct STACKFM * V, int BIAS) {
// 931 %if V == Null %start
if (_imp_ADDR((void *)(V)) != _imp_ADDR((void *)(NULL))) goto L_0010;
// 932 Printstring("Null"); Newline
_imp_PRINTSTRING(_imp_str_literal("Null"));
_imp_NEWLINE();
// 933 %return
return;
// 934 %finish
L_0010:;
// 935 Show Data(V_Data)
SHOWDATA(/*?*/ &V->DATA);
// 936 newline
_imp_NEWLINE();
// 937 %if V_Oper # 0 %start
if (V->OPER == 0) goto L_0011;
// 938 Spaces(Bias-4); Printstring(Operid(V_Oper))
_imp_SPACES(BIAS - 4);
_imp_PRINTSTRING(
*({
__typeof__(_imp_string4) tmp = OPERID[V->OPER - 1] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 939 Display(V_Link, Bias)
DISPLAY(V->LINK, BIAS);
// 940 %finish
L_0011:;
// 941 %end
return;
} /* end of DISPLAY */
// 942
// 943 %routine Show Reg(%integer R)
void SHOWREG(int R) {
// 944 %integer A
int A;
// 945 A = Activity(R)
A = ACTIVITY[R];
// 946 Printstring(Regid(R))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string3) tmp = REGID[R] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 947 Printstring(" act:")
_imp_PRINTSTRING(_imp_str_literal(" act:"));
// 948 %if A < 0 %then Printch('*') %else Write(A, 0)
if (A >= 0) goto L_0012;
PRINTCH(42);
goto L_0013;
L_0012:;
_imp_WRITE(A, 0);
L_0013:;
// 949 Printstring(" u:"); Print Octal(Used(R))
_imp_PRINTSTRING(_imp_str_literal(" u:"));
PRINTOCTAL(USED[R]);
// 950 Printstring(" k:"); Write(Ktimes(R), 0)
_imp_PRINTSTRING(_imp_str_literal(" k:"));
_imp_WRITE(KTIMES[R], 0);
// 951 Newline
_imp_NEWLINE();
// 952 %end
return;
} /* end of SHOWREG */
// 953
// 954 %routine Monitor Register(%integer R, %string(15) Text)
void MONITORREGISTER(int R, _imp_string15 TEXT) {
// 955 Select Output(0)
_imp_SELECTOUTPUT(0);
// 956 Printstring(Text); Spaces(16-length(Text))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string15) tmp = TEXT /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_SPACES(16 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEXT));
// 957 Show Reg(R)
SHOWREG(R);
// 958 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 959 %end
return;
} /* end of MONITORREGISTER */
// 960
// 961 %routine Monitor(%record(Stackfm)%name V, %string(15) Text)
void MONITOR(struct STACKFM * V, _imp_string15 TEXT) {
// 962 Select Output(0)
_imp_SELECTOUTPUT(0);
// 963 Printstring(Text); spaces(16-length(Text))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string15) tmp = TEXT /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_SPACES(16 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEXT));
// 964 Display(V, 16)
DISPLAY(V, 16);
// 965 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 966 %end
return;
} /* end of MONITOR */
// 967 %routine Mon Regid(%integer R, %string(15) Text)
void MONREGID(int R, _imp_string15 TEXT) {
// 968 Select Output(0)
_imp_SELECTOUTPUT(0);
// 969 Printstring(Regid(R)); Space
_imp_PRINTSTRING(
*({
__typeof__(_imp_string3) tmp = REGID[R] /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_SPACE();
// 970 Printstring(Text)
_imp_PRINTSTRING(
*({
__typeof__(_imp_string15) tmp = TEXT /*q*/;
(_imp_string255 *)&tmp;
})
);
// 971 Newline
_imp_NEWLINE();
// 972 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 973 %end
return;
} /* end of MONREGID */
// 974 %routine Display Knowledge
void DISPLAYKNOWLEDGE(void) {
// 975 %record(Datafm)%name K
struct DATAFM *K;
// 976 Select Output(0)
_imp_SELECTOUTPUT(0);
// 977 K == Knowing
K = (struct DATAFM *)KNOWING;
// 978 %while K ## Null %cycle
L_0014:;
if (_imp_ADDR((void *)(K)) == _imp_ADDR((void *)(NULL))) goto L_0015;
// 979 Printstring(Regid(K_Reg)); Printstring(" = ")
_imp_PRINTSTRING(
*({
__typeof__(_imp_string3) tmp = REGID[K->REG] /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_PRINTSTRING(_imp_str_literal(" = "));
// 980 Show Data(K)
SHOWDATA(K);
// 981 Newline
_imp_NEWLINE();
// 982 K == K_Link
K = (struct DATAFM *)K->LINK;
// 983 %repeat
goto L_0014;
L_0015:;
// 984 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 985 %end
return;
} /* end of DISPLAYKNOWLEDGE */
// 986
// 987 %routine Fail(%string(63) Why)
void FAIL(_imp_string63 WHY) {
// 988 %integer R
int R;
// 989
// 990 %routine Pcode(%integer S)
void PCODE(int S) {
// 991 %if ' ' <= S <= 126 %start
{
// Double-sided test on S (Part I)
int tmp;
if (32 > (tmp = S)) goto L_0016;
// Double-sided test on S (Part II)
if (tmp > 126) goto L_0016;
}
// 992 Printch(''''); Printch(S); Printch('''')
PRINTCH(39);
PRINTCH(S);
PRINTCH(39);
// 993 %finish
L_0016:;
// 994 write(S, 3)
_imp_WRITE(S, 3);
// 995 %end
return;
} /* end of PCODE */
// 996
// 997 Select Output(0)
_imp_SELECTOUTPUT(0);
// 998 Printstring("Pass 2 fails -- "); Printstring(Why)
_imp_PRINTSTRING(_imp_str_literal("Pass 2 fails -- "));
_imp_PRINTSTRING(
*({
__typeof__(_imp_string63) tmp = WHY /*q*/;
(_imp_string255 *)&tmp;
})
);
// 999 Printstring(" at source line "); Write(Current Line, 0); newline
_imp_PRINTSTRING(_imp_str_literal(" at source line "));
_imp_WRITE(CURRENTLINE, 0);
_imp_NEWLINE();
// 1000 Printstring("Code "); Pcode(Code)
_imp_PRINTSTRING(_imp_str_literal("Code "));
PCODE(CODE);
// 1001 Printstring(" Pending "); Pcode(Pending)
_imp_PRINTSTRING(_imp_str_literal(" Pending "));
PCODE(PENDING);
// 1002 Newline
_imp_NEWLINE();
// 1003 Show Reg(R) %for R = R0, 1, F3
// %for R = 1, 1, 13 %cycle
{
R = 0;
L_0017:
if (R == 13) goto L_0018;
R += 1;
SHOWREG(R);
goto L_0017;
}
L_0018:;
// 1004 %while Stack ## Null %cycle
L_0019:;
if (_imp_ADDR((void *)(STACK)) == _imp_ADDR((void *)(NULL))) goto L_001A;
// 1005 Printstring("S:"); Display(Stack, 5)
_imp_PRINTSTRING(_imp_str_literal("S:"));
DISPLAY(STACK, 5);
// 1006 Stack == Stack_Stack
STACK = (struct STACKFM *)STACK->STACK;
// 1007 %repeat
goto L_0019;
L_001A:;
// 1008 %while Using ## Null %cycle
L_001B:;
if (_imp_ADDR((void *)(USING)) == _imp_ADDR((void *)(NULL))) goto L_001C;
// 1009 Printstring("U:"); Display(Using, 5)
_imp_PRINTSTRING(_imp_str_literal("U:"));
DISPLAY(USING, 5);
// 1010 Using == Using_Using
USING = (struct STACKFM *)USING->USING;
// 1011 %repeat
goto L_001B;
L_001C:;
// 1012 Printstring("Ca="); Print Octal(Ca)
_imp_PRINTSTRING(_imp_str_literal("Ca="));
PRINTOCTAL(*CA);
// 1013 Newline
_imp_NEWLINE();
// 1014 %monitor; %stop
/*_imp_monitor(__LINE__, __FILE__, PRETTY_FUNCTION);*/
_imp_stop(0);
// 1015 %end
} /* end of FAIL */
// 1016
// 1017 %routine Warn(%string(63) What)
void WARN(_imp_string63 WHAT) {
// 1018 Select Output(0)
_imp_SELECTOUTPUT(0);
// 1019 Printstring("Warning: "); Printstring(What)
_imp_PRINTSTRING(_imp_str_literal("Warning: "));
_imp_PRINTSTRING(
*({
__typeof__(_imp_string63) tmp = WHAT /*q*/;
(_imp_string255 *)&tmp;
})
);
// 1020 Printstring(" at source line "); Write(Current Line, 0); newline
_imp_PRINTSTRING(_imp_str_literal(" at source line "));
_imp_WRITE(CURRENTLINE, 0);
_imp_NEWLINE();
// 1021 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 1022 %end
return;
} /* end of WARN */
// 1023
// 1024 %routine Set Mode(%integer Type)
void SETMODE(int TYPE) {
// 1025 {Change the mode of the floating-point processor. Fp MODE defines the}
// 1026 {current mode.}
// 1027 %if Fp Mode # Type %start
if (FPMODE == TYPE) goto L_001D;
// 1028 Fp Mode = Type
FPMODE = TYPE;
// 1029 %if Type = Reals %then Plant0(SETF) %else %c
if (TYPE != 3) goto L_001E;
PLANT0(97);
goto L_001F;
L_001E:;
if (TYPE != 4) goto L_0020;
PLANT0(96);
goto L_001F;
L_0020:;
if (TYPE == 0) goto L_0021;
FAIL(_imp_str_literal_size(63, "FP Mode"));
L_0021:;
L_001F:;
// 1030+ %if Type = Lreals %then Plant0(SETD) %else %c
// 1031+ %if Type # Undefined %then Fail("FP Mode")
// 1032 %finish
L_001D:;
// 1033 %end
return;
} /* end of SETMODE */
// 1034 %routine Replace(%record(Stackfm)%name Old, New)
void REPLACE(struct STACKFM * OLD, struct STACKFM * NEW) {
// 1035 Release(Old_Base)
RELEASE(OLD->BASE);
// 1036 Old_Data = New_Data
OLD->DATA = NEW->DATA;
// 1037 Claim(Old_Base)
CLAIM(OLD->BASE);
// 1038 %end
return;
} /* end of REPLACE */
// 1039 %routine Reduce Array(%record(Stackfm)%name V)
void REDUCEARRAY(struct STACKFM * V) {
// 1040 %record(Stackfm) X
struct STACKFM X;
// 1041 %record(Stackfm)%name Z
struct STACKFM *Z;
// 1042 %integer Flags, Type, Bias, Scale, Reloc
int FLAGS;
int TYPE;
int BIAS;
int SCALE;
int RELOC;
// 1043 Monitor(V, "Reduce A") %if Diag&MonOperate # 0
if (DIAG & 16 == 0) goto L_0022;
MONITOR(V, _imp_str_literal_size(15, "Reduce A"));
L_0022:;
// 1044 Flags = V_A_Flags; Type = V_Type
FLAGS = V->A.FLAGS;
TYPE = V->TYPE;
// 1045 Reloc = 0
RELOC = 0;
// 1046 Reloc = V_A_Area %if Flags&Arrayname = 0
if (FLAGS & 64 != 0) goto L_0023;
RELOC = V->A.AREA;
L_0023:;
// 1047 Z == Record(Descriptor)
Z = (struct STACKFM *)_imp_RECORD(DESCRIPTOR());
// 1048 Z_V = V_A {describing A(0)}
Z->V = V->A;
// 1049 %if Reloc # 0 %start
if (RELOC == 0) goto L_0024;
// 1050 %if Z_Form >= VinX %then Reloc = 0 {do it now} %c
if (Z->FORM < 4) goto L_0025;
RELOC = 0;
goto L_0026;
L_0025:;
Z->AREA = 0;
L_0026:;
// 1051+ %else Z_Area = 0 {delay it}
// 1052 %finish
L_0024:;
// 1053 Optimise(V, 0)
OPTIMISE(V, 0);
// 1054 Bias = V_Bias
BIAS = V->BIAS;
// 1055 Scale = V_A_Scale
SCALE = V->A.SCALE;
// 1056 %if Scale # 0 %start
if (SCALE == 0) goto L_0027;
// 1057 X = 0
X = (struct STACKFM){0};
// 1058 X_V = V_V {index}
X.V = V->V;
// 1059 X_Type = V_A_Type
X.TYPE = V->A.TYPE;
// 1060 Operate(MULX, X, Record(Literal(Scale)))
OPERATE(5, /*?*/ &X, _imp_RECORD(LITERAL(SCALE)));
// 1061 Amap(Z) {describing addr(A(0))}
AMAP(Z);
// 1062 %if Z_Oper # 0 %start
if (Z->OPER == 0) goto L_0028;
// 1063 Bias = Bias+Z_Link_Disp
BIAS = BIAS + Z->LINK->DISP;
// 1064 Drop(Z_Link)
DROP(Z->LINK);
// 1065 Z_Link == Null
Z->LINK = (struct STACKFM *)NULL;
// 1066 Z_Oper = 0
Z->OPER = 0;
// 1067 %finish
L_0028:;
// 1068 %if Z_Form = VinR %start
if (Z->FORM != 0) goto L_0029;
// 1069 Bias = Bias+Z_Disp; Z_Disp = 0
BIAS = BIAS + Z->DISP;
Z->DISP = 0;
// 1070 %finish
L_0029:;
// 1071 Operate(ADDX, X, Z) {X is now Addr(A(X))}
OPERATE(3, /*?*/ &X, Z);
// 1072 Loadup(X) %if X_Oper # 0
if (X.OPER == 0) goto L_002A;
LOADUP(/*?*/ &X);
L_002A:;
// 1073 V_A_Type = Alhs
V->A.TYPE = 9;
// 1074 Remember(X_Base, V)
REMEMBER(X.BASE, V);
// 1075 V_Data = X_Data
V->DATA = X.DATA;
// 1076 %finish %else %start
goto L_002B;
L_0027:;
// 1077 V_Type = Integers
V->TYPE = 1;
// 1078 Drop (Z)
DROP(Z);
// 1079 %finish
L_002B:;
// 1080 Z == Record(Literal(Bias)); Z_Area = Reloc
Z = (struct STACKFM *)_imp_RECORD(LITERAL(BIAS));
Z->AREA = RELOC;
// 1081 Operate(ADDx, V, Z) {V_Disp = V_Disp+Bias}
OPERATE(3, V, Z);
// 1082 Vmap(V, Integers) %if Flags&Indirect # 0 {name array}
if (FLAGS & 8 == 0) goto L_002C;
VMAP(V, 1);
L_002C:;
// 1083 Vmap(V, Type)
VMAP(V, TYPE);
// 1084 %end
return;
} /* end of REDUCEARRAY */
// 1085 %routine Address(%record(Stackfm)%name V, %integer Mode)
void ADDRESS(struct STACKFM * V, int MODE) {
// 1086 Monitor(V, "Addr") %if Diag&MonOperand # 0
if (DIAG & 8 == 0) goto L_002D;
MONITOR(V, _imp_str_literal_size(15, "Addr"));
L_002D:;
// 1087 %if V_Oper # 0 %start {must be loaded}
if (V->OPER == 0) goto L_002E;
// 1088 Loadup(V)
LOADUP(V);
// 1089 Fail("LHS") %if Mode = 0
if (MODE != 0) goto L_002F;
FAIL(_imp_str_literal_size(63, "LHS"));
L_002F:;
// 1090 %return
return;
// 1091 %finish
L_002E:;
// 1092 Reduce Array(V) %if V_A_Scale # 0
if (V->A.SCALE == 0) goto L_0030;
REDUCEARRAY(V);
L_0030:;
// 1093 %if V_Form >= VinX %start {must be simplified}
if (V->FORM < 4) goto L_0031;
// 1094 Reduce(V) %unless V_Form = VinX %and V_Disp = 0
if (V->FORM != 4) goto L_0032;
if (V->DISP == 0) goto L_0033;
L_0032:;
REDUCE(V);
L_0033:;
// 1095 %finish
L_0031:;
// 1096 Optimise(V, Mode) {try to improve it}
OPTIMISE(V, MODE);
// 1097 %end
return;
} /* end of ADDRESS */
// 1098 %routine Reduce(%record(Stackfm)%name V)
void REDUCE(struct STACKFM * V) {
// 1099 %record(Stackfm) Temp
struct STACKFM TEMP;
// 1100 Monitor(V, "Reduce") %if Diag&MonOperand # 0
if (DIAG & 8 == 0) goto L_0034;
MONITOR(V, _imp_str_literal_size(15, "Reduce"));
L_0034:;
// 1101 Temp = 0
TEMP = (struct STACKFM){0};
// 1102 Temp_Base = V_Base
TEMP.BASE = V->BASE;
// 1103 Temp_Disp = V_Extra
TEMP.DISP = V->EXTRA;
// 1104 Temp_Type = Integers
TEMP.TYPE = 1;
// 1105 Temp_Form = VinS
TEMP.FORM = 1;
// 1106 %if V_Flags&Hazarded # 0 %start {Hazard hit it}
if (V->FLAGS & 16 == 0) goto L_0035;
// 1107 V_Flags = V_Flags&(\Hazarded)
V->FLAGS = V->FLAGS & (~16);
// 1108 %finish %else %start
goto L_0036;
L_0035:;
// 1109 Temp_Area = V_Area
TEMP.AREA = V->AREA;
// 1110 V_Area = 0
V->AREA = 0;
// 1111 %finish
L_0036:;
// 1112 Load(Temp, AnyG) {pick up the record base}
LOAD(/*?*/ &TEMP, 9);
// 1113 V_Base = Temp_Base; V_Extra = 0
V->BASE = TEMP.BASE;
V->EXTRA = 0;
// 1114 %if V_Form = AinX %start
if (V->FORM != 5) goto L_0037;
// 1115 V_Form = VinX
V->FORM = 4;
// 1116 V_Extra = V_Disp
V->EXTRA = V->DISP;
// 1117 V_Disp = 0
V->DISP = 0;
// 1118 %finish %else %if V_Form = VinX %start
goto L_0038;
L_0037:;
if (V->FORM != 4) goto L_0039;
// 1119 V_Form = VinS
V->FORM = 1;
// 1120 %finish %else %start
goto L_0038;
L_0039:;
// 1121 Fail("Reduce ".FormId(V_Form))
FAIL(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("Reduce "),
(_imp_string *)/*?*/ &FORMID[V->FORM]);
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string63 *)&tmp;
})
);
// 1122 %finish
L_0038:;
// 1123 %end
return;
} /* end of REDUCE */
// 1124 %routine Vmap(%record(Stackfm)%name V, %integer New Type)
void VMAP(struct STACKFM * V, int NEWTYPE) {
// 1125 %record(Stackfm)%name W
struct STACKFM *W;
// 1126 %integer N, R
int N;
int R;
// 1127 N = 0; R = 0
N = 0;
R = 0;
// 1128 Monitor(V, "Vmap") %if Diag&MonOperate # 0
if (DIAG & 16 == 0) goto L_003A;
MONITOR(V, _imp_str_literal_size(15, "Vmap"));
L_003A:;
// 1129 %if V_Oper # 0 %start
if (V->OPER == 0) goto L_003B;
// 1130 W == V_Link
W = (struct STACKFM *)V->LINK;
// 1131 %if V_Oper = ADDx %and W_Form = VinR %start
if (V->OPER != 3) goto L_003C;
if (W->FORM != 0) goto L_003C;
// 1132 {Integer(X+23) or (X+R1) or (X+Addr(Y))}
// 1133 N = W_Disp; W_Disp = 0
N = W->DISP;
W->DISP = 0;
// 1134 R = W_Area; W_Area = 0
R = W->AREA;
W->AREA = 0;
// 1135 %if R # 0 %start
if (R == 0) goto L_003D;
// 1136 V_Oper = 0; V_Link == Null
V->OPER = 0;
V->LINK = (struct STACKFM *)NULL;
// 1137 Loadup(V); V_Area = R
LOADUP(V);
V->AREA = R;
// 1138 V_Oper = ADDx; V_Link == W
V->OPER = 3;
V->LINK = (struct STACKFM *)W;
// 1139 %finish
L_003D:;
// 1140 %if W_Base # 0 %start {add in the register}
if (W->BASE == 0) goto L_003E;
// 1141 Loadup(V)
LOADUP(V);
// 1142 %finish %else %start
goto L_003F;
L_003E:;
// 1143 V_Oper = 0; V_Link == Null; Drop(W)
V->OPER = 0;
V->LINK = (struct STACKFM *)NULL;
DROP(W);
// 1144 %finish
L_003F:;
// 1145 %finish %else %start
goto L_0040;
L_003C:;
// 1146 Loadup(V)
LOADUP(V);
// 1147 %finish
L_0040:;
// 1148 %finish
L_003B:;
// 1149 Reduce array(V) %if V_A_Scale # 0
if (V->A.SCALE == 0) goto L_0041;
REDUCEARRAY(V);
L_0041:;
// 1150 Loadup (V) %if V_Type # Integers
if (V->TYPE == 1) goto L_0042;
LOADUP(V);
L_0042:;
// 1151 %if V_Form = VinR %start
if (V->FORM != 0) goto L_0043;
// 1152 V_Form = VinS
V->FORM = 1;
// 1153 V_Disp = V_Disp+N
V->DISP = V->DISP + N;
// 1154 %finish %else %if V_Form = VinS %start
goto L_0044;
L_0043:;
if (V->FORM != 1) goto L_0045;
// 1155 V_Extra = V_Disp
V->EXTRA = V->DISP;
// 1156 V_Disp = N
V->DISP = N;
// 1157 V_Form = VinX
V->FORM = 4;
// 1158 %finish %else %start
goto L_0044;
L_0045:;
// 1159 Reduce(V) %if V_Form = AinX {leaving VinX}
if (V->FORM != 5) goto L_0046;
REDUCE(V);
L_0046:;
// 1160 %if N = 0 %start
if (N != 0) goto L_0047;
// 1161 V_Form = AinX
V->FORM = 5;
// 1162 %finish %else %start
goto L_0048;
L_0047:;
// 1163 Reduce(V)
REDUCE(V);
// 1164 V_Extra = V_Disp
V->EXTRA = V->DISP;
// 1165 V_Disp = N
V->DISP = N;
// 1166 V_Form = VinX
V->FORM = 4;
// 1167 %finish
L_0048:;
// 1168 %finish
L_0044:;
// 1169 V_Flags = Hazarded %if R # 0 %and V_Form # VinS
if (R == 0) goto L_0049;
if (V->FORM == 1) goto L_0049;
V->FLAGS = 16;
L_0049:;
// 1170 V_Type = New Type
V->TYPE = NEWTYPE;
// 1171 %end
return;
} /* end of VMAP */
// 1172 %routine Amap(%record(Stackfm)%name V)
void AMAP(struct STACKFM * V) {
// 1173 Monitor(V, "Amap") %if Diag&MonOperate # 0
if (DIAG & 16 == 0) goto L_004A;
MONITOR(V, _imp_str_literal_size(15, "Amap"));
L_004A:;
// 1174 Reduce Array(V) %if V_A_Scale # 0
if (V->A.SCALE == 0) goto L_004B;
REDUCEARRAY(V);
L_004B:;
// 1175 %if V_Form = VinR %or V_Oper # 0 %start
if (V->FORM == 0) goto L_0003;
if (V->OPER == 0) goto L_004C;
L_0003:;
// 1176 Fail("Amap")
FAIL(_imp_str_literal_size(63, "Amap"));
// 1177 %finish %else %start
L_004C:;
// 1178 V_Type = Integers
V->TYPE = 1;
// 1179 %if V_Form = VinX %start
if (V->FORM != 4) goto L_004D;
// 1180 %if V_Disp # 0 %start
if (V->DISP == 0) goto L_004E;
// 1181 V_Oper = ADDx; V_Link == Record(Literal(V_Disp))
V->OPER = 3;
V->LINK = (struct STACKFM *)_imp_RECORD(LITERAL(V->DISP));
// 1182 %finish
L_004E:;
// 1183 V_Form = VinS
V->FORM = 1;
// 1184 V_Disp = V_Extra; V_Extra = 0
V->DISP = V->EXTRA;
V->EXTRA = 0;
// 1185 %finish %else %if V_Form = VinS %start
goto L_004F;
L_004D:;
if (V->FORM != 1) goto L_0050;
// 1186 V_Form = VinR
V->FORM = 0;
// 1187 %finish %else %if V_Form = AinX %start
goto L_004F;
L_0050:;
if (V->FORM != 5) goto L_0051;
// 1188 V_Form = VinX
V->FORM = 4;
// 1189 %finish {leave Ainc and Adec alone}
L_0051:;
L_004F:;
// 1190 %finish
// 1191 %end
return;
} /* end of AMAP */
// 1192 %routine Process Operand(%record(Stackfm)%name V,
void PROCESSOPERAND(struct STACKFM * V, struct OPFM * D, int MODE, int USE) {
// 1193+ %record(Opfm) %name D, %integer Mode, Use)
// 1194 Monitor(V, "Process") %if Diag&MonOperand # 0
if (DIAG & 8 == 0) goto L_0052;
MONITOR(V, _imp_str_literal_size(15, "Process"));
L_0052:;
// 1195 Address(V, Mode)
ADDRESS(V, MODE);
// 1196 D = 0
*D = (struct OPFM){0};
// 1197 D_More = V_Area
D->MORE = V->AREA;
// 1198 Load Base(V) %if V_Base > Pc
if (V->BASE <= 8) goto L_0053;
LOADBASE(V);
L_0053:;
// 1199 %if V_Form = VinR %start
if (V->FORM != 0) goto L_0054;
// 1200 %if V_Base = 0 %start {constant+relocation}
if (V->BASE != 0) goto L_0055;
// 1201 Fail("LHS") %if Mode = 0
if (MODE != 0) goto L_0056;
FAIL(_imp_str_literal_size(63, "LHS"));
L_0056:;
// 1202 D_Modereg = Immediate
D->MODEREG = 23;
// 1203 D_Extra = V_Disp
D->EXTRA = V->DISP;
// 1204 D_More = No Relocation %if D_More = 0
if (D->MORE != 0) goto L_0057;
D->MORE = -1;
L_0057:;
// 1205 %finish %else %if V_Disp = 0 %and V_Area = 0 %start
goto L_0058;
L_0055:;
if (V->DISP != 0) goto L_0059;
if (V->AREA != 0) goto L_0059;
// 1206 %if V_Base = AnyG %start
if (V->BASE != 9) goto L_005A;
// 1207 V_Base = Gpr
V->BASE = GPR();
// 1208 %finish %else %if V_Base = AnyF %start
goto L_005B;
L_005A:;
if (V->BASE != 14) goto L_005C;
// 1209 V_Base = Fpr
V->BASE = FPR();
// 1210 %finish
L_005C:;
L_005B:;
// 1211 D_Modereg = Reg
D->MODEREG = 0;
// 1212 %finish %else %start {address calculation}
goto L_0058;
L_0059:;
// 1213 V_Link == Record(Register(V_Base))
V->LINK = (struct STACKFM *)_imp_RECORD(REGISTER(V->BASE));
// 1214 V_Oper = ADDx
V->OPER = 3;
// 1215 V_Base = 0
V->BASE = 0;
// 1216 Use = AnyG %if Use = 0; Load(V, Use)
if (USE != 0) goto L_005D;
USE = 9;
L_005D:;
LOAD(V, USE);
// 1217 D_Modereg = Reg
D->MODEREG = 0;
// 1218 D_More = 0
D->MORE = 0;
// 1219 %finish
L_0058:;
// 1220 %finish %else %if V_Form = VinS %start
goto L_005E;
L_0054:;
if (V->FORM != 1) goto L_005F;
// 1221 %if V_Base = 0 %start
if (V->BASE != 0) goto L_0060;
// 1222 D_Modereg = Absolute
D->MODEREG = 31;
// 1223 D_Extra = V_Disp
D->EXTRA = V->DISP;
// 1224 D_More = No Relocation %if D_More = 0
if (D->MORE != 0) goto L_0061;
D->MORE = -1;
L_0061:;
// 1225 %finish %else %if V_Disp = 0 %and V_Area = 0 %start
goto L_0062;
L_0060:;
if (V->DISP != 0) goto L_0063;
if (V->AREA != 0) goto L_0063;
// 1226 D_Modereg = Defer
D->MODEREG = 8;
// 1227 %finish %else %start
goto L_0062;
L_0063:;
// 1228 D_Modereg = Index
D->MODEREG = 48;
// 1229 D_Extra = V_Disp
D->EXTRA = V->DISP;
// 1230 D_More = No Relocation %if D_More = 0
if (D->MORE != 0) goto L_0064;
D->MORE = -1;
L_0064:;
// 1231 %finish
L_0062:;
// 1232 %finish %else %if V_Form = VinX %and V_Disp = 0 %start
goto L_005E;
L_005F:;
if (V->FORM != 4) goto L_0065;
if (V->DISP != 0) goto L_0065;
// 1233 %if V_Base = 0 %start
if (V->BASE != 0) goto L_0066;
// 1234 D_More = D_More!1 {make Pc relative}
D->MORE = D->MORE | 1;
// 1235 D_Modereg = Relative Defer
D->MODEREG = 63;
// 1236 %finish %else %start
goto L_0067;
L_0066:;
// 1237 D_Modereg = IndexDefer
D->MODEREG = 56;
// 1238 %finish
L_0067:;
// 1239 D_Extra = V_Extra
D->EXTRA = V->EXTRA;
// 1240 D_More = No Relocation %if D_More = 0
if (D->MORE != 0) goto L_0068;
D->MORE = -1;
L_0068:;
// 1241 %finish %else %if V_Form = Ainc %or V_Form = Adec %start
goto L_005E;
L_0065:;
if (V->FORM == 2) goto L_0069;
if (V->FORM != 3) goto L_006A;
L_0069:;
// 1242 Fail("Auto") %if V_Disp # 0 %or V_Base = 0 %or V_Area # 0
if (V->DISP != 0) goto L_006B;
if (V->BASE == 0) goto L_006B;
if (V->AREA == 0) goto L_006C;
L_006B:;
FAIL(_imp_str_literal_size(63, "Auto"));
L_006C:;
// 1243 D_Modereg = AutoI
D->MODEREG = 16;
// 1244 D_Modereg = AutoD %if V_Form = Adec
if (V->FORM != 3) goto L_006D;
D->MODEREG = 32;
L_006D:;
// 1245 %finish %else %start
goto L_005E;
L_006A:;
// 1246 Fail("Form")
FAIL(_imp_str_literal_size(63, "Form"));
// 1247 %finish
L_005E:;
// 1248 D_Modereg = D_Modereg+Actual(V_Base)
D->MODEREG = D->MODEREG + ACTUAL[V->BASE];
// 1249 Attributes = Attributes!Attr Uses Locals %if V_Base = LNB
if (V->BASE != 5) goto L_006E;
ATTRIBUTES = ATTRIBUTES | 2048;
L_006E:;
// 1250 Monitor(V, "done") %if Diag&MonOperand # 0
if (DIAG & 8 == 0) goto L_006F;
MONITOR(V, _imp_str_literal_size(15, "done"));
L_006F:;
// 1251 %end
return;
} /* end of PROCESSOPERAND */
// 1252 %routine Cbyte(%integer N)
void CBYTE(int N) {
// 1253 Printch(Obj Byte)
PRINTCH(34);
// 1254 Printch(N&255)
PRINTCH(N & 255);
// 1255 Ca = Ca+1
*CA = *CA + 1;
// 1256 %end
return;
} /* end of CBYTE */
// 1257 %routine Cword(%integer N)
void CWORD(int N) {
// 1258 Plant(N, 0)
PLANT(N, 0);
// 1259 %end
return;
} /* end of CWORD */
// 1260
// 1261 {Area Control}
// 1262
// 1263 %routine Select Area(%integer Area Id, %integername Base)
void SELECTAREA(int AREAID, int *BASE) {
// 1264 Current Area = Area Id
CURRENTAREA = AREAID;
// 1265 Ca == Base
CA = (int *)BASE;
// 1266 Ocode(Obj Select); Put with Ca(Current Area)
OCODE(31);
PUTWITHCA(CURRENTAREA);
// 1267 %end
return;
} /* end of SELECTAREA */
// 1268 %routine Select Code Area
void SELECTCODEAREA(void) {
// 1269 Select Area(Code Area, Code Base)
SELECTAREA(0, /*?*/ &CODEBASE);
// 1270 %end
return;
} /* end of SELECTCODEAREA */
// 1271 %routine Select Constant Area
void SELECTCONSTANTAREA(void) {
// 1272 Select Area(Constant Area, Constant Base)
SELECTAREA(2, /*?*/ &CONSTANTBASE);
// 1273 %end
return;
} /* end of SELECTCONSTANTAREA */
// 1274 %routine Select Own Area
void SELECTOWNAREA(void) {
// 1275 Select Area(Own Area, Own Base)
SELECTAREA(4, /*?*/ &OWNBASE);
// 1276 %end
return;
} /* end of SELECTOWNAREA */
// 1277 %routine Word Align
void WORDALIGN(void) {
// 1278 Cbyte(0) %if Ca&1 # 0
if (*CA & 1 == 0) goto L_0070;
CBYTE(0);
L_0070:;
// 1279 %end
return;
} /* end of WORDALIGN */
// 1280 %routine Plant(%integer Op, Reloc)
void PLANT(int OP, int RELOC) {
// 1281 %integer Code
int CODE;
// 1282 !#if e(=true)
// 1283 %if Diag # 0 %start
if (DIAG == 0) goto L_0071;
// 1284 Select Output(0)
_imp_SELECTOUTPUT(0);
// 1285 !Decode11(Ca, Op, Reloc, 0)
// 1286 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 1287 %finish
L_0071:;
// 1288 !#fi
// 1289 %if Reloc > 0 %start
if (RELOC <= 0) goto L_0072;
// 1290 %if Reloc > Own Area!1 %start
if (RELOC <= 4 | 1) goto L_0073;
// 1291 Dcode(Dir Spec); Put(Reloc)
DCODE(8);
PUT(RELOC);
// 1292 %finish
L_0073:;
// 1293 Ocode(Obj External); Put(Reloc)
OCODE(42);
PUT(RELOC);
// 1294 %finish
L_0072:;
// 1295 Code = Obj Word
CODE = 46;
// 1296 Code = -Reloc %if Reloc < No Relocation {no relocation, but perhaps info}
if (RELOC >= -1) goto L_0074;
CODE = -RELOC;
L_0074:;
// 1297 Printch(Code)
PRINTCH(CODE);
// 1298 Put(Op)
PUT(OP);
// 1299 Ca = Ca+2
*CA = *CA + 2;
// 1300 %end
return;
} /* end of PLANT */
// 1301 %routine Protect(%record(Stackfm)%name V)
void PROTECT(struct STACKFM * V) {
// 1302 %integer R
int R;
// 1303 %if InReg(V)#0 %and Activity(V_Base) > 1 %start
if (INREG(V) == 0) goto L_0075;
if (ACTIVITY[V->BASE] <= 1) goto L_0075;
// 1304 %if V_Base >= F0 %then R = Fpr %else R = Gpr
if (V->BASE < 10) goto L_0076;
R = FPR();
goto L_0077;
L_0076:;
R = GPR();
L_0077:;
// 1305 Load(V, R)
LOAD(V, R);
// 1306 %finish
L_0075:;
// 1307 %end
return;
} /* end of PROTECT */
// 1308 {%predicate}
// 1309 %integerfn Cc Known(%record(Stackfm)%name V)
int CCKNOWN(struct STACKFM * V) {
// 1310 %result=-1 %if Cc1_Cc Ca = Ca %and Same(V, Cc1)#0
if (CC1.CCCA != *CA) goto L_0078;
if (SAME(V, /*?*/ &CC1) == 0) goto L_0078;
return -1;
L_0078:;
// 1311 %result=-1 %if Cc2_Cc Ca = Ca %and Same(V, Cc2)#0
if (CC2.CCCA != *CA) goto L_0079;
if (SAME(V, /*?*/ &CC2) == 0) goto L_0079;
return -1;
L_0079:;
// 1312 %result=0
return 0;
// 1313 %end
} /* end of CCKNOWN */
// 1314 %routine Set CC1(%record(Stackfm)%name V)
void SETCC1(struct STACKFM * V) {
// 1315 Cc1_Data = V_Data
CC1.DATA = V->DATA;
// 1316 Cc1_Cc Ca = Ca
CC1.CCCA = *CA;
// 1317 %end
return;
} /* end of SETCC1 */
// 1318 %routine Plant0(%integer Op)
void PLANT0(int OP) {
// 1319 Fail("Operand") %if OpType(Op)&Type Mask # Zero Instruction
if (OPTYPE[OP - 1] & 112 == 0) goto L_007A;
FAIL(_imp_str_literal_size(63, "Operand"));
L_007A:;
// 1320 Cword(OpTable(Op))
CWORD(OPTABLE[OP - 1]);
// 1321 %end
return;
} /* end of PLANT0 */
// 1322 %routine Process Reals 2(%integer Op, %record(Stackfm)%name V1, V2)
void PROCESSREALS2(int OP, struct STACKFM *V1, struct STACKFM *V2) {
// 1323 %integer Reg, Store, Stop
int REG;
int STORE;
int STOP;
// 1324 Fail("Real op") %unless Op = LDF
if (OP == 68) goto L_007B;
FAIL(_imp_str_literal_size(63, "Real op"));
L_007B:;
// 1325 %if V1_Form = VinR %and V1_Disp = 0 %and V1_Base = 0 %start
if (V1->FORM != 0) goto L_007C;
if (V1->DISP != 0) goto L_007C;
if (V1->BASE != 0) goto L_007C;
// 1326 PlantF(CLRF, 0, V2)
PLANTF(42, 0, V2);
// 1327 %return
return;
// 1328 %finish
L_007C:;
// 1329 %if V2_Form # VinR %start
if (V2->FORM == 0) goto L_007D;
// 1330 Store = 1
STORE = 1;
// 1331 %if InReg(V1)#0 %start
if (INREG(V1) == 0) goto L_007E;
// 1332 Reg = V1_Base
REG = V1->BASE;
// 1333 %finish %else %start
goto L_007F;
L_007E:;
// 1334 Reg = Fpr
REG = FPR();
// 1335 PlantF(LDF, Reg, V1)
PLANTF(68, REG, V1);
// 1336 %finish
L_007F:;
// 1337 %finish %else %start
goto L_0080;
L_007D:;
// 1338 Store = 0
STORE = 0;
// 1339 Reg = V2_Base
REG = V2->BASE;
// 1340 %if Reg = AnyF %start
if (REG != 14) goto L_0081;
// 1341 %return %if InReg(V1)#0
if (INREG(V1) == 0) goto L_0082;
return;
L_0082:;
// 1342 Reg = Fpr
REG = FPR();
// 1343 %finish
L_0081:;
// 1344 PlantF(LDF, Reg, V1)
PLANTF(68, REG, V1);
// 1345 %finish
L_0080:;
// 1346 Release(V1_Base)
RELEASE(V1->BASE);
// 1347 V1_Base = Reg; V1_Form = VinR; V1_Disp = 0
V1->BASE = REG;
V1->FORM = 0;
V1->DISP = 0;
// 1348 Claim(Reg)
CLAIM(REG);
// 1349 Stop = Stf
STOP = 106;
// 1350 Stop = Stcfd %if V2_Type = Reals
if (V2->TYPE != 3) goto L_0083;
STOP = 104;
L_0083:;
// 1351 PlantF(Stop, Reg, V2) %if Store # 0
if (STORE == 0) goto L_0084;
PLANTF(STOP, REG, V2);
L_0084:;
// 1352 %end
return;
} /* end of PROCESSREALS2 */
// 1353 %routine Plant1(%integer Op, %record(Stackfm)%name V1)
void PLANT1(int OP, struct STACKFM *V1) {
// 1354 %record(Opfm) Op1
struct OPFM OP1;
// 1355 %integer T
int T;
// 1356 %record(Stackfm) Hold
struct STACKFM HOLD;
// 1357 %if V1_Type >= Reals %start
if (V1->TYPE < 3) goto L_0085;
// 1358 PlantF(Op, 0, V1)
PLANTF(OP, 0, V1);
// 1359 %return
return;
// 1360 %finish
L_0085:;
// 1361 T = Optype(Op)
T = OPTYPE[OP - 1];
// 1362 Fail("Op") %if T&Type Mask # Single Instruction
if (T & 112 == 16) goto L_0086;
FAIL(_imp_str_literal_size(63, "Op"));
L_0086:;
// 1363
// 1364 Protect(V1) %if T&OpMask = 0
if (T & 3 != 0) goto L_0087;
PROTECT(V1);
L_0087:;
// 1365 Hold_Data = V1_Data
HOLD.DATA = V1->DATA;
// 1366 Process Operand(V1, Op1, T&Op Mask, 0)
PROCESSOPERAND(V1, /*?*/ &OP1, T & 3, 0);
// 1367 Claim(V1_Base) %if Hold_Base = AnyG %or Hold_Base = AnyF
if (HOLD.BASE == 9) goto L_0088;
if (HOLD.BASE != 14) goto L_0089;
L_0088:;
CLAIM(V1->BASE);
L_0089:;
// 1368
// 1369 %if Op = TST %start
if (OP != 114) goto L_008A;
// 1370 ->TZ %if Cc Known(V1)#0
if (CCKNOWN(V1) == 0) goto L_008B;
goto U_1000;
L_008B:;
// 1371 N = Spare Register
N = SPAREREGISTER();
// 1372 %if N # 0 %and V1_Form # VinR %start
if (N == 0) goto L_008C;
if (V1->FORM == 0) goto L_008C;
// 1373 Load(V1, N)
LOAD(V1, N);
// 1374 Remember(N, Hold)
REMEMBER(N, /*?*/ &HOLD);
// 1375 Test Zero(V1)
TESTZERO(V1);
// 1376 ->TZ
goto U_1000;
// 1377 %finish
L_008C:;
// 1378 %finish
L_008A:;
// 1379
// 1380 Plant(OpTable(Op)+Op1_Modereg, Test Single)
PLANT(OPTABLE[OP - 1] + OP1.MODEREG, -47);
// 1381 Plant(Op1_Extra, Op1_More) %if Op1_More # 0
if (OP1.MORE == 0) goto L_008D;
PLANT(OP1.EXTRA, OP1.MORE);
L_008D:;
// 1382
// 1383 %if T&OpMask = 0 %start {destination}
if (T & 3 != 0) goto L_008E;
// 1384 Forget Destination(V1)
FORGETDESTINATION(V1);
// 1385 Forget Destination(Hold)
FORGETDESTINATION(/*?*/ &HOLD);
// 1386 %finish
L_008E:;
// 1387
// 1388 Set CC1(V1)
SETCC1(V1);
// 1389
// 1390 TZ:%if Op = TST %and Op1_ModeReg&8_70 = 0 %start
U_1000:;
if (OP != 114) goto L_008F;
if (OP1.MODEREG & 56 != 0) goto L_008F;
// 1391 Z Ca = Ca
ZCA = *CA;
// 1392 Z Reg = V1_Base
ZREG = V1->BASE;
// 1393 %finish
L_008F:;
// 1394 %end
return;
} /* end of PLANT1 */
// 1395 %routine Plant2(%integer Op, %record(Stackfm)%name V1, V2)
void PLANT2(int OP, struct STACKFM *V1, struct STACKFM *V2) {
// 1396 %record(Opfm) Op1, Op2
struct OPFM OP1;
struct OPFM OP2;
// 1397 %integer T, Wanted
int T;
int WANTED;
// 1398 %record(Stackfm) Hold1, Hold2
struct STACKFM HOLD1;
struct STACKFM HOLD2;
// 1399 %if V2_Type >= Reals %start
if (V2->TYPE < 3) goto L_0090;
// 1400 Process Reals 2(Op, V1, V2)
PROCESSREALS2(OP, V1, V2);
// 1401 %return
return;
// 1402 %finish
L_0090:;
// 1403 T = OpType(Op)
T = OPTYPE[OP - 1];
// 1404 Protect(V2) %if T&(ToReg!OpMask<<2) = 0 {dest modification}
if (T & (128 | 3 << 2) != 0) goto L_0091;
PROTECT(V2);
L_0091:;
// 1405 Wanted = 0
WANTED = 0;
// 1406 Wanted = V2_Base %if T&ToReg # 0 %and V2_Form = VinR
if (T & 128 == 0) goto L_0092;
if (V2->FORM != 0) goto L_0092;
WANTED = V2->BASE;
L_0092:;
// 1407 Fail("Op") %if T&Type Mask # Double Instruction
if (T & 112 == 32) goto L_0093;
FAIL(_imp_str_literal_size(63, "Op"));
L_0093:;
// 1408
// 1409 Hold1 = V1
HOLD1 = *V1;
// 1410 Hold2 = V2 {Beware: V2 can point to ANYG or ANYR so don't alter it}
HOLD2 = *V2;
// 1411 Process Operand(V1, Op1, T&Op Mask, Wanted)
PROCESSOPERAND(V1, /*?*/ &OP1, T & 3, WANTED);
// 1412 %if (V2_Base = AnyG %or V2_Base = AnyF) %and In Reg(V1)#0 %start
if (V2->BASE == 9) goto L_0094;
if (V2->BASE != 14) goto L_0095;
L_0094:;
if (INREG(V1) == 0) goto L_0095;
// 1413 %return %if Activity(V1_Base) >= 0 {don't use dedicated registers}
if (ACTIVITY[V1->BASE] < 0) goto L_0096;
return;
L_0096:;
// 1414 %finish
L_0095:;
// 1415 Process Operand(Hold2, Op2, T&Op Mask<<2, 0)
PROCESSOPERAND(/*?*/ &HOLD2, /*?*/ &OP2, T & 3 << 2, 0);
// 1416 %unless Op1_Modereg = Op2_Modereg %and %c
if (OP1.MODEREG != OP2.MODEREG) goto L_0097;
if (OP1.EXTRA != OP2.EXTRA) goto L_0097;
if (OP1.MORE != OP2.MORE) goto L_0097;
if (OP == 73) goto L_0098;
if (OP == 74) goto L_0098;
L_0097:;
// 1417+ Op1_Extra = Op2_Extra %and %c
// 1418+ Op1_More = Op2_More %and %c
// 1419+ (Op = MOV %or Op = MOVB) %start
// 1420
// 1421 Plant(OpTable(Op)+(Op1_Modereg<<6)+Op2_Modereg, Test Double)
PLANT(OPTABLE[OP - 1] + (OP1.MODEREG << 6) + OP2.MODEREG, -48);
// 1422 Plant(Op1_Extra, Op1_More) %if Op1_More # 0
if (OP1.MORE == 0) goto L_0099;
PLANT(OP1.EXTRA, OP1.MORE);
L_0099:;
// 1423 Plant(Op2_Extra, Op2_More) %if Op2_More # 0
if (OP2.MORE == 0) goto L_009A;
PLANT(OP2.EXTRA, OP2.MORE);
L_009A:;
// 1424
// 1425 %if T&OpMask<<2 = 0 %start {destination}
if (T & 3 << 2 != 0) goto L_009B;
// 1426 Forget Destination(Hold2)
FORGETDESTINATION(/*?*/ &HOLD2);
// 1427 Forget Destination(V2)
FORGETDESTINATION(V2);
// 1428 Set CC1(Hold2)
SETCC1(/*?*/ &HOLD2);
// 1429 %finish
L_009B:;
// 1430 %if T&ToReg # 0 %start
if (T & 128 == 0) goto L_009C;
// 1431 Cc2_Data = V1_Data; Cc2_Cc Ca = Ca
CC2.DATA = V1->DATA;
CC2.CCCA = *CA;
// 1432 Remember(Hold2_Base, Hold1) %if InReg(Hold2)#0
if (INREG(/*?*/ &HOLD2) == 0) goto L_009D;
REMEMBER(HOLD2.BASE, /*?*/ &HOLD1);
L_009D:;
// 1433 %if InReg(V1)#0 %start
if (INREG(V1) == 0) goto L_009E;
// 1434 %if V2_Form = VinR %then Remember(V1_Base, Hold2) %c
if (V2->FORM != 0) goto L_009F;
REMEMBER(V1->BASE, /*?*/ &HOLD2);
goto L_00A0;
L_009F:;
REMEMBER(V1->BASE, V2);
L_00A0:;
// 1435+ %else Remember(V1_Base, V2)
// 1436 %finish
L_009E:;
// 1437 %finish
L_009C:;
// 1438 %finish
L_0098:;
// 1439 %if Wanted # 0 %start {going to a register}
if (WANTED == 0) goto L_00A1;
// 1440 Replace(V1, Hold2)
REPLACE(V1, /*?*/ &HOLD2);
// 1441 %finish %else %start
goto L_00A2;
L_00A1:;
// 1442 V2_Data = Hold2_Data
V2->DATA = HOLD2.DATA;
// 1443 %finish
L_00A2:;
// 1444 %end
return;
} /* end of PLANT2 */
// 1445 %routine PlantR(%integer Op, Reg, %record(Stackfm)%name V)
void PLANTR(int OP, int REG, struct STACKFM *V) {
// 1446 %record(Opfm) Op1
struct OPFM OP1;
// 1447 %record(Stackfm) Hold
struct STACKFM HOLD;
// 1448 %integer T
int T;
// 1449 T = OpType(Op)
T = OPTYPE[OP - 1];
// 1450 Fail("Op") %if T&Type Mask # Register Instruction
if (T & 112 == 48) goto L_00A3;
FAIL(_imp_str_literal_size(63, "Op"));
L_00A3:;
// 1451 Fail("Register") %unless R0 <= Reg <= R3
{
// Double-sided test on REG (Part I)
int tmp;
if (1 > (tmp = REG)) goto L_00A4;
// Double-sided test on REG (Part II)
if (tmp <= 4) goto L_00A5;
}
L_00A4:;
FAIL(_imp_str_literal_size(63, "Register"));
L_00A5:;
// 1452 Protect(V) %if T&OpMask<<2 = 0
if (T & 3 << 2 != 0) goto L_00A6;
PROTECT(V);
L_00A6:;
// 1453 Hold = V
HOLD = *V;
// 1454 Process Operand(V, Op1, T&Op Mask<<2, 0)
PROCESSOPERAND(V, /*?*/ &OP1, T & 3 << 2, 0);
// 1455
// 1456 Plant(OpTable(Op)+(Actual(Reg)<<6)+Op1_Modereg, Test Double)
PLANT(OPTABLE[OP - 1] + (ACTUAL[REG] << 6) + OP1.MODEREG, -48);
// 1457 Plant(Op1_Extra, Op1_More) %if Op1_More # 0
if (OP1.MORE == 0) goto L_00A7;
PLANT(OP1.EXTRA, OP1.MORE);
L_00A7:;
// 1458
// 1459 %if T&OpMask<<2 = 0 %start
if (T & 3 << 2 != 0) goto L_00A8;
// 1460 Forget Destination(Hold)
FORGETDESTINATION(/*?*/ &HOLD);
// 1461 Forget Destination(V)
FORGETDESTINATION(V);
// 1462 %finish
L_00A8:;
// 1463 Forget(Reg) %if T&OpMask = 0
if (T & 3 != 0) goto L_00A9;
FORGET(REG);
L_00A9:;
// 1464 Set Cc1(V)
SETCC1(V);
// 1465 %end
return;
} /* end of PLANTR */
// 1466 %routine PlantF(%integer Op, Reg, %record(Stackfm)%name V)
void PLANTF(int OP, int REG, struct STACKFM *V) {
// 1467 %record(opfm) Op1
struct OPFM OP1;
// 1468 %record(Stackfm) Hold
struct STACKFM HOLD;
// 1469 %record(Stackfm)%name R
struct STACKFM *R;
// 1470 %integer T
int T;
// 1471 T = OpType(Op)
T = OPTYPE[OP - 1];
// 1472 Fail("Op") %if T&Type Mask # Floating Instruction
if (T & 112 == 64) goto L_00AA;
FAIL(_imp_str_literal_size(63, "Op"));
L_00AA:;
// 1473 Fail("Register") %unless 0 <= Reg <= F3
{
// Double-sided test on REG (Part I)
int tmp;
if (0 > (tmp = REG)) goto L_00AB;
// Double-sided test on REG (Part II)
if (tmp <= 13) goto L_00AC;
}
L_00AB:;
FAIL(_imp_str_literal_size(63, "Register"));
L_00AC:;
// 1474 Protect(V) %if T&OpMask<<2 = 0
if (T & 3 << 2 != 0) goto L_00AD;
PROTECT(V);
L_00AD:;
// 1475 Hold = V
HOLD = *V;
// 1476 Process Operand(V, Op1, T&Op Mask<<2, 0)
PROCESSOPERAND(V, /*?*/ &OP1, T & 3 << 2, 0);
// 1477
// 1478 {Reg=0 for unary operations}
// 1479 %unless Op = TSTF %and Cc Known(V)#0 %start
if (OP != 116) goto L_00AE;
if (CCKNOWN(V) != 0) goto L_00AF;
L_00AE:;
// 1480 %if Reg = 0 %then Set Mode(V_Type) %else Set Mode(Lreals)
if (REG != 0) goto L_00B0;
SETMODE(V->TYPE);
goto L_00B1;
L_00B0:;
SETMODE(4);
L_00B1:;
// 1481 Plant(OpTable(Op)+(Actual(Reg)<<6)+Op1_Modereg, Test Single)
PLANT(OPTABLE[OP - 1] + (ACTUAL[REG] << 6) + OP1.MODEREG, -47);
// 1482 Plant(Op1_Extra, Op1_More) %if Op1_More # 0
if (OP1.MORE == 0) goto L_00B2;
PLANT(OP1.EXTRA, OP1.MORE);
L_00B2:;
// 1483
// 1484 %if T&OpMask<<2 = 0 %start {destination}
if (T & 3 << 2 != 0) goto L_00B3;
// 1485 Forget Destination(Hold)
FORGETDESTINATION(/*?*/ &HOLD);
// 1486 Forget Destination(V)
FORGETDESTINATION(V);
// 1487 %finish
L_00B3:;
// 1488 %if Reg # 0 %start
if (REG == 0) goto L_00B4;
// 1489 Forget(Reg) %if T&OpMask = 0
if (T & 3 != 0) goto L_00B5;
FORGET(REG);
L_00B5:;
// 1490 R == RegV(Reg)
R = (struct STACKFM *)/*?*/ ®V[REG - 1];
// 1491 Set Cc1(R)
SETCC1(R);
// 1492 %finish
L_00B4:;
// 1493 %if Op = LDF %or Op = STF %start
if (OP == 68) goto L_00B6;
if (OP != 106) goto L_00B7;
L_00B6:;
// 1494 Remember(Reg, Hold)
REMEMBER(REG, /*?*/ &HOLD);
// 1495 Cc2_Data = V_Data; Cc2_Cc Ca = Ca
CC2.DATA = V->DATA;
CC2.CCCA = *CA;
// 1496 %finish
L_00B7:;
// 1497 Replace(V, R) %if T&ToReg # 0
if (T & 128 == 0) goto L_00B8;
REPLACE(V, R);
L_00B8:;
// 1498 %finish
L_00AF:;
// 1499 %end
return;
} /* end of PLANTF */
// 1500 %routine Machine Code
void MACHINECODE(void) {
// 1501 %constbytearray Limits(0:9) = 0,0,0,0,63,255,63,0,255,7
const unsigned char LIMITS[10] = {0, 0, 0, 0, 63, 255, 63, 0, 255, 7};
// 1502 %integer P, Code, Type, Limit, Errors, Change Ds, Varop
int P;
int CODE;
int TYPE;
int LIMIT;
int ERRORS;
int CHANGEDS;
int VAROP;
// 1503 %string(6) Text
_imp_string6 TEXT;
// 1504 %integerarray Disps, Rels(1:2)
int DISPS[2];
int RELS[2];
// 1505 %record(Varfm)%name V
struct VARFM *V;
// 1506 {%predicate}
// 1507 %integerfn Match(%integer Wanted)
int MATCH(int WANTED) {
// 1508 %result=0 %unless Pending = Wanted
if (PENDING == WANTED) goto L_00B9;
return 0;
L_00B9:;
// 1509 Readch(Pending)
READCH(/*?*/ &PENDING);
// 1510 %result=-1
return -1;
// 1511 %end
} /* end of MATCH */
// 1512 %routine Mc Error(%string(31) S)
void MCERROR(_imp_string31 S) {
// 1513 %integer N
int N;
// 1514 Errors = Errors-1
ERRORS = ERRORS - 1;
// 1515 Warn(Text.S) %if Errors = 0
if (ERRORS != 0) goto L_00BA;
WARN(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &TEXT, (_imp_string *)/*?*/ &S);
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string63 *)&tmp;
})
);
L_00BA:;
// 1516 %while Pending # ';' %cycle
L_00BB:;
if (PENDING == 59) goto L_00BC;
// 1517 %if Match('N')#0 %then N = Four Bytes %else Readch(Pending)
if (MATCH(78) == 0) goto L_00BD;
N = FOURBYTES();
goto L_00BE;
L_00BD:;
READCH(/*?*/ &PENDING);
L_00BE:;
// 1518 %repeat
goto L_00BB;
L_00BC:;
// 1519 %end
return;
} /* end of MCERROR */
// 1520 %integerfn Literal(%integer Limit)
int LITERAL(int LIMIT) {
// 1521 %integer N
int N;
// 1522 %if Match('N')#0 %start
if (MATCH(78) == 0) goto L_00BF;
// 1523 N = Four Bytes
N = FOURBYTES();
// 1524 %result = N %if Limit = 0 %or 0 <= N <= Limit
if (LIMIT == 0) goto L_00C0;
{
// Double-sided test on N (Part I)
int tmp;
if (0 > (tmp = N)) goto L_00C1;
// Double-sided test on N (Part II)
if (tmp > LIMIT) goto L_00C1;
}
L_00C0:;
return N;
L_00C1:;
// 1525 %finish
L_00BF:;
// 1526 Mc Error(" Value?")
MCERROR(_imp_str_literal_size(31, " Value?"));
// 1527 %result=0
return 0;
// 1528 %end
} /* end of LITERAL */
// 1529 %routine Add(%integer D, R)
void ADD(int D, int R) {
// 1530 P = P+1
P = P + 1;
// 1531 Disps(P) = D
DISPS[P - 1] = D;
// 1532 Rels(P) = R
RELS[P - 1] = R;
// 1533 %end
return;
} /* end of ADD */
// 1534 %integerfn Operand
int OPERAND(void) {
// 1535 %record(Varfm)%name V
struct VARFM *V;
// 1536 %integer Indirect, Mode, Reg, Lit, Rel
int INDIRECT;
int MODE;
int REG;
int LIT;
int REL;
// 1537 Mode = 0; Reg = 0; Lit = 0; Rel = 0; Varop = 0
MODE = 0;
REG = 0;
LIT = 0;
REL = 0;
VAROP = 0;
// 1538 %routine Get Index
void GETINDEX(void) {
// 1539 Reg = Literal(7)
REG = LITERAL(7);
// 1540 Mc Error(" ) ?") %unless Match(')')#0
if (MATCH(41) != 0) goto L_00C2;
MCERROR(_imp_str_literal_size(31, " ) ?"));
L_00C2:;
// 1541 %end
return;
} /* end of GETINDEX */
// 1542 %routine Modify
void MODIFY(void) {
// 1543 %cycle
L_00C3:;
// 1544 %if Match('+')#0 %start
if (MATCH(43) == 0) goto L_00C4;
// 1545 Lit = Lit+Literal(0)
LIT = LIT + LITERAL(0);
// 1546 %finish %else %if Match('-')#0 %start
goto L_00C5;
L_00C4:;
if (MATCH(45) == 0) goto L_00C6;
// 1547 Lit = Lit-Literal(0)
LIT = LIT - LITERAL(0);
// 1548 %finish %else %return
goto L_00C5;
L_00C6:;
return;
L_00C5:;
// 1549 %repeat
goto L_00C3;
// 1550 %end
} /* end of MODIFY */
// 1551 Indirect = 0
INDIRECT = 0;
// 1552 Indirect = 1 %if Match('@')#0
if (MATCH(64) == 0) goto L_00C7;
INDIRECT = 1;
L_00C7:;
// 1553 %if Match('#')#0 %start
if (MATCH(35) == 0) goto L_00C8;
// 1554 Mode = 2; Reg = 7
MODE = 2;
REG = 7;
// 1555 %if Match(' ')#0 %start
if (MATCH(32) == 0) goto L_00C9;
// 1556 V == Var(Tag)
V = (struct VARFM *)/*?*/ &VAR[TAG()];
// 1557 Rel = V_Area
REL = V->AREA;
// 1558 Lit = V_Disp
LIT = V->DISP;
// 1559 Mc Error(" Address?") %if Rel = 0
if (REL != 0) goto L_00CA;
MCERROR(_imp_str_literal_size(31, " Address?"));
L_00CA:;
// 1560 Modify
MODIFY();
// 1561 %finish %else %start
goto L_00CB;
L_00C9:;
// 1562 Lit = Literal(0)
LIT = LITERAL(0);
// 1563 %finish
L_00CB:;
// 1564 Add(Lit, Rel)
ADD(LIT, REL);
// 1565 %finish %else %if Match('(')#0 %start
goto L_00CC;
L_00C8:;
if (MATCH(40) == 0) goto L_00CD;
// 1566 Get Index
GETINDEX();
// 1567 Mode = 1
MODE = 1;
// 1568 Mode = 2 %if Match('+')#0
if (MATCH(43) == 0) goto L_00CE;
MODE = 2;
L_00CE:;
// 1569 %finish %else %if Match('-')#0 %start
goto L_00CC;
L_00CD:;
if (MATCH(45) == 0) goto L_00CF;
// 1570 %if Match('(')#0 %start
if (MATCH(40) == 0) goto L_00D0;
// 1571 Get Index
GETINDEX();
// 1572 Mode = 4
MODE = 4;
// 1573 %finish %else %start
goto L_00D1;
L_00D0:;
// 1574 Mode = 6
MODE = 6;
// 1575 Lit = -Literal(0)
LIT = -LITERAL(0);
// 1576 %if Match('(')#0 %then Get Index %else Mc Error(" ( ?")
if (MATCH(40) == 0) goto L_00D2;
GETINDEX();
goto L_00D3;
L_00D2:;
MCERROR(_imp_str_literal_size(31, " ( ?"));
L_00D3:;
// 1577 Modify
MODIFY();
// 1578 Add(Lit, 0)
ADD(LIT, 0);
// 1579 %finish
L_00D1:;
// 1580 %finish %else %if Pending = 'N' %start
goto L_00CC;
L_00CF:;
if (PENDING != 78) goto L_00D4;
// 1581 Lit = Literal(0)
LIT = LITERAL(0);
// 1582 %if Match('(')#0 %start
if (MATCH(40) == 0) goto L_00D5;
// 1583 Get Index
GETINDEX();
// 1584 Mode = 6
MODE = 6;
// 1585 Modify
MODIFY();
// 1586 Add(Lit, 0)
ADD(LIT, 0);
// 1587 %finish %else %start
goto L_00D6;
L_00D5:;
// 1588 Mc Error(" Register?") %unless 0 <= Lit <= 7
{
// Double-sided test on LIT (Part I)
int tmp;
if (0 > (tmp = LIT)) goto L_00D7;
// Double-sided test on LIT (Part II)
if (tmp <= 7) goto L_00D8;
}
L_00D7:;
MCERROR(_imp_str_literal_size(31, " Register?"));
L_00D8:;
// 1589 Reg = Lit
REG = LIT;
// 1590 %finish
L_00D6:;
// 1591 %finish %else %if Match(' ')#0 %start
goto L_00CC;
L_00D4:;
if (MATCH(32) == 0) goto L_00D9;
// 1592 Varop = 1
VAROP = 1;
// 1593 V == Var(Tag)
V = (struct VARFM *)/*?*/ &VAR[TAG()];
// 1594 Rel = V_Area
REL = V->AREA;
// 1595 Lit = V_Disp
LIT = V->DISP;
// 1596 Reg = V_Base
REG = V->BASE;
// 1597 %if V_Type = Labels %start
if (V->TYPE != 8) goto L_00DA;
// 1598 Rel = -(Lit<<1); Mode = 6; Reg = 7
REL = -(LIT << 1);
MODE = 6;
REG = 7;
// 1599 Lit = 0
LIT = 0;
// 1600 %finish %else %if V_Base = Local %start
goto L_00DB;
L_00DA:;
if (V->BASE != LOCAL) goto L_00DC;
// 1601 Reg = Actual(Lnb); Mode = 6
REG = ACTUAL[5];
MODE = 6;
// 1602 %finish %else %if Rel # 0 %or Reg = 0 %start
goto L_00DB;
L_00DC:;
if (REL != 0) goto L_00DD;
if (REG != 0) goto L_00DE;
L_00DD:;
// 1603 Reg = 7; Mode = 3
REG = 7;
MODE = 3;
// 1604 %finish %else %start
goto L_00DB;
L_00DE:;
// 1605 Mc Error(" Address?")
MCERROR(_imp_str_literal_size(31, " Address?"));
// 1606 %finish
L_00DB:;
// 1607 %if Indirect # 0 %start
if (INDIRECT == 0) goto L_00DF;
// 1608 Mode = 6; Rel = Rel!1
MODE = 6;
REL = REL | 1;
// 1609 %finish
L_00DF:;
// 1610 Modify
MODIFY();
// 1611 %if Lit = 0 %and Rel = 0 %and Mode = 6 %then Mode = 1 %c
if (LIT != 0) goto L_00E0;
if (REL != 0) goto L_00E0;
if (MODE != 6) goto L_00E0;
MODE = 1;
goto L_00E1;
L_00E0:;
ADD(LIT, REL);
L_00E1:;
// 1612+ %else Add(Lit, Rel)
// 1613 %finish %else %start
goto L_00CC;
L_00D9:;
// 1614 Mc Error(" Format?")
MCERROR(_imp_str_literal_size(31, " Format?"));
// 1615 %finish
L_00CC:;
// 1616 %if Indirect # 0 %start
if (INDIRECT == 0) goto L_00E2;
// 1617 Mc Error(" Indirect?") %if Mode&1 # 0
if (MODE & 1 == 0) goto L_00E3;
MCERROR(_imp_str_literal_size(31, " Indirect?"));
L_00E3:;
// 1618 Mode = Mode+1
MODE = MODE + 1;
// 1619 %finish
L_00E2:;
// 1620 %result = Mode<<3+Reg
return (MODE << 3) + REG;
// 1621 %end
} /* end of OPERAND */
// 1622 %routine Get Oper
void GETOPER(void) {
// 1623 %integer M1, M2, J, H, L
int M1;
int M2;
int J;
int H;
int L;
// 1624 Text = ""
_imp_strncpy(/*?*/ &TEXT, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 6);
// 1625 %while Pending # '_' %cycle
L_00E4:;
if (PENDING == 95) goto L_00E5;
// 1626 Text = Text.Tostring(Pending) %unless Length(Text) = 5
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEXT) == 5) goto L_00E6;
_imp_strncpy(/*?*/ &TEXT, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &TEXT, ({
__typeof__(_imp_string1) tmp; /*E*/
tmp = _imp_TOSTRING(PENDING);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 6);
L_00E6:;
// 1627 Readch(Pending)
READCH(/*?*/ &PENDING);
// 1628 %repeat
goto L_00E4;
L_00E5:;
// 1629 Readch(Pending)
READCH(/*?*/ &PENDING);
// 1630 Text = Text." " %while Length(Text) # 5
L_00E7:;
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEXT) == 5) goto L_00E8;
_imp_strncpy(/*?*/ &TEXT, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ &TEXT, (_imp_string *)/*?*/ _imp_str_literal_ptr(" "));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 6);
goto L_00E7;
L_00E8:;
// 1631 M1 = ((Charno(Text, 1)<<5+Charno(Text, 2))<<5+Charno(Text, 3))&8_077777
M1 = ((*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &TEXT, 1) << 5) +
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &TEXT, 2)
<< 5) +
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &TEXT, 3) &
32767;
// 1632 M2 = Charno(Text, 4)<<5+Charno(Text, 5)
M2 = (*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &TEXT, 4) << 5) +
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &TEXT, 5);
// 1633 L = 1; H = McOps {Binary search}
L = 1;
H = 118;
// 1634 %cycle
L_00E9:;
// 1635 J = (L+H)>>1
J = (unsigned int)L + H >> 1;
// 1636 %if Val1(J) = M1 %start
if (VAL1[J - 1] != M1) goto L_00EA;
// 1637 %if Val2(J) = M2 %start
if (VAL2[J - 1] != M2) goto L_00EB;
// 1638 Type = Mc Type(J)
TYPE = MCTYPE[J - 1];
// 1639 Code = Op Table(J)
CODE = OPTABLE[J - 1];
// 1640 Limit = Limits(Type&15)
LIMIT = LIMITS[TYPE & 15];
// 1641 %return
return;
// 1642 %finish
L_00EB:;
// 1643 %if Val2(J) > M2 %then H = J-1 %else L = J+1
if (VAL2[J - 1] <= M2) goto L_00EC;
H = J - 1;
goto L_00ED;
L_00EC:;
L = J + 1;
L_00ED:;
// 1644 %finish %else %start
goto L_00EE;
L_00EA:;
// 1645 %if Val1(J) > M1 %then H = J-1 %else L = J+1
if (VAL1[J - 1] <= M1) goto L_00EF;
H = J - 1;
goto L_00F0;
L_00EF:;
L = J + 1;
L_00F0:;
// 1646 %finish
L_00EE:;
// 1647 %repeat %until L > H
if (L > H) goto L_00F1;
goto L_00E9;
L_00F1:;
// 1648 Type = 0
TYPE = 0;
// 1649 Code = 0
CODE = 0;
// 1650 Mc Error(" Unknown")
MCERROR(_imp_str_literal_size(31, " Unknown"));
// 1651 %end
return;
} /* end of GETOPER */
// 1652 %routine Pop(%integer N)
void POP(int N) {
// 1653 %integer V, R, L
int V;
int R;
int L;
// 1654 V = Disps(N); R = Rels(N)
V = DISPS[N - 1];
R = RELS[N - 1];
// 1655 %if R < 0 %start {label}
if (R >= 0) goto L_00F2;
// 1656 R = -R
R = -R;
// 1657 L = R>>1
L = (unsigned int)R >> 1;
// 1658 Printch(Obj PcRel) %if R&1 # 0 {?was after ca+2?}
if (R & 1 == 0) goto L_00F3;
PRINTCH(43);
L_00F3:;
// 1659 Dcode(Dir Mcused); Put with Ca(L)
DCODE(14);
PUTWITHCA(L);
// 1660 Ocode(Obj Modlab); Put(L); Put(V)
OCODE(51);
PUT(L);
PUT(V);
// 1661 Ca = Ca+2
*CA = *CA + 2;
// 1662 %finish %else %start
goto L_00F4;
L_00F2:;
// 1663 Plant(V, R)
PLANT(V, R);
// 1664 %finish
L_00F4:;
// 1665 %end
return;
} /* end of POP */
// 1666 %routine Code Instruction
void CODEINSTRUCTION(void) {
// 1667 %switch Mc(0:9)
int MC_index;
int MC_line;
char *MC_file;
static const void *MC[10] = {&&case_MC_missing, &&case_MC_missing, &&case_MC_missing, &&case_MC_missing,
&&case_MC_missing, &&case_MC_missing, &&case_MC_missing, &&case_MC_missing,
&&case_MC_missing, &&case_MC_missing};
// 1668 ->Mc(Type&15)
MC_line = __LINE__;
MC_file = __FILE__;
MC_index = TYPE & 15;
goto case_MC_dispatch;
// 1669 Mc(2): Code = Code!Operand<<6
case_MC_2:;
CODE = CODE | OPERAND() << 6;
// 1670 Change Ds = Test One %if Varop # 0
if (VAROP == 0) goto L_00F6;
CHANGEDS = -54;
L_00F6:;
// 1671 Com: ->Err %unless Match(',')#0
U_1001:;
if (MATCH(44) != 0) goto L_00F7;
goto U_1002;
L_00F7:;
// 1672 Mc(1): Code = Code!Operand
case_MC_1:;
CODE = CODE | OPERAND();
// 1673 %if Varop # 0 %start
if (VAROP == 0) goto L_00F8;
// 1674 %if Change DS = 0 %then Change DS = Test Single %C
if (CHANGEDS != 0) goto L_00F9;
CHANGEDS = -47;
goto L_00FA;
L_00F9:;
CHANGEDS = -48;
L_00FA:;
// 1675+ %else Change DS = Test Double
// 1676 %finish
L_00F8:;
// 1677 Plant(Code, Change Ds)
PLANT(CODE, CHANGEDS);
// 1678 Pop(1) %if P # 0
if (P == 0) goto L_00FB;
POP(1);
L_00FB:;
// 1679 Pop(2) %if P = 2
if (P != 2) goto L_00FC;
POP(2);
L_00FC:;
// 1680 %return
return;
// 1681 Mc(0): Plant(Code, 0); %return
case_MC_0:;
PLANT(CODE, 0);
return;
// 1682 Mc(3):
case_MC_3:;
// 1683 Mc(7): Code = Code!Literal(Limit)<<6
case_MC_7:;
CODE = CODE | LITERAL(LIMIT) << 6;
// 1684 ->Com
goto U_1001;
// 1685 Mc(4):
case_MC_4:;
// 1686 Mc(5):
case_MC_5:;
// 1687 Mc(9): Plant(Code!Literal(Limit), 0); %return
case_MC_9:;
PLANT(CODE | LITERAL(LIMIT), 0);
return;
// 1688 Mc(6): Code = Code!Literal(3)<<6
case_MC_6:;
CODE = CODE | LITERAL(3) << 6;
// 1689 ->Err %unless Match(',')#0
if (MATCH(44) != 0) goto L_00FD;
goto U_1002;
L_00FD:;
// 1690 Mc(8): %if Match(' ')#0 %start
case_MC_8:;
if (MATCH(32) == 0) goto L_00FE;
// 1691 V == Var(Tag)
V = (struct VARFM *)/*?*/ &VAR[TAG()];
// 1692 %if V_Type = Labels %start
if (V->TYPE != 8) goto L_00FF;
// 1693 Dcode(Dir Mcused); Put with Ca(V_Disp)
DCODE(14);
PUTWITHCA(V->DISP);
// 1694 Ocode(Obj Branch+4-((Type&15)>>1)); Put(V_Disp); Put(Code)
OCODE(49 + 4 - ((unsigned int)(TYPE & 15) >> 1));
PUT(V->DISP);
PUT(CODE);
// 1695 Ca = Ca+2
*CA = *CA + 2;
// 1696 %return
return;
// 1697 %finish
L_00FF:;
// 1698 %finish
L_00FE:;
// 1699 Mc Error(" Label?")
MCERROR(_imp_str_literal_size(31, " Label?"));
// 1700 %return
return;
// 1701 Err: Mc Error(" Comma?")
U_1002:;
MCERROR(_imp_str_literal_size(31, " Comma?"));
// 1702 %end
return;
case_MC_dispatch:
if (MC_index < 0 || MC_index > 9)
_imp_signalf(6, 3, MC_index, "->MC(%d) out of bounds at %s line %d", MC_index, MC_file, MC_line);
goto *MC[MC_index - 0];
case_MC_missing:
_imp_signalf(8, 2, MC_index, "switch jump to undefined label MC(%d): at %s line %d", MC_index, MC_file,
MC_line);
} /* end of CODEINSTRUCTION */
// 1703 Errors = 1
ERRORS = 1;
// 1704 Change Ds = 0
CHANGEDS = 0;
// 1705 P = 0
P = 0;
// 1706 Get Oper
GETOPER();
// 1707 Code Instruction
CODEINSTRUCTION();
// 1708 Uncond Jump = Ca %if Type&128 # 0
if (TYPE & 128 == 0) goto L_0100;
UNCONDJUMP = *CA;
L_0100:;
// 1709 Mc Error(" Operands?") %if Pending # ';'
if (PENDING == 59) goto L_0101;
MCERROR(_imp_str_literal_size(31, " Operands?"));
L_0101:;
// 1710 Readch(Pending)
READCH(/*?*/ &PENDING);
// 1711 %end
return;
} /* end of MACHINECODE */
// 1712 {%predicate}
// 1713 %integerfn In Safe Reg(%record(Stackfm)%name V)
int INSAFEREG(struct STACKFM * V) {
// 1714 %result=0 %if V_Form # VinR %or V_Disp # 0 %or V_Base >= 128 %c
if (V->FORM != 0) goto L_0102;
if (V->DISP != 0) goto L_0102;
if (V->BASE >= 128) goto L_0102;
if (ACTIVITY[V->BASE] == 1) goto L_0103;
L_0102:;
return 0;
L_0103:;
// 1715+ %or Activity(V_Base) # 1
// 1716 %result=-1
return -1;
// 1717 %end
} /* end of INSAFEREG */
// 1718 {%predicate}
// 1719 %integerfn In Free Reg(%record(Stackfm)%name V)
int INFREEREG(struct STACKFM * V) {
// 1720 %result=0 %if V_Form # VinR %or V_Disp # 0 %or Activity(V_Base) # 0
if (V->FORM != 0) goto L_0104;
if (V->DISP != 0) goto L_0104;
if (ACTIVITY[V->BASE] == 0) goto L_0105;
L_0104:;
return 0;
L_0105:;
// 1721 %result=-1
return -1;
// 1722 %end
} /* end of INFREEREG */
// 1723 %routine Float(%record(Stackfm)%name V, T)
void FLOAT(struct STACKFM * V, struct STACKFM * T) {
// 1724 {Convert the integral object V into a floating-point object}
// 1725 {T defines the sort of result required: Real or Long real, and
// 1726 {possibly the register to do it into}
// 1727 %integer R
int R;
// 1728 Monitor(V, "Float") %if Diag&MonOperate # 0
if (DIAG & 16 == 0) goto L_0106;
MONITOR(V, _imp_str_literal_size(15, "Float"));
L_0106:;
// 1729 Fail("Integral") %if V_Type > Bytes
if (V->TYPE <= 2) goto L_0107;
FAIL(_imp_str_literal_size(63, "Integral"));
L_0107:;
// 1730 %if Const(V)#0 %start
if (CONST(V) == 0) goto L_0108;
// 1731 Real Value_R = V_Disp
REALVALUE.R = V->DISP;
// 1732 Set Real(V)
SETREAL(V);
// 1733 %return
return;
// 1734 %finish
L_0108:;
// 1735 Loadup(V) %if V_Type = Bytes %or V_Oper # 0
if (V->TYPE == 2) goto L_0109;
if (V->OPER == 0) goto L_010A;
L_0109:;
LOADUP(V);
L_010A:;
// 1736 %if In Free Reg(T)#0 %then R = T_Base %c
if (INFREEREG(T) == 0) goto L_010B;
R = T->BASE;
goto L_010C;
L_010B:;
R = FPR();
L_010C:;
// 1737+ %else R = Fpr
// 1738 PlantF(LDCIF, R, V)
PLANTF(67, R, V);
// 1739 %end
return;
} /* end of FLOAT */
// 1740 %routine Equate Types(%record(Stackfm)%name Old, New, %integer ToNew)
void EQUATETYPES(struct STACKFM * OLD, struct STACKFM * NEW, int TONEW) {
// 1741 %integer Nt, Ot, R
int NT;
int OT;
int R;
// 1742 %record(Stackfm) Rw
struct STACKFM RW;
// 1743 %record(Stackfm)%name Rv
struct STACKFM *RV;
// 1744 %routine Update
void UPDATE(void) {
// 1745 New_Data = Rw_Data %if New_Form # VinR
if (NEW->FORM == 0) goto L_010D;
NEW->DATA = RW.DATA;
L_010D:;
// 1746 Replace(Old, New)
REPLACE(OLD, NEW);
// 1747 %end
return;
} /* end of UPDATE */
// 1748 Nt = New_Type; Ot = Old_Type
NT = NEW->TYPE;
OT = OLD->TYPE;
// 1749 %if Ot = Strings %or Ot = Records %start
if (OT == 5) goto L_010E;
if (OT != 6) goto L_010F;
L_010E:;
// 1750 Amap(Old); %return
AMAP(OLD);
return;
// 1751 %finish
L_010F:;
// 1752 %if Ot = Bytes %start {must be loaded}
if (OT != 2) goto L_0110;
// 1753 %if In Free Reg(New)#0 %then R = New_Base %else R = Gpr
if (INFREEREG(NEW) == 0) goto L_0111;
R = NEW->BASE;
goto L_0112;
L_0111:;
R = GPR();
L_0112:;
// 1754 Rv == RegV(R)
RV = (struct STACKFM *)/*?*/ ®V[R - 1];
// 1755 %if Old_Flags&Safe Byte # 0 %start {Movb will zero extend}
if (OLD->FLAGS & 128 == 0) goto L_0113;
// 1756 Plant2(MOVB, Old, Rv)
PLANT2(74, OLD, RV);
// 1757 %finish %else %start
goto L_0114;
L_0113:;
// 1758 Claim(R)
CLAIM(R);
// 1759 Plant1(CLR, Rv); Plant2(BISB, Old, Rv)
PLANT1(40, RV);
PLANT2(22, OLD, RV);
// 1760 Release(Old_Base)
RELEASE(OLD->BASE);
// 1761 %finish
L_0114:;
// 1762 Old_Data = Rv_Data; Ot = Integers
OLD->DATA = RV->DATA;
OT = 1;
// 1763 %return %if Nt = Integers
if (NT != 1) goto L_0115;
return;
L_0115:;
// 1764 %finish
L_0110:;
// 1765 %if Reals <= Nt <= Lreals %start
{
// Double-sided test on NT (Part I)
int tmp;
if (3 > (tmp = NT)) goto L_0116;
// Double-sided test on NT (Part II)
if (tmp > 4) goto L_0116;
}
// 1766 %if Reals <= Ot <= Lreals %start
{
// Double-sided test on OT (Part I)
int tmp;
if (3 > (tmp = OT)) goto L_0117;
// Double-sided test on OT (Part II)
if (tmp > 4) goto L_0117;
}
// 1767 %if ToNew # 0 %and InReg(Old)#0 %start
if (TONEW == 0) goto L_0118;
if (INREG(OLD) == 0) goto L_0118;
// 1768 Rw_Data = New_Data
RW.DATA = NEW->DATA;
// 1769 PlantF(STCFD, Old_Base, Rw)
PLANTF(104, OLD->BASE, /*?*/ &RW);
// 1770 Update
UPDATE();
// 1771 %finish %else %start
goto L_0119;
L_0118:;
// 1772 R = AnyF
R = 14;
// 1773 R = New_Base %if ToNew # 0 %and New_Form = VinR
if (TONEW == 0) goto L_011A;
if (NEW->FORM != 0) goto L_011A;
R = NEW->BASE;
L_011A:;
// 1774 R = Fpr %if R = AnyF
if (R != 14) goto L_011B;
R = FPR();
L_011B:;
// 1775 PlantF(LDCFD, R, Old)
PLANTF(66, R, OLD);
// 1776 Old_Type = Nt
OLD->TYPE = NT;
// 1777 %finish
L_0119:;
// 1778 %finish %else %start {float required}
goto L_011C;
L_0117:;
// 1779 Float(Old, New)
FLOAT(OLD, NEW);
// 1780 %finish
L_011C:;
// 1781 %finish %else %if Reals <= Ot <= Lreals %start
goto L_011D;
L_0116:;
{
// Double-sided test on OT (Part I)
int tmp;
if (3 > (tmp = OT)) goto L_011E;
// Double-sided test on OT (Part II)
if (tmp > 4) goto L_011E;
}
// 1782 Loadup(Old)
LOADUP(OLD);
// 1783 %if ToNew # 0 %start
if (TONEW == 0) goto L_011F;
// 1784 Rw_Data = New_Data
RW.DATA = NEW->DATA;
// 1785 PlantF(STCFI, Old_Base, Rw)
PLANTF(105, OLD->BASE, /*?*/ &RW);
// 1786 Update
UPDATE();
// 1787 %finish %else %start
goto L_0120;
L_011F:;
// 1788 Rv == RegV(Gpr)
RV = (struct STACKFM *)/*?*/ ®V[GPR() - 1];
// 1789 PlantF(STCFI, Old_Base, Rv)
PLANTF(105, OLD->BASE, RV);
// 1790 Replace(Old, Rv)
REPLACE(OLD, RV);
// 1791 %finish
L_0120:;
// 1792 %finish
L_011E:;
L_011D:;
// 1793 %end
return;
} /* end of EQUATETYPES */
// 1794 %routine Simple(%record(Stackfm)%name From, To)
void SIMPLE(struct STACKFM * FROM, struct STACKFM * TO) {
// 1795 {Move the object described by the simple descriptor FROM into the}
// 1796 {destination TO. FROM is updated if To is a register and TO is left unaltered}
// 1797 %integer Type, N, Treg
int TYPE;
int N;
int TREG;
// 1798 %record(Stackfm) Temp
struct STACKFM TEMP;
// 1799 %if Diag&MonMove # 0 %start
if (DIAG & 32 == 0) goto L_0121;
// 1800 Monitor(From, "S-From")
MONITOR(FROM, _imp_str_literal_size(15, "S-From"));
// 1801 Monitor(To, "S-To")
MONITOR(TO, _imp_str_literal_size(15, "S-To"));
// 1802 %finish
L_0121:;
// 1803 %return %if Same(From, To)#0
if (SAME(FROM, TO) == 0) goto L_0122;
return;
L_0122:;
// 1804 Treg = Inreg(To)
TREG = INREG(TO);
// 1805 %if Treg # 0 %start
if (TREG == 0) goto L_0123;
// 1806 N = Activity(To_Base)
N = ACTIVITY[TO->BASE];
// 1807 %if N > 0 %start
if (N <= 0) goto L_0124;
// 1808 Hazard(To_Base) %if N > 1 %or To_Base # From_Base
if (N > 1) goto L_0125;
if (TO->BASE == FROM->BASE) goto L_0126;
L_0125:;
HAZARD(TO->BASE);
L_0126:;
// 1809 %finish
L_0124:;
// 1810 %finish
L_0123:;
// 1811 Type = To_Type
TYPE = TO->TYPE;
// 1812 %if Const(From)#0 %and %c
if (CONST(FROM) == 0) goto L_0127;
if (FROM->DISP == 0) goto L_0128;
{
// Double-sided test on FROM->DISP (Part I)
int tmp;
if (-1 > (tmp = FROM->DISP)) goto L_0127;
// Double-sided test on FROM->DISP (Part II)
if (tmp > 1) goto L_0127;
}
if (TREG == 0) goto L_0127;
L_0128:;
// 1813+ (From_Disp = 0 %or (-1 <= From_Disp <= 1 %and Treg#0)) %start
// 1814 Promote(To_Base)
PROMOTE(TO->BASE);
// 1815 N = From_Disp
N = FROM->DISP;
// 1816 Optimise(From, 1) {just in case}
OPTIMISE(FROM, 1);
// 1817 Move(From, To) %and %return %if From_Base # 0
if (FROM->BASE == 0) goto L_0129;
MOVE(FROM, TO);
return;
L_0129:;
// 1818 Temp_Data = From_Data
TEMP.DATA = FROM->DATA;
// 1819 %if N # 0 %start
if (N == 0) goto L_012A;
// 1820 From_Disp = 0; Optimise(From, 1)
FROM->DISP = 0;
OPTIMISE(FROM, 1);
// 1821 %finish
L_012A:;
// 1822 %if From_Base # 0 %start
if (FROM->BASE == 0) goto L_012B;
// 1823 Move(From, To)
MOVE(FROM, TO);
// 1824 %finish %else %start
goto L_012C;
L_012B:;
// 1825 From_Data = To_Data
FROM->DATA = TO->DATA;
// 1826 Claim(From_Base)
CLAIM(FROM->BASE);
// 1827 Plant1(Clearop(Type), From)
PLANT1(CLEAROP[TYPE - 1], FROM);
// 1828 %finish
L_012C:;
// 1829 %if N # 0 %start
if (N == 0) goto L_012D;
// 1830 %if N < 0 %then N = DEC %else N = INC
if (N >= 0) goto L_012E;
N = 50;
goto L_012F;
L_012E:;
N = 60;
L_012F:;
// 1831 Plant1(N, From)
PLANT1(N, FROM);
// 1832 %finish
L_012D:;
// 1833 Remember(From_Base, Temp) %if From_Form = VinR
if (FROM->FORM != 0) goto L_0130;
REMEMBER(FROM->BASE, /*?*/ &TEMP);
L_0130:;
// 1834 %finish %else %start
goto L_0131;
L_0127:;
// 1835 Equate Types(From, To, 1) %if From_Type # Type
if (FROM->TYPE == TYPE) goto L_0132;
EQUATETYPES(FROM, TO, 1);
L_0132:;
// 1836 Plant2(Move op(Type), From, To)
PLANT2(MOVEOP[TYPE - 1], FROM, TO);
// 1837 %finish
L_0131:;
// 1838 %end
return;
} /* end of SIMPLE */
// 1839 {%predicate}
// 1840 %integerfn Incdec Done(%record(Stackfm)%name S, D, %integer Oper)
int INCDECDONE(struct STACKFM * S, struct STACKFM * D, int OPER) {
// 1841 %result=0 %unless Const(S)#0 %and (S_Disp = 1 %or S_Disp = -1)
if (CONST(S) == 0) goto L_0133;
if (S->DISP == 1) goto L_0134;
if (S->DISP == -1) goto L_0134;
L_0133:;
return 0;
L_0134:;
// 1842 Oper = ADDx+SUBx-Oper %if S_Disp < 0
if (S->DISP >= 0) goto L_0135;
OPER = 3 + 4 - OPER;
L_0135:;
// 1843 Plant1(Inc op(Oper<<1+D_Type), D)
PLANT1(INCOP[(OPER << 1) + D->TYPE - 7], D);
// 1844 %result=-1
return -1;
// 1845 %end
} /* end of INCDECDONE */
// 1846 {%predicate}
// 1847 %integerfn Shifted(%record(Stackfm)%name S, D, %integer Pickup, Oper)
int SHIFTED(struct STACKFM * S, struct STACKFM * D, int PICKUP, int OPER) {
// 1848 %integer Now, Then, N
int NOW;
int THEN;
int N;
// 1849 %result=0 %unless Const(S)#0
if (CONST(S) != 0) goto L_0136;
return 0;
L_0136:;
// 1850 Load(D, Pickup) %if Pickup # 0
if (PICKUP == 0) goto L_0137;
LOAD(D, PICKUP);
L_0137:;
// 1851 N = S_Disp
N = S->DISP;
// 1852 %result=0 %if N&7 >= 5 %and Pickup = 0
if (N & 7 < 5) goto L_0138;
if (PICKUP != 0) goto L_0138;
return 0;
L_0138:;
// 1853 %unless 0 <= N <= 16 %start
{
// Double-sided test on N (Part I)
int tmp;
if (0 > (tmp = N)) goto L_0139;
// Double-sided test on N (Part II)
if (tmp <= 16) goto L_013A;
}
L_0139:;
// 1854 !#if e(=true)
// 1855 warn("Shift by ".ItoS(N))
WARN(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("Shift by "), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = ITOS(N);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string63 *)&tmp;
})
);
// 1856 !#else(=false)
// 1857 { warn("Shift by ".ItoS(N,1))}
// 1858 !#fi
// 1859 %if N < 0 %then N = 0 %else N = 16
if (N >= 0) goto L_013B;
N = 0;
goto L_013C;
L_013B:;
N = 16;
L_013C:;
// 1860 %finish
L_013A:;
// 1861 %result = 0 %unless 0 < N <= 2 %or 8 <= n <= 10
{
// Double-sided test on N (Part I)
int tmp;
if (0 >= (tmp = N)) goto L_013D;
// Double-sided test on N (Part II)
if (tmp <= 2) goto L_013E;
}
L_013D:;
{
// Double-sided test on N (Part I)
int tmp;
if (8 > (tmp = N)) goto L_013F;
// Double-sided test on N (Part II)
if (tmp <= 10) goto L_013E;
}
L_013F:;
return 0;
L_013E:;
// 1862 %if N >= 8 %start
if (N < 8) goto L_0140;
// 1863 Plant1(CLRB, D) %if Oper = RSHx
if (OPER != 13) goto L_0141;
PLANT1(41, D);
L_0141:;
// 1864 Plant1(SWAB, D)
PLANT1(111, D);
// 1865 Plant1(CLRB, D) %if Oper = LSHx
if (OPER != 12) goto L_0142;
PLANT1(41, D);
L_0142:;
// 1866 N = N-8
N = N - 8;
// 1867 %finish
L_0140:;
// 1868 Now = Asl; Then = Asl
NOW = 8;
THEN = 8;
// 1869 %if Oper = RSHx %start
if (OPER != 13) goto L_0143;
// 1870 Now = ROR; Then = ASR
NOW = 86;
THEN = 10;
// 1871 Oper = 0
OPER = 0;
// 1872 %finish
L_0143:;
// 1873 %if N > 0 %start
if (N <= 0) goto L_0144;
// 1874 Plant0(CLC) %if Oper = 0
if (OPER != 0) goto L_0145;
PLANT0(38);
L_0145:;
// 1875 %cycle
L_0146:;
// 1876 Plant1(Now, D)
PLANT1(NOW, D);
// 1877 Now = Then
NOW = THEN;
// 1878 N = N-1
N = N - 1;
// 1879 %repeat %until N = 0
if (N == 0) goto L_0147;
goto L_0146;
L_0147:;
// 1880 %finish
L_0144:;
// 1881 %result=-1
return -1;
// 1882 %end
} /* end of SHIFTED */
// 1883 {%predicate}
// 1884 %integerfn Self(%record(Stackfm)%name S, D, %integer Oper)
int SELF(struct STACKFM * S, struct STACKFM * D, int OPER) {
// 1885 %integer Flags
int FLAGS;
// 1886 Flags = Oper Flags(Oper)
FLAGS = OPERFLAGS[OPER - 1];
// 1887 %result=0 %if Flags&Selfop = 0 %or %c
if (FLAGS & 8 == 0) goto L_0148;
if (FLAGS & 16 != 0) goto L_0149;
if (D->TYPE != 2) goto L_0149;
L_0148:;
return 0;
L_0149:;
// 1888+ (Flags&Byteself = 0 %and D_type = Bytes)
// 1889 {Beware - INCB and DECB are funnies as there are no ADDB and SUBB}
// 1890 %if Flags&Unary # 0 %start
if (FLAGS & 32 == 0) goto L_014A;
// 1891 %if Oper = RNEGx %start
if (OPER != 16) goto L_014B;
// 1892 PlantF(NEGF, 0, D)
PLANTF(81, 0, D);
// 1893 %finish %else %start
goto L_014C;
L_014B:;
// 1894 Plant1(Unary op(Oper<<1+D_Type), D)
PLANT1(UNARYOP[(OPER << 1) + D->TYPE - 3], D);
// 1895 %finish
L_014C:;
// 1896 %finish %else %start {Binary}
goto L_014D;
L_014A:;
// 1897 %if Flags&Incdec # 0 %start
if (FLAGS & 64 == 0) goto L_014E;
// 1898 %result=-1 %if Incdec Done(S, D, Oper)#0
if (INCDECDONE(S, D, OPER) == 0) goto L_014F;
return -1;
L_014F:;
// 1899 %result=0 %if D_Type = Bytes
if (D->TYPE != 2) goto L_0150;
return 0;
L_0150:;
// 1900 %finish
L_014E:;
// 1901 %if Oper = XORx %start
if (OPER != 10) goto L_0151;
// 1902 Loadup(S)
LOADUP(S);
// 1903 PlantR(XOR, S_Base, D)
PLANTR(118, S->BASE, D);
// 1904 %finish %else %if Oper = LSHx %or Oper = RSHx %start
goto L_0152;
L_0151:;
if (OPER == 12) goto L_0153;
if (OPER != 13) goto L_0154;
L_0153:;
// 1905 %result=0 %unless Shifted(S, D, 0, Oper)#0
if (SHIFTED(S, D, 0, OPER) != 0) goto L_0155;
return 0;
L_0155:;
// 1906 %finish %else %start
goto L_0152;
L_0154:;
// 1907 Loadup(S) %if S_Type = Bytes # D_Type
{
// Double-sided test on 2 (Part I)
int tmp;
if (S->TYPE != (tmp = 2)) goto L_0156;
// Double-sided test on 2 (Part II)
if (tmp == D->TYPE) goto L_0156;
}
LOADUP(S);
L_0156:;
// 1908 Plant2(Operation(Oper<<1+D_Type), S, D)
PLANT2(OPERATION[(OPER << 1) + D->TYPE - 3], S, D);
// 1909 %finish
L_0152:;
// 1910 %finish
L_014D:;
// 1911 %result=-1
return -1;
// 1912 %end
} /* end of SELF */
// 1913 %routine Advance Ds
void ADVANCEDS(void) {
// 1914 %if DsBias # 0 %start
if (DSBIAS == 0) goto L_0157;
// 1915 Cword(8_062705); Cword(DsBias) {ADD_#DsBias,Ds}
CWORD(26053);
CWORD(DSBIAS);
// 1916 DsBias = 0
DSBIAS = 0;
// 1917 %finish
L_0157:;
// 1918 %end
return;
} /* end of ADVANCEDS */
// 1919 %routine Retreat Ds(%integer Shift)
void RETREATDS(int SHIFT) {
// 1920 Ds Bias = Shift
DSBIAS = SHIFT;
// 1921 %if Ds Bias # 0 %start
if (DSBIAS == 0) goto L_0158;
// 1922 Cword(8_162705); Cword(DsBias) {SUB_#DsBias,Ds}
CWORD(58821);
CWORD(DSBIAS);
// 1923 %finish
L_0158:;
// 1924 %end
return;
} /* end of RETREATDS */
// 1925 %routine To Work Area(%record(Stackfm)%name V)
void TOWORKAREA(struct STACKFM * V) {
// 1926 %record(Stackfm)%name W
struct STACKFM *W;
// 1927 {Leaves V as the address of the area}
// 1928 Load(V, R1)
LOAD(V, 2);
// 1929 Hazard(R2)
HAZARD(3);
// 1930 W == Record(Literal(DsBias))
W = (struct STACKFM *)_imp_RECORD(LITERAL(DSBIAS));
// 1931 W_Base = Ds; W_Flags = In Work
W->BASE = 6;
W->FLAGS = 1;
// 1932 DsBias = DsBias+256
DSBIAS = DSBIAS + 256;
// 1933 Load(W, R2); Release(R2)
LOAD(W, 3);
RELEASE(3);
// 1934 Attributes = Attributes!Attr Dynamic
ATTRIBUTES = ATTRIBUTES | 4096;
// 1935 Release and Clear(V)
RELEASEANDCLEAR(V);
// 1936 Perm(Smove)
PERM(1031);
// 1937 Claim(R2)
CLAIM(3);
// 1938 V_Data = W_Data
V->DATA = W->DATA;
// 1939 W_Flags = 0; Drop(W)
W->FLAGS = 0;
DROP(W);
// 1940 %end
return;
} /* end of TOWORKAREA */
// 1941 %routine Complex(%record(Stackfm)%name From, To)
void COMPLEX(struct STACKFM * FROM, struct STACKFM * TO) {
// 1942 {Move the object described by the complex descriptor FROM into the}
// 1943 {destination TO. FROM is updated and TO is left unaltered}
// 1944 %record(Stackfm)%name W, Work, V
struct STACKFM *W;
struct STACKFM *WORK;
struct STACKFM *V;
// 1945 %integer Even, Odd, N, Oper, Flags
int EVEN;
int ODD;
int N;
int OPER;
int FLAGS;
// 1946 %record(Stackfm) Reg
struct STACKFM REG;
// 1947 %switch Nasty(ADDx:REXPx)
int NASTY_index;
int NASTY_line;
char *NASTY_file;
static const void *NASTY[19] = {
&&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing,
&&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing,
&&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing,
&&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing, &&case_NASTY_missing};
// 1948 %routine Choose a Register(%integer Type)
void CHOOSEAREGISTER(int TYPE) {
// 1949 Reg = 0
REG = (struct STACKFM){0};
// 1950 Reg_Type = Type
REG.TYPE = TYPE;
// 1951 %if In Free Reg(To)#0 %start
if (INFREEREG(TO) == 0) goto L_0159;
// 1952 Reg_Base = To_Base
REG.BASE = TO->BASE;
// 1953 %finish %else %start
goto L_015A;
L_0159:;
// 1954 Optimise(From, 1)
OPTIMISE(FROM, 1);
// 1955 %if In Safe Reg(From)#0 %start
if (INSAFEREG(FROM) == 0) goto L_015B;
// 1956 Reg_Base = From_Base
REG.BASE = FROM->BASE;
// 1957 %finish %else %start
goto L_015C;
L_015B:;
// 1958 %if Type >= Reals %then Reg_Base = AnyF %else Reg_Base = AnyG
if (TYPE < 3) goto L_015D;
REG.BASE = 14;
goto L_015E;
L_015D:;
REG.BASE = 9;
L_015E:;
// 1959 %finish
L_015C:;
// 1960 %finish
L_015A:;
// 1961 %end
return;
} /* end of CHOOSEAREGISTER */
// 1962 %routine Choose odd Register
void CHOOSEODDREGISTER(void) {
// 1963 Reg = 0
REG = (struct STACKFM){0};
// 1964 Reg_Type = Integers
REG.TYPE = 1;
// 1965 %if In Safe Reg(From)#0 %and From_Base&1 = 0 %start
if (INSAFEREG(FROM) == 0) goto L_015F;
if (FROM->BASE & 1 != 0) goto L_015F;
// 1966 Reg_Base = From_Base
REG.BASE = FROM->BASE;
// 1967 %finish %else %if Activity(R0)+Activity(R1) < Activity(R2)+Activity(R3) %start
goto L_0160;
L_015F:;
if (ACTIVITY[1] + ACTIVITY[2] >= ACTIVITY[3] + ACTIVITY[4]) goto L_0161;
// 1968 Reg_Base = R1
REG.BASE = 2;
// 1969 %finish %else %start
goto L_0160;
L_0161:;
// 1970 Reg_Base = R3
REG.BASE = 4;
// 1971 %finish
L_0160:;
// 1972 %end
return;
} /* end of CHOOSEODDREGISTER */
// 1973 %if Diag&MonMove # 0 %start
if (DIAG & 32 == 0) goto L_0162;
// 1974 Monitor(From, "C-From")
MONITOR(FROM, _imp_str_literal_size(15, "C-From"));
// 1975 Monitor(To, "C-To")
MONITOR(TO, _imp_str_literal_size(15, "C-To"));
// 1976 %finish
L_0162:;
// 1977 W == From_Link; From_Link == Null
W = (struct STACKFM *)FROM->LINK;
FROM->LINK = (struct STACKFM *)NULL;
// 1978 Oper = From_Oper; From_Oper = 0
OPER = FROM->OPER;
FROM->OPER = 0;
// 1979 Flags = Oper flags(Oper)
FLAGS = OPERFLAGS[OPER - 1];
// 1980 %if Same(From, To)#0 %and Self(W, To, Oper)#0 %start
if (SAME(FROM, TO) == 0) goto L_0163;
if (SELF(W, TO, OPER) == 0) goto L_0163;
// 1981 Release and Drop(W) %unless W == Null {beware unary operators}
if (_imp_ADDR((void *)(W)) == _imp_ADDR((void *)(NULL))) goto L_0164;
RELEASEANDDROP(W);
L_0164:;
// 1982 %return
return;
// 1983 %finish
L_0163:;
// 1984 %if Flags&Commutative # 0 %start
if (FLAGS & 1 == 0) goto L_0165;
// 1985 %if Same(W, To)#0 %and Self(From, To, Oper)#0 %start
if (SAME(W, TO) == 0) goto L_0166;
if (SELF(FROM, TO, OPER) == 0) goto L_0166;
// 1986 Replace(From, To)
REPLACE(FROM, TO);
// 1987 Release and Drop(W)
RELEASEANDDROP(W);
// 1988 %return
return;
// 1989 %finish %else %if In Safe Reg(W)#0 %c
L_0166:;
if (INSAFEREG(W) == 0) goto L_0167;
if (INSAFEREG(FROM) == 0) goto L_0168;
if (KTIMES[FROM->BASE] >= KTIMES[W->BASE]) goto L_0167;
L_0168:;
// 1990+ %and (%not In Safe Reg(From)#0 %c
// 1991+ %or Ktimes(From_Base) < Ktimes(W_Base)) %start
// 1992 Reg_Data = From_Data
REG.DATA = FROM->DATA;
// 1993 From_Data = W_Data
FROM->DATA = W->DATA;
// 1994 W_Data = Reg_Data
W->DATA = REG.DATA;
// 1995 %finish
L_0167:;
// 1996 %finish
L_0165:;
// 1997 %if Flags&InPrim # 0 %start
if (FLAGS & 2 == 0) goto L_0169;
// 1998 Perm Operation(Oper, From, W) {sets FROM to describe the result}
PERMOPERATION(OPER, FROM, W);
// 1999 Drop(W)
DROP(W);
// 2000 Sout: Simple(From, To)
U_1003:;
SIMPLE(FROM, TO);
// 2001 %return
return;
// 2002 %finish
L_0169:;
// 2003 %if Oper >= RNEGx %start {floating-point operation}
if (OPER < 16) goto L_016A;
// 2004 Choose a register(Lreals)
CHOOSEAREGISTER(4);
// 2005 Simple(From, Reg)
SIMPLE(FROM, /*?*/ ®);
// 2006 %if Oper = RNEGx %start
if (OPER != 16) goto L_016B;
// 2007 Plant1(NEGF, From)
PLANT1(81, FROM);
// 2008 %finish %else %start
goto L_016C;
L_016B:;
// 2009 Equate Types(W, From, 0) %if W_Type # From_Type
if (W->TYPE == FROM->TYPE) goto L_016D;
EQUATETYPES(W, FROM, 0);
L_016D:;
// 2010 PlantF(Fop(Oper), From_Base, W)
PLANTF(FOP[OPER - 17], FROM->BASE, W);
// 2011 Release and drop(W)
RELEASEANDDROP(W);
// 2012 %finish
L_016C:;
// 2013 ->Sout
goto U_1003;
// 2014 %finish
L_016A:;
// 2015 %if Flags&Easy # 0 %start
if (FLAGS & 4 == 0) goto L_016E;
// 2016 Choose a register(Integers)
CHOOSEAREGISTER(1);
// 2017 Simple(From, Reg)
SIMPLE(FROM, /*?*/ ®);
// 2018 %if Oper <= NEGx %start
if (OPER > 2) goto L_016F;
// 2019 Plant1(Operation(Oper<<1+Integers), From)
PLANT1(OPERATION[(OPER << 1) + 1 - 3], FROM);
// 2020 %finish %else %start
goto L_0170;
L_016F:;
// 2021 %unless Flags&IncDec # 0 %and Incdec Done(W, From, Oper)#0 %start
if (FLAGS & 64 == 0) goto L_0171;
if (INCDECDONE(W, FROM, OPER) != 0) goto L_0172;
L_0171:;
// 2022 Loadup(W) %if W_Type = Bytes
if (W->TYPE != 2) goto L_0173;
LOADUP(W);
L_0173:;
// 2023 Plant2(Operation(Oper<<1+Integers), W, From)
PLANT2(OPERATION[(OPER << 1) + 1 - 3], W, FROM);
// 2024 %finish
L_0172:;
// 2025 Release and drop(W)
RELEASEANDDROP(W);
// 2026 %finish
L_0170:;
// 2027 ->Sout
goto U_1003;
// 2028 %finish
L_016E:;
// 2029
// 2030 {This leaves the nasties: MUL, DIV, REM, XOR, SHL, SHR, CONC}
// 2031
// 2032 ->Nasty(Oper)
NASTY_line = __LINE__;
NASTY_file = __FILE__;
NASTY_index = OPER;
goto case_NASTY_dispatch;
// 2033
// 2034 Nasty(XORx):Choose a register(Integers)
case_NASTY_10:;
CHOOSEAREGISTER(1);
// 2035 Simple(From, Reg)
SIMPLE(FROM, /*?*/ ®);
// 2036 Loadup(W)
LOADUP(W);
// 2037 PlantR(XOR, W_Base, From)
PLANTR(118, W->BASE, FROM);
// 2038 Release and drop(W)
RELEASEANDDROP(W);
// 2039 ->Sout
goto U_1003;
// 2040
// 2041 Nasty(MULx):Choose odd register
case_NASTY_5:;
CHOOSEODDREGISTER();
// 2042 Simple(From, Reg)
SIMPLE(FROM, /*?*/ ®);
// 2043 Loadup(W) %if W_Type = Bytes
if (W->TYPE != 2) goto L_0175;
LOADUP(W);
L_0175:;
// 2044 PlantR(MUL, From_Base, W)
PLANTR(77, FROM->BASE, W);
// 2045 Release and drop(W)
RELEASEANDDROP(W);
// 2046 ->Sout
goto U_1003;
// 2047
// 2048 Nasty(REMx):
case_NASTY_14:;
// 2049 Nasty(DIVx):Choose odd register
case_NASTY_6:;
CHOOSEODDREGISTER();
// 2050 Simple(From, Reg)
SIMPLE(FROM, /*?*/ ®);
// 2051 Odd = From_Base; Even = Odd-1
ODD = FROM->BASE;
EVEN = ODD - 1;
// 2052 Hazard(Even); Claim(Even)
HAZARD(EVEN);
CLAIM(EVEN);
// 2053 Test Zero(From)
TESTZERO(FROM);
// 2054 Plant1(SXT, RegV(Even)); Forget(Even)
PLANT1(112, /*?*/ ®V[EVEN - 1]);
FORGET(EVEN);
// 2055 Loadup(W) %if W_Type = Bytes
if (W->TYPE != 2) goto L_0176;
LOADUP(W);
L_0176:;
// 2056 PlantR(DIV, Even, W); Forget(Odd)
PLANTR(52, EVEN, W);
FORGET(ODD);
// 2057 Release and drop(W)
RELEASEANDDROP(W);
// 2058 From_Base = Even {assume DIVx}
FROM->BASE = EVEN;
// 2059 From_Base = Odd %if Oper = REMx
if (OPER != 14) goto L_0177;
FROM->BASE = ODD;
L_0177:;
// 2060 Release(Even+Odd-From_Base) {the other one}
RELEASE(EVEN + ODD - FROM->BASE);
// 2061 ->Sout
goto U_1003;
// 2062
// 2063 Nasty(LSHx):
case_NASTY_12:;
// 2064 Nasty(RSHx):
case_NASTY_13:;
// 2065 N = AnyG
N = 9;
// 2066 N = To_Base %if To_Form = VinR %and To_a_Scale = 0
if (TO->FORM != 0) goto L_0178;
if (TO->A.SCALE != 0) goto L_0178;
N = TO->BASE;
L_0178:;
// 2067 %if Shifted(W, From, N, Oper)=0 %start
if (SHIFTED(W, FROM, N, OPER) != 0) goto L_0179;
// 2068 loadup(w) %if W_Type = Bytes
if (W->TYPE != 2) goto L_017A;
LOADUP(W);
L_017A:;
// 2069 choose a register(integers)
CHOOSEAREGISTER(1);
// 2070 simple(from,reg)
SIMPLE(FROM, /*?*/ ®);
// 2071 %if Oper = RSHx %start
if (OPER != 13) goto L_017B;
// 2072 %if Const(W) = 0 %start
if (CONST(W) != 0) goto L_017C;
// 2073 loadup(w)
LOADUP(W);
// 2074 plant1(neg,w)
PLANT1(79, W);
// 2075 %finish %else %start
goto L_017D;
L_017C:;
// 2076 w_disp=-w_disp
W->DISP = -W->DISP;
// 2077 %finish
L_017D:;
// 2078 %finish
L_017B:;
// 2079 plantR(ash,from_base,w)
PLANTR(6, FROM->BASE, W);
// 2080 %finish
L_0179:;
// 2081 release and drop(w)
RELEASEANDDROP(W);
// 2082 ->sout
goto U_1003;
// 2083 ! N = AnyG
// 2084 ! N = To_Base %if To_Form = VinR
// 2085 ! Perm Operation(Oper, From, W) %unless Shifted(W, From, N, Oper)#0
// 2086 ! Drop(W)
// 2087 ! ->Sout
// 2088
// 2089 Nasty(CONCx):
case_NASTY_15:;
// 2090 %if From_Flags&In Work # 0 %start
if (FROM->FLAGS & 1 == 0) goto L_017E;
// 2091 Amap(From)
AMAP(FROM);
// 2092 %finish %else %start
goto L_017F;
L_017E:;
// 2093 To Work Area(From)
TOWORKAREA(FROM);
// 2094 %finish
L_017F:;
// 2095 From_Flags = From_Flags&(\In Work)
FROM->FLAGS = FROM->FLAGS & (~1);
// 2096 %while W ## Null %cycle
L_0180:;
if (_imp_ADDR((void *)(W)) == _imp_ADDR((void *)(NULL))) goto L_0181;
// 2097 V == W; W == W_Link
V = (struct STACKFM *)W;
W = (struct STACKFM *)W->LINK;
// 2098 V_Oper = 0; V_Link == Null
V->OPER = 0;
V->LINK = (struct STACKFM *)NULL;
// 2099 %if V_Type # Strings %start {Tostring}
if (V->TYPE == 5) goto L_0182;
// 2100 N = From_Format {max size}
N = FROM->FORMAT;
// 2101 Load(From, R2)
LOAD(FROM, 3);
// 2102 Cword(8_105212) {INCB_(R2)}
CWORD(35466);
// 2103 Forget(R2)
FORGET(3);
// 2104 Work == Record(Copy(From)); Release(R2)
WORK = (struct STACKFM *)_imp_RECORD(COPY(FROM));
RELEASE(3);
// 2105 Work_Type = Bytes
WORK->TYPE = 2;
// 2106 Work_Form = VinS
WORK->FORM = 1;
// 2107 Work_Flags = Work_Flags!Safe Byte %if 2 <= N <= 128
{
// Double-sided test on N (Part I)
int tmp;
if (2 > (tmp = N)) goto L_0183;
// Double-sided test on N (Part II)
if (tmp > 128) goto L_0183;
}
WORK->FLAGS = WORK->FLAGS | 128;
L_0183:;
// 2108 Loadup(Work)
LOADUP(WORK);
// 2109 Cword(8_060200+Actual(Work_Base)); Forget(Work_Base)
CWORD(24704 + ACTUAL[WORK->BASE]);
FORGET(WORK->BASE);
// 2110 Work_Type = Bytes; Work_Form = VinS
WORK->TYPE = 2;
WORK->FORM = 1;
// 2111 Move(V, Work)
MOVE(V, WORK);
// 2112 Release and Drop(Work); Release and Drop(V)
RELEASEANDDROP(WORK);
RELEASEANDDROP(V);
// 2113 N = N + 1
N = N + 1;
// 2114 %finish %else %start
goto L_0184;
L_0182:;
// 2115 N = From_Format + V_Format
N = FROM->FORMAT + V->FORMAT;
// 2116 Load(V, R1); Load(From, R2)
LOAD(V, 2);
LOAD(FROM, 3);
// 2117 Release and Drop(V); Release(R2)
RELEASEANDDROP(V);
RELEASE(3);
// 2118 Perm(Sconc)
PERM(1032);
// 2119 %finish
L_0184:;
// 2120 From_Format = N
FROM->FORMAT = N;
// 2121 Claim(R2)
CLAIM(3);
// 2122 %repeat
goto L_0180;
L_0181:;
// 2123 Simple(From, To) %unless To_Base = AnyG
if (TO->BASE == 9) goto L_0185;
SIMPLE(FROM, TO);
L_0185:;
// 2124 From_Flags = From_Flags!In Work
FROM->FLAGS = FROM->FLAGS | 1;
// 2125 %return
return;
// 2126
// 2127 Nasty(*): Fail("Operation")
case_NASTY_default:;
FAIL(_imp_str_literal_size(63, "Operation"));
// 2128 %end
return;
case_NASTY_dispatch:
if (NASTY_index < 3 || NASTY_index > 21)
_imp_signalf(6, 3, NASTY_index, "->NASTY(%d) out of bounds at %s line %d", NASTY_index, NASTY_file, NASTY_line);
goto *NASTY[NASTY_index - 3];
case_NASTY_missing:
_imp_signalf(8, 2, NASTY_index, "switch jump to undefined label NASTY(%d): at %s line %d", NASTY_index,
NASTY_file, NASTY_line);
} /* end of COMPLEX */
// 2129 %routine Move(%record(Stackfm)%name From, To)
void MOVE(struct STACKFM * FROM, struct STACKFM * TO) {
// 2130 {Move the object FROM into the destination TO}
// 2131 {FROM is updated and TO is left unaltered}
// 2132 %if From_Oper = 0 %then Simple (From, To) %c
if (FROM->OPER != 0) goto L_0186;
SIMPLE(FROM, TO);
goto L_0187;
L_0186:;
COMPLEX(FROM, TO);
L_0187:;
// 2133+ %else Complex(From, To)
// 2134 %end
return;
} /* end of MOVE */
// 2135 %routine Load(%record(Stackfm)%name V, %integer R)
void LOAD(struct STACKFM * V, int R) {
// 2136 Move(V, RegV(R))
MOVE(V, /*?*/ ®V[R - 1]);
// 2137 %end
return;
} /* end of LOAD */
// 2138 %routine Loadup(%record(Stackfm)%name V)
void LOADUP(struct STACKFM * V) {
// 2139 {load the value V into a suitable register depending on its type}
// 2140 %integer R
int R;
// 2141 %if Floating(V)#0 %then R = AnyF %c
if (FLOATING(V) == 0) goto L_0188;
R = 14;
goto L_0189;
L_0188:;
R = 9;
L_0189:;
// 2142+ %else R = AnyG
// 2143 Load(V, R)
LOAD(V, R);
// 2144 %end
return;
} /* end of LOADUP */
// 2145 %routine Load Base(%record(Stackfm)%name V)
void LOADBASE(struct STACKFM * V) {
// 2146 %record(Varfm) D
struct VARFM D;
// 2147 %record(Stackfm) T
struct STACKFM T;
// 2148 %return %if V_Base <= 128
if (V->BASE > 128) goto L_018A;
return;
L_018A:;
// 2149 Monitor(V, "LoadB") %if Diag&MonOperand # 0
if (DIAG & 8 == 0) goto L_018B;
MONITOR(V, _imp_str_literal_size(15, "LoadB"));
L_018B:;
// 2150 %if V_Base = Local %start
if (V->BASE != LOCAL) goto L_018C;
// 2151 V_Base = Lnb
V->BASE = 5;
// 2152 %finish %else %start
goto L_018D;
L_018C:;
// 2153 %if Uses Display = 0 %start
if (USESDISPLAY != 0) goto L_018E;
// 2154 External Id = "@DISPLAY"
_imp_strncpy(/*?*/ &EXTERNALID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("@DISPLAY");
(void *)&tmp;
}),
/*max:*/ 15);
// 2155 D_Form = VinS; Dump External(Dir Notex, D)
D.FORM = 1;
DUMPEXTERNAL(10, /*?*/ &D);
// 2156 Uses Display = D_Area
USESDISPLAY = D.AREA;
// 2157 %finish
L_018E:;
// 2158 Frame Use(V_Base) = 0 {show the level used}
FRAMEUSE[V->BASE - 128] = 0;
// 2159 T = 0
T = (struct STACKFM){0};
// 2160 T_Disp = (V_Base-128-1)*2
T.DISP = (V->BASE - 128 - 1) * 2;
// 2161 T_Type = Integers
T.TYPE = 1;
// 2162 T_Form = VinS
T.FORM = 1;
// 2163 T_Area = Uses Display
T.AREA = USESDISPLAY;
// 2164 Loadup(T)
LOADUP(/*?*/ &T);
// 2165 V_Base = T_Base
V->BASE = T.BASE;
// 2166 %finish
L_018D:;
// 2167 %end
return;
} /* end of LOADBASE */
// 2168 %routine Load Pair(%record(Stackfm)%name V1, V2)
void LOADPAIR(struct STACKFM * V1, struct STACKFM * V2) {
// 2169 {Loads V1 into R1 and V2 into R2}
// 2170 Load(V1, R1)
LOAD(V1, 2);
// 2171 Load(V2, R2)
LOAD(V2, 3);
// 2172 Load(V1, R1) %if V1_Base # R1 {in case of Hazard}
if (V1->BASE == 2) goto L_018F;
LOAD(V1, 2);
L_018F:;
// 2173 %end
return;
} /* end of LOADPAIR */
// 2174 %routine Push(%record(Stackfm)%name V)
void PUSH(struct STACKFM * V) {
// 2175 %record(Stackfm) S
struct STACKFM S;
// 2176 S = 0
S = (struct STACKFM){0};
// 2177 S_Base = DS; S_Type = Integers; S_Form = Ainc
S.BASE = 6;
S.TYPE = 1;
S.FORM = 2;
// 2178 Move(V, S)
MOVE(V, /*?*/ &S);
// 2179 %end
return;
} /* end of PUSH */
// 2180 %routine Constant Operation(%integer Op, %integername L,
void CONSTANTOPERATION(int OP, int *L, struct STACKFM *R) {
// 2181+ %record(Stackfm)%name R)
// 2182 %switch Cop(NOTX:REXPX)
int COP_index;
int COP_line;
char *COP_file;
static const void *COP[21] = {&&case_COP_missing, &&case_COP_missing, &&case_COP_missing, &&case_COP_missing,
&&case_COP_missing, &&case_COP_missing, &&case_COP_missing, &&case_COP_missing,
&&case_COP_missing, &&case_COP_missing, &&case_COP_missing, &&case_COP_missing,
&&case_COP_missing, &&case_COP_missing, &&case_COP_missing, &&case_COP_missing,
&&case_COP_missing, &&case_COP_missing, &&case_COP_missing, &&case_COP_missing,
&&case_COP_missing};
// 2183 %integer N
int N;
// 2184 N = R_Disp
N = R->DISP;
// 2185 Drop(R)
DROP(R);
// 2186 ->Cop(Op)
COP_line = __LINE__;
COP_file = __FILE__;
COP_index = OP;
goto case_COP_dispatch;
// 2187 Cop(ADDX): L = L+N; ->Out
case_COP_3:;
*L = *L + N;
goto U_1004;
// 2188 Cop(SUBX): L = L-N; ->Out
case_COP_4:;
*L = *L - N;
goto U_1004;
// 2189 Cop(MULX): L = L*N; ->Out
case_COP_5:;
*L = *L * N;
goto U_1004;
// 2190 Cop(BICx): L = L&(\N); ->Out
case_COP_11:;
*L = *L & (~N);
goto U_1004;
// 2191 Cop( ORX): L = L!N; ->Out
case_COP_9:;
*L = *L | N;
goto U_1004;
// 2192 Cop(XORX): L = L!!N; ->Out
case_COP_10:;
*L = *L ^ N;
goto U_1004;
// 2193 Cop(LSHX): L = L<<N; ->Out
case_COP_12:;
*L = *L << N;
goto U_1004;
// 2194 Cop(RSHX): L = (L&16_ffff)>>N; ->Out
case_COP_13:;
*L = (unsigned int)(*L & 65535) >> N;
goto U_1004;
// 2195 Cop(EXPX): Fail("Exp") %if N < 0; L = L\\N; ->Out
case_COP_7:;
if (N >= 0) goto L_0191;
FAIL(_imp_str_literal_size(63, "Exp"));
L_0191:;
*L = _imp_IEXP(*L, N);
goto U_1004;
// 2196 Cop(REMx): Fail("Zero divide") %if N = 0; L = L-L//N*N; ->Out
case_COP_14:;
if (N != 0) goto L_0192;
FAIL(_imp_str_literal_size(63, "Zero divide"));
L_0192:;
*L = *L - ((long)*L / (long)N) * N;
goto U_1004;
// 2197 Cop(DIVX): Fail("Zero divide") %if N = 0; L = L//N; ->Out
case_COP_6:;
if (N != 0) goto L_0193;
FAIL(_imp_str_literal_size(63, "Zero divide"));
L_0193:;
*L = ((long)*L / (long)N);
goto U_1004;
// 2198 Cop(*): Fail("C-op")
case_COP_default:;
FAIL(_imp_str_literal_size(63, "C-op"));
// 2199 Out:
U_1004:;
// 2200 %end
return;
case_COP_dispatch:
if (COP_index < 1 || COP_index > 21)
_imp_signalf(6, 3, COP_index, "->COP(%d) out of bounds at %s line %d", COP_index, COP_file, COP_line);
goto *COP[COP_index - 1];
case_COP_missing:
_imp_signalf(8, 2, COP_index, "switch jump to undefined label COP(%d): at %s line %d", COP_index, COP_file,
COP_line);
} /* end of CONSTANTOPERATION */
// 2201 %routine Operate(%integer Oper, %record(Stackfm)%name Lhs, Rhs)
void OPERATE(int OPER, struct STACKFM *LHS, struct STACKFM *RHS) {
// 2202 %integer Op, Rconst, Key, Lflags, Rflags, N
int OP;
int RCONST;
int KEY;
int LFLAGS;
int RFLAGS;
int N;
// 2203 %record(Stackfm)%name W
struct STACKFM *W;
// 2204
// 2205 %routine Swop
void SWOP(void) {
// 2206 %record(Stackfm) Temp
struct STACKFM TEMP;
// 2207 Temp_Data = Lhs_Data
TEMP.DATA = LHS->DATA;
// 2208 Lhs_Data = Rhs_Data
LHS->DATA = RHS->DATA;
// 2209 Rhs_Data = Temp_Data
RHS->DATA = TEMP.DATA;
// 2210 %end
return;
} /* end of SWOP */
// 2211 %routine Reduce Constant
void REDUCECONSTANT(void) {
// 2212 %integer Op, N, F
int OP;
int N;
int F;
// 2213 %routine Fix(%integer Op)
void FIX(int OP) {
// 2214 Lhs_Oper = Op
LHS->OPER = OP;
// 2215 Drop(Lhs_Link)
DROP(LHS->LINK);
// 2216 Lhs_Link == Null
LHS->LINK = (struct STACKFM *)NULL;
// 2217 %end
return;
} /* end of FIX */
// 2218 Op = Lhs_Oper; F = Oper Flags(Op)
OP = LHS->OPER;
F = OPERFLAGS[OP - 1];
// 2219 N = Lhs_Link_Disp
N = LHS->LINK->DISP;
// 2220 %if F&Nullop # 0 %and Null Value(Op) = N %start
if (F & 512 == 0) goto L_0194;
if (NULLVALUE[OP - 3] != N) goto L_0194;
// 2221 Fix(0)
FIX(0);
// 2222 %finish %else %if Op = MULx %start
goto L_0195;
L_0194:;
if (OP != 5) goto L_0196;
// 2223 %if N = 0 %start
if (N != 0) goto L_0197;
// 2224 Fix(0)
FIX(0);
// 2225 Release(Lhs_Base)
RELEASE(LHS->BASE);
// 2226 Lhs_Form = VinR; Lhs_Base = 0; Lhs_Disp = 0; Lhs_Area = 0
LHS->FORM = 0;
LHS->BASE = 0;
LHS->DISP = 0;
LHS->AREA = 0;
// 2227 %finish %else %if N = -1 %start
goto L_0198;
L_0197:;
if (N != -1) goto L_0199;
// 2228 Fix(NEGX)
FIX(2);
// 2229 %finish %else %start
goto L_0198;
L_0199:;
// 2230 N = Power(N)
N = POWER(N);
// 2231 %if N > 0 %start
if (N <= 0) goto L_019A;
// 2232 Lhs_Link_Disp = N
LHS->LINK->DISP = N;
// 2233 Lhs_Oper = LSHX
LHS->OPER = 12;
// 2234 %finish
L_019A:;
// 2235 %finish
L_0198:;
// 2236 %finish %else %if Op = XORX %and N = -1 %start
goto L_0195;
L_0196:;
if (OP != 10) goto L_019B;
if (N != -1) goto L_019B;
// 2237 Fix(NOTX)
FIX(1);
// 2238 %finish %else %if Op = BICx %and N&x'FF00' = 0 %start
goto L_0195;
L_019B:;
if (OP != 11) goto L_019C;
if (N & 65280 != 0) goto L_019C;
// 2239 Lhs_Flags = Lhs_Flags!Safe Byte %if Lhs_Type = Bytes
if (LHS->TYPE != 2) goto L_019D;
LHS->FLAGS = LHS->FLAGS | 128;
L_019D:;
// 2240 %finish
L_019C:;
L_0195:;
// 2241 %end
return;
} /* end of REDUCECONSTANT */
// 2242
// 2243 %if Diag&MonOperate # 0 %start
if (DIAG & 16 == 0) goto L_019E;
// 2244 Monitor(Lhs, "O-Lhs")
MONITOR(LHS, _imp_str_literal_size(15, "O-Lhs"));
// 2245 Monitor(Rhs, "O-Rhs")
MONITOR(RHS, _imp_str_literal_size(15, "O-Rhs"));
// 2246 %finish
L_019E:;
// 2247 Rflags = Oper Flags(Oper)
RFLAGS = OPERFLAGS[OPER - 1];
// 2248 %if Rflags&Unary # 0 %start
if (RFLAGS & 32 == 0) goto L_019F;
// 2249 %if Const(Lhs)#0 %start {this excludes reals}
if (CONST(LHS) == 0) goto L_01A0;
// 2250 %if Oper = NEGX %start
if (OPER != 2) goto L_01A1;
// 2251 Lhs_Disp = -Lhs_Disp
LHS->DISP = -LHS->DISP;
// 2252 %finish %else %if Oper = NOTX %start
goto L_01A2;
L_01A1:;
if (OPER != 1) goto L_01A3;
// 2253 Lhs_Disp = \Lhs_Disp
LHS->DISP = (~LHS->DISP);
// 2254 %finish %else Fail("Operator")
goto L_01A2;
L_01A3:;
FAIL(_imp_str_literal_size(63, "Operator"));
L_01A2:;
// 2255 %finish %else %start
goto L_01A4;
L_01A0:;
// 2256 Oper = RNEGx %if Floating(Lhs)#0
if (FLOATING(LHS) == 0) goto L_01A5;
OPER = 16;
L_01A5:;
// 2257 %if Lhs_Oper # 0 %start
if (LHS->OPER == 0) goto L_01A6;
// 2258 %if Lhs_Oper = Oper %start {e.g. -(-A) }
if (LHS->OPER != OPER) goto L_01A7;
// 2259 Lhs_Oper = 0 {this must catch reals}
LHS->OPER = 0;
// 2260 ->Mon
goto U_1003;
// 2261 %finish
L_01A7:;
// 2262 %if Lhs_Oper = NEGx %or Lhs_Oper = NOTx %start
if (LHS->OPER == 2) goto L_01A8;
if (LHS->OPER != 1) goto L_01A9;
L_01A8:;
// 2263 { -(\A) -> A+1 Note: -NEG = ADD }
// 2264 { \(-A) -> A-1 -NOT = SUB }
// 2265 Lhs_Oper = 0
LHS->OPER = 0;
// 2266 %if Oper = NEGx %then Oper = ADDx %else Oper = SUBx
if (OPER != 2) goto L_01AA;
OPER = 3;
goto L_01AB;
L_01AA:;
OPER = 4;
L_01AB:;
// 2267 Operate(Oper, Lhs, Record(Literal(1)))
OPERATE(OPER, LHS, _imp_RECORD(LITERAL(1)));
// 2268 ->Mon
goto U_1003;
// 2269 %finish
L_01A9:;
// 2270 Loadup(Lhs)
LOADUP(LHS);
// 2271 %finish
L_01A6:;
// 2272 Lhs_Oper = Oper; Lhs_Link == Null
LHS->OPER = OPER;
LHS->LINK = (struct STACKFM *)NULL;
// 2273 %finish
L_01A4:;
// 2274 ->Mon
goto U_1003;
// 2275 %finish
L_019F:;
// 2276
// 2277 %if Oper = ConcX %start
if (OPER != 15) goto L_01AC;
// 2278 Lhs == Lhs_Link %while Lhs_Oper # 0 {skip to the end}
L_01AD:;
if (LHS->OPER == 0) goto L_01AE;
LHS = (struct STACKFM *)LHS->LINK;
goto L_01AD;
L_01AE:;
// 2279 Lhs_Oper = ConcX; Lhs_Link == Rhs {append the new bit}
LHS->OPER = 15;
LHS->LINK = (struct STACKFM *)RHS;
// 2280 ->Mon
goto U_1003;
// 2281 %finish
L_01AC:;
// 2282
// 2283 Swop %if Rflags&Commutative # 0 %and Const(Lhs)#0 {1@? -> ?@1}
if (RFLAGS & 1 == 0) goto L_01AF;
if (CONST(LHS) == 0) goto L_01AF;
SWOP();
L_01AF:;
// 2284
// 2285 %if Oper = ANDx %start
if (OPER != 8) goto L_01B0;
// 2286 Operate(NOTx, Rhs, Null)
OPERATE(1, RHS, NULL);
// 2287 Operate(BICx, Lhs, Rhs)
OPERATE(11, LHS, RHS);
// 2288 %return
return;
// 2289 %finish
L_01B0:;
// 2290
// 2291 %if Rhs_Oper # 0 %start
if (RHS->OPER == 0) goto L_01B1;
// 2292 Op = Rhs_Oper
OP = RHS->OPER;
// 2293 %if Op = NEGx %and (Oper = ADDx %or Oper = SUBx) %start
if (OP != 2) goto L_01B2;
if (OPER == 3) goto L_01B3;
if (OPER != 4) goto L_01B2;
L_01B3:;
// 2294 { Lhs + (-Rhs) }
// 2295 Oper = (ADDx+SUBx)-Op { Lhs - Rhs }
OPER = 3 + 4 - OP;
// 2296 %finish %else %start
goto L_01B4;
L_01B2:;
// 2297 Loadup(Rhs)
LOADUP(RHS);
// 2298 %finish
L_01B4:;
// 2299 Rhs_Oper = 0
RHS->OPER = 0;
// 2300 %finish
L_01B1:;
// 2301
// 2302 %if Const(Rhs)#0 %start
if (CONST(RHS) == 0) goto L_01B5;
// 2303 Rconst = 1
RCONST = 1;
// 2304 %if Oper = SUBX %start { Lhs-(+const) }
if (OPER != 4) goto L_01B6;
// 2305 Rhs_Disp = -Rhs_Disp
RHS->DISP = -RHS->DISP;
// 2306 Oper = ADDX { Lhs+(-const) }
OPER = 3;
// 2307 %finish
L_01B6:;
// 2308 %finish %else %start
goto L_01B7;
L_01B5:;
// 2309 Rconst = 0
RCONST = 0;
// 2310 %finish
L_01B7:;
// 2311
// 2312 %if Lhs_Oper # 0 %start
if (LHS->OPER == 0) goto L_01B8;
// 2313 Op = Lhs_Oper; Lflags = Oper Flags(Op)
OP = LHS->OPER;
LFLAGS = OPERFLAGS[OP - 1];
// 2314 W == Lhs_Link
W = (struct STACKFM *)LHS->LINK;
// 2315 %if Op = NEGx %and Oper = MULx %start
if (OP != 2) goto L_01B9;
if (OPER != 5) goto L_01B9;
// 2316 Lhs_Oper = 0
LHS->OPER = 0;
// 2317 Operate(MULx, Lhs, Rhs)
OPERATE(5, LHS, RHS);
// 2318 Operate(NEGx, Lhs, Null)
OPERATE(2, LHS, NULL);
// 2319 %return
return;
// 2320 %finish
L_01B9:;
// 2321 %if Lflags&Unary = 0 %and Const(W)#0 %start
if (LFLAGS & 32 != 0) goto L_01BA;
if (CONST(W) == 0) goto L_01BA;
// 2322 %if Rconst # 0 %start
if (RCONST == 0) goto L_01BB;
// 2323 Key = (Lflags!Rflags)&Assoc Mask
KEY = (LFLAGS | RFLAGS) & 384;
// 2324 %if Key = 0 {strongly associative} %or %c
if (KEY == 0) goto L_01BC;
if (KEY != 256) goto L_01BD;
if (OPER != OP) goto L_01BD;
L_01BC:;
// 2325+ (Key = Weak Assoc {weakly associative} %and Oper = Op) %start
// 2326 %if Rhs_Base = 0 %or Oper = ADDX %start
if (RHS->BASE == 0) goto L_01BE;
if (OPER != 3) goto L_01BF;
L_01BE:;
// 2327 Constant Operation(Oper, W_Disp, Rhs)
CONSTANTOPERATION(OPER, /*?*/ &W->DISP, RHS);
// 2328 Reduce Constant %if Rhs_Base = 0
if (RHS->BASE != 0) goto L_01C0;
REDUCECONSTANT();
L_01C0:;
// 2329 ->Mon
goto U_1003;
// 2330 %finish
L_01BF:;
// 2331 %finish
L_01BD:;
// 2332 %if Op = ADDx %and Oper = MULx %start { (A+c)*m -> Am+cm }
if (OP != 3) goto L_01C1;
if (OPER != 5) goto L_01C1;
// 2333 W_Disp = W_Disp*Rhs_Disp
W->DISP = W->DISP * RHS->DISP;
// 2334 Lhs_Link == Null; Lhs_Oper = 0
LHS->LINK = (struct STACKFM *)NULL;
LHS->OPER = 0;
// 2335 Operate(MULx, Lhs, Rhs)
OPERATE(5, LHS, RHS);
// 2336 Operate(ADDx, Lhs, W)
OPERATE(3, LHS, W);
// 2337 %return
return;
// 2338 %finish
L_01C1:;
// 2339 %finish
L_01BB:;
// 2340 %finish
L_01BA:;
// 2341 Loadup(Lhs) {no other choice}
LOADUP(LHS);
// 2342 %finish
L_01B8:;
// 2343
// 2344 %if Const(Lhs)#0 %and Rconst # 0 %start
if (CONST(LHS) == 0) goto L_01C2;
if (RCONST == 0) goto L_01C2;
// 2345 Constant Operation(Oper, Lhs_Disp, Rhs)
CONSTANTOPERATION(OPER, /*?*/ &LHS->DISP, RHS);
// 2346 ->Mon
goto U_1003;
// 2347 %finish
L_01C2:;
// 2348 %if Lhs_Type >= Reals %or Rhs_Type >= Reals %start
if (LHS->TYPE >= 3) goto L_01C3;
if (RHS->TYPE < 3) goto L_01C4;
L_01C3:;
// 2349 Oper = Oper+Real Shift %unless Oper >= RNEGx
if (OPER >= 16) goto L_01C5;
OPER = OPER + 14;
L_01C5:;
// 2350 %finish %else %if Rhs_Form = VinR %and Rhs_A_Scale = 0 %and %c
goto L_01C6;
L_01C4:;
if (RHS->FORM != 0) goto L_01C7;
if (RHS->A.SCALE != 0) goto L_01C7;
if (OPER == 3) goto L_01C8;
if (OPER != 4) goto L_01C7;
L_01C8:;
// 2351+ (Oper = ADDx %or Oper = SUBx) %start
// 2352 %if Lhs_Form = VinR %and Lhs_A_Scale = 0 %and Lhs_Area = 0 %start
if (LHS->FORM != 0) goto L_01C9;
if (LHS->A.SCALE != 0) goto L_01C9;
if (LHS->AREA != 0) goto L_01C9;
// 2353 N = Rhs_Disp; Rhs_Disp = 0
N = RHS->DISP;
RHS->DISP = 0;
// 2354 N = -N %if Oper = SUBx
if (OPER != 4) goto L_01CA;
N = -N;
L_01CA:;
// 2355 N = N+Lhs_Disp
N = N + LHS->DISP;
// 2356 %if Rhs_Base = 0 %start
if (RHS->BASE != 0) goto L_01CB;
// 2357 Lhs_Area = Rhs_Area
LHS->AREA = RHS->AREA;
// 2358 Drop(Rhs)
DROP(RHS);
// 2359 %finish %else %start
goto L_01CC;
L_01CB:;
// 2360 Lhs_Disp = 0
LHS->DISP = 0;
// 2361 Lhs_Oper = Oper; Lhs_Link == Rhs; Loadup(Lhs)
LHS->OPER = OPER;
LHS->LINK = (struct STACKFM *)RHS;
LOADUP(LHS);
// 2362 %finish
L_01CC:;
// 2363 Lhs_Disp = N
LHS->DISP = N;
// 2364 ->Mon
goto U_1003;
// 2365 %finish
L_01C9:;
// 2366 %finish
L_01C7:;
L_01C6:;
// 2367 %if Rflags&Commutative # 0 %and InReg(Rhs)#0 %start
if (RFLAGS & 1 == 0) goto L_01CD;
if (INREG(RHS) == 0) goto L_01CD;
// 2368 Swop
SWOP();
// 2369 Rconst = 0
RCONST = 0;
// 2370 Rconst = 1 %if Const(Rhs)#0
if (CONST(RHS) == 0) goto L_01CE;
RCONST = 1;
L_01CE:;
// 2371 %finish
L_01CD:;
// 2372 Lhs_Oper = Oper; Lhs_Link == Rhs
LHS->OPER = OPER;
LHS->LINK = (struct STACKFM *)RHS;
// 2373 Reduce Constant %if Rconst # 0
if (RCONST == 0) goto L_01CF;
REDUCECONSTANT();
L_01CF:;
// 2374 Mon:
U_1003:;
// 2375 Monitor(Lhs, "Operate") %if Diag&MonOperate # 0
if (DIAG & 16 == 0) goto L_01D0;
MONITOR(LHS, _imp_str_literal_size(15, "Operate"));
L_01D0:;
// 2376 %end
return;
} /* end of OPERATE */
// 2377 %routine Modulus
void MODULUS(void) {
// 2378 Loadup(Stack); Protect(Stack)
LOADUP(STACK);
PROTECT(STACK);
// 2379 %if Floating(Stack)#0 %start
if (FLOATING(STACK) == 0) goto L_01D1;
// 2380 Plant1(ABSF, Stack)
PLANT1(1, STACK);
// 2381 %finish %else %start
goto L_01D2;
L_01D1:;
// 2382 Test Zero(Stack)
TESTZERO(STACK);
// 2383 Cword(8_002001) {BGE_.+1}
CWORD(1025);
// 2384 Plant1(NEGX, Stack)
PLANT1(2, STACK);
// 2385 %finish
L_01D2:;
// 2386 %end
return;
} /* end of MODULUS */
// 2387 %routine Aop
void AOP(void) {
// 2388 Array Access
ARRAYACCESS();
// 2389 Stack_A_Flags = Stack_A_Flags&(\Indirect)
STACK->A.FLAGS = STACK->A.FLAGS & (~8);
// 2390 Stack_A_Flags = Stack_A_Flags!Arrayname
STACK->A.FLAGS = STACK->A.FLAGS | 64;
// 2391 %end
return;
} /* end of AOP */
// 2392
// 2393 {***Register optimisation routines***}
// 2394
// 2395 {%predicate}
// 2396 %integerfn Memorable(%record(Stackfm)%name V, %record(Datafm)%name K)
int MEMORABLE(struct STACKFM * V, struct DATAFM * K) {
// 2397 %integer F
int F;
// 2398 %result=0 %if V_Oper # 0
if (V->OPER == 0) goto L_01D3;
return 0;
L_01D3:;
// 2399 %if V_Form = VinR %start
if (V->FORM != 0) goto L_01D4;
// 2400 %if V_Base = 0 %start {constant}
if (V->BASE != 0) goto L_01D5;
// 2401 F = 0
F = 0;
// 2402 %finish %else %if V_Disp # 0 %start {address of variable}
goto L_01D6;
L_01D5:;
if (V->DISP == 0) goto L_01D7;
// 2403 F = 1
F = 1;
// 2404 %finish %else %result=0
goto L_01D6;
L_01D7:;
return 0;
L_01D6:;
// 2405 %finish %else %if V_Form = VinS %start {variable direct}
goto L_01D8;
L_01D4:;
if (V->FORM != 1) goto L_01D9;
// 2406 F = 2
F = 2;
// 2407 %finish %else %if V_Form = VinX %start {variable indirect/record direct}
goto L_01D8;
L_01D9:;
if (V->FORM != 4) goto L_01DA;
// 2408 F = 3 {indirect}
F = 3;
// 2409 F = 5 %if V_Disp # 0 {direct}
if (V->DISP == 0) goto L_01DB;
F = 5;
L_01DB:;
// 2410 %finish %else %start {record indirect}
goto L_01D8;
L_01DA:;
// 2411 F = 6
F = 6;
// 2412 %finish
L_01D8:;
// 2413 K_V = V_V
K->V = V->V;
// 2414 K_V_Form = F
K->V.FORM = F;
// 2415 K_A = V_A
K->A = V->A;
// 2416 %result=-1
return -1;
// 2417 %end
} /* end of MEMORABLE */
// 2418 %routine Optimise(%record(Stackfm)%name V, %integer Mode)
void OPTIMISE(struct STACKFM * V, int MODE) {
// 2419 {Mode = 0 if destination (address) wanted}
// 2420 { = 1 if source (value) wanted}
// 2421 %record(Datafm)%name P
struct DATAFM *P;
// 2422 %record(Datafm) M
struct DATAFM M;
// 2423 %record(stackfm)%name W
struct STACKFM *W;
// 2424 %integer F, Bias, Op
int F;
int BIAS;
int OP;
// 2425
// 2426 %routine Set(%integer Form)
void SET(int FORM) {
// 2427 Release(V_Base); Release(V_A_Base)
RELEASE(V->BASE);
RELEASE(V->A.BASE);
// 2428 V_Data = 0
V->DATA = (struct STACKFM){0};
// 2429 V_Type = P_V_Type
V->TYPE = P->V.TYPE;
// 2430 V_Form = Form
V->FORM = FORM;
// 2431 %if Form = VinR %start
if (FORM != 0) goto L_01DC;
// 2432 V_Type = Integers %if V_Type = Bytes
if (V->TYPE != 2) goto L_01DD;
V->TYPE = 1;
L_01DD:;
// 2433 V_Type = Lreals %if V_Type = Reals
if (V->TYPE != 3) goto L_01DE;
V->TYPE = 4;
L_01DE:;
// 2434 %finish
L_01DC:;
// 2435 V_Disp = 0
V->DISP = 0;
// 2436 V_Bias = Bias
V->BIAS = BIAS;
// 2437 V_Base = P_Reg; Claim(V_Base)
V->BASE = P->REG;
CLAIM(V->BASE);
// 2438 Monitor(V, "Opt'd") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_01DF;
MONITOR(V, _imp_str_literal_size(15, "Opt'd"));
L_01DF:;
// 2439 %end
return;
} /* end of SET */
// 2440
// 2441 Monitor(V, "Opt") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_01E0;
MONITOR(V, _imp_str_literal_size(15, "Opt"));
L_01E0:;
// 2442 Bias = V_Bias
BIAS = V->BIAS;
// 2443 P == Knowing; %return %if P == Null {nothing known}
P = (struct DATAFM *)KNOWING;
if (_imp_ADDR((void *)(P)) != _imp_ADDR((void *)(NULL))) goto L_01E1;
return;
L_01E1:;
// 2444 %if V_Oper # 0 %start
if (V->OPER == 0) goto L_01E2;
// 2445 Op = V_Oper; V_Oper = 0
OP = V->OPER;
V->OPER = 0;
// 2446 W == V_Link; V_Link == Null
W = (struct STACKFM *)V->LINK;
V->LINK = (struct STACKFM *)NULL;
// 2447 Optimise(V, Mode); Optimise(W, Mode) %unless W == Null
OPTIMISE(V, MODE);
if (_imp_ADDR((void *)(W)) == _imp_ADDR((void *)(NULL))) goto L_01E3;
OPTIMISE(W, MODE);
L_01E3:;
// 2448 V_Oper = Op; V_Link == W
V->OPER = OP;
V->LINK = (struct STACKFM *)W;
// 2449 %return
return;
// 2450 %finish
L_01E2:;
// 2451 %return %unless Memorable(V, M)#0 {worth looking for?}
if (MEMORABLE(V, /*?*/ &M) != 0) goto L_01E4;
return;
L_01E4:;
// 2452 %cycle
L_01E5:;
// 2453 %if P_V_Disp = M_V_Disp %and P_V_Base = M_V_Base %and %c
if (P->V.DISP != M.V.DISP) goto L_01E6;
if (P->V.BASE != M.V.BASE) goto L_01E6;
if (P->V.TYPE != M.V.TYPE) goto L_01E6;
if (P->V.AREA != M.V.AREA) goto L_01E6;
if (P->V.EXTRA != M.V.EXTRA) goto L_01E6;
if (P->A.SCALE != M.A.SCALE) goto L_01E6;
// 2454+ P_V_Type = M_V_Type %and P_V_Area = M_V_Area %and %c
// 2455+ P_V_Extra = M_V_Extra %and P_A_Scale = M_A_Scale %start
// 2456 {Basically ok, now check for arrays}
// 2457 %if M_A_Scale # 0 %start {an array index wanted}
if (M.A.SCALE == 0) goto L_01E7;
// 2458 %if P_A_Base = M_A_Base %and P_A_Area = M_A_Area %and %c
if (P->A.BASE != M.A.BASE) goto L_01E8;
if (P->A.AREA != M.A.AREA) goto L_01E8;
if (P->A.FORM != M.A.FORM) goto L_01E8;
if (P->A.EXTRA != M.A.EXTRA) goto L_01E8;
if (P->V.FORM != M.V.FORM) goto L_01E8;
// 2459+ P_A_Form = M_A_Form %and P_A_Extra = M_A_Extra %and %c
// 2460+ P_V_Form = M_V_Form %start
// 2461 %if Mode # 0 %start
if (MODE == 0) goto L_01E9;
// 2462 %if P_A_Type # Alhs %and P_A_Disp = M_A_Disp %start
if (P->A.TYPE == 9) goto L_01EA;
if (P->A.DISP != M.A.DISP) goto L_01EA;
// 2463 Set VinR: Set(VinR)
U_1003:;
SET(0);
// 2464 %return
return;
// 2465 %finish
L_01EA:;
// 2466 %finish %else %if P_A_Type = Alhs %start
goto L_01EB;
L_01E9:;
if (P->A.TYPE != 9) goto L_01EC;
// 2467 %if M_A_Form = VinS %or M_A_Form = VinX %start
if (M.A.FORM == 1) goto L_01ED;
if (M.A.FORM != 4) goto L_01EE;
L_01ED:;
// 2468 Bias = Bias+M_A_Disp; M_A_Disp = 0
BIAS = BIAS + M.A.DISP;
M.A.DISP = 0;
// 2469 ->Set VinR
goto U_1003;
// 2470 %finish %else %if M_A_Disp = P_A_Disp %start
L_01EE:;
if (M.A.DISP != P->A.DISP) goto L_01EF;
// 2471 ->Set VinR
goto U_1003;
// 2472 %finish
L_01EF:;
// 2473 %finish
L_01EC:;
L_01EB:;
// 2474 %finish
L_01E8:;
// 2475 %finish %else %start
goto L_01F0;
L_01E7:;
// 2476 F = P_V_Form
F = P->V.FORM;
// 2477 %if F = M_V_Form %and Mode # 0 %start {exact match}
if (F != M.V.FORM) goto L_01F1;
if (MODE == 0) goto L_01F1;
// 2478 ->Set VinR
goto U_1003;
// 2479 %finish %else %if F+1 = M_V_Form %start {address in register}
L_01F1:;
if (F + 1 != M.V.FORM) goto L_01F2;
// 2480 Set(VinS)
SET(1);
// 2481 Optimise(V, Mode) %if Mode # 0
if (MODE == 0) goto L_01F3;
OPTIMISE(V, MODE);
L_01F3:;
// 2482 %return
return;
// 2483 %finish
L_01F2:;
// 2484 %finish
L_01F0:;
// 2485 %finish
L_01E6:;
// 2486 P == P_Link
P = (struct DATAFM *)P->LINK;
// 2487 %repeat %until P == Null
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(NULL))) goto L_01F4;
goto L_01E5;
L_01F4:;
// 2488 %end
return;
} /* end of OPTIMISE */
// 2489 {%record(Datafm)%map}
// 2490 %integerfn NewK
int NEWK(void) {
// 2491 %record(Datafm)%name P
struct DATAFM *P;
// 2492 P == Kasl_Link
P = (struct DATAFM *)KASL.LINK;
// 2493 %if P ## Null %start
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(NULL))) goto L_01F5;
// 2494 Kasl_Link == P_Link
KASL.LINK = (struct DATAFM *)P->LINK;
// 2495 Ktail == Kasl %if Kasl_Link == Null
if (_imp_ADDR((void *)(KASL.LINK)) != _imp_ADDR((void *)(NULL))) goto L_01F6;
KTAIL = (struct DATAFM *)/*?*/ &KASL;
L_01F6:;
// 2496 P_Label = 0 {invalidate any environment information}
P->LABEL = 0;
// 2497 %finish
L_01F5:;
// 2498 %result = Addr(P)
return _imp_ADDR(P);
// 2499 %end
} /* end of NEWK */
// 2500 %routine Forget Everything
void FORGETEVERYTHING(void) {
// 2501 %record(Datafm)%name K
struct DATAFM *K;
// 2502 K == Knowing
K = (struct DATAFM *)KNOWING;
// 2503 %if K ## Null %start
if (_imp_ADDR((void *)(K)) == _imp_ADDR((void *)(NULL))) goto L_01F7;
// 2504 K == K_Link %while K_Link ## Null
L_01F8:;
if (_imp_ADDR((void *)(K->LINK)) == _imp_ADDR((void *)(NULL))) goto L_01F9;
K = (struct DATAFM *)K->LINK;
goto L_01F8;
L_01F9:;
// 2505 Ktail_Link == Knowing
KTAIL->LINK = (struct DATAFM *)KNOWING;
// 2506 Ktail == K
KTAIL = (struct DATAFM *)K;
// 2507 Knowing == Null
KNOWING = (struct DATAFM *)NULL;
// 2508 %finish
L_01F7:;
// 2509 Used(R0) = 0; Used(R1) = 0; Used(R2) = 0; Used(R3) = 0
USED[1] = 0;
USED[2] = 0;
USED[3] = 0;
USED[4] = 0;
// 2510 Ktimes(R0) = 0; Ktimes(R1) = 0; Ktimes(R2) = 0; Ktimes(R3) = 0
KTIMES[1] = 0;
KTIMES[2] = 0;
KTIMES[3] = 0;
KTIMES[4] = 0;
// 2511 Used(F0) = 0; Used(F1) = 0; Used(F2) = 0; Used(F3) = 0
USED[10] = 0;
USED[11] = 0;
USED[12] = 0;
USED[13] = 0;
// 2512 Ktimes(F0) = 0; Ktimes(F1) = 0; Ktimes(F2) = 0; Ktimes(F3) = 0
KTIMES[10] = 0;
KTIMES[11] = 0;
KTIMES[12] = 0;
KTIMES[13] = 0;
// 2513 Cc1_Cc Ca = -1; Cc2_Cc Ca = -1; Z Ca = -1
CC1.CCCA = -1;
CC2.CCCA = -1;
ZCA = -1;
// 2514 Ktimes(Cc Lhs) = 0; Ktimes(Cc Rhs) = 0
KTIMES[15] = 0;
KTIMES[16] = 0;
// 2515 %end
return;
} /* end of FORGETEVERYTHING */
// 2516 %routine IncK(%integer R)
void INCK(int R) {
// 2517 Ktimes(R) = Ktimes(R)+1 %if R&128 = 0
if (R & 128 != 0) goto L_01FA;
KTIMES[R] = KTIMES[R] + 1;
L_01FA:;
// 2518 %end
return;
} /* end of INCK */
// 2519 %routine Kinc(%record(Datafm)%name K)
void KINC(struct DATAFM * K) {
// 2520 IncK(K_Reg)
INCK(K->REG);
// 2521 IncK(K_V_Base)
INCK(K->V.BASE);
// 2522 IncK(K_A_Base)
INCK(K->A.BASE);
// 2523 %end
return;
} /* end of KINC */
// 2524 %routine DecK(%integer R)
void DECK(int R) {
// 2525 Ktimes(R) = Ktimes(R)-1 %if R&128 = 0
if (R & 128 != 0) goto L_01FB;
KTIMES[R] = KTIMES[R] - 1;
L_01FB:;
// 2526 %end
return;
} /* end of DECK */
// 2527 %routine Kdec(%record(Datafm)%name K)
void KDEC(struct DATAFM * K) {
// 2528 DecK(K_Reg)
DECK(K->REG);
// 2529 DecK(K_V_Base)
DECK(K->V.BASE);
// 2530 DecK(K_A_Base)
DECK(K->A.BASE);
// 2531 %end
return;
} /* end of KDEC */
// 2532 %routine Forget(%integer Register)
void FORGET(int REGISTER) {
// 2533 %integername N
int *N;
// 2534 %record(Datafm)%name K, R
struct DATAFM *K;
struct DATAFM *R;
// 2535 Fail("Forget") %unless R0 <= Register <= AnyF
{
// Double-sided test on REGISTER (Part I)
int tmp;
if (1 > (tmp = REGISTER)) goto L_01FC;
// Double-sided test on REGISTER (Part II)
if (tmp <= 14) goto L_01FD;
}
L_01FC:;
FAIL(_imp_str_literal_size(63, "Forget"));
L_01FD:;
// 2536 N == Ktimes(Register)
N = (int *)/*?*/ &KTIMES[REGISTER];
// 2537 Used(Register) = 0
USED[REGISTER] = 0;
// 2538 %return %if N = 0 %or Activity(Register) < 0
if (*N == 0) goto L_01FE;
if (ACTIVITY[REGISTER] >= 0) goto L_01FF;
L_01FE:;
return;
L_01FF:;
// 2539 K == Knowing; Knowing == Null
K = (struct DATAFM *)KNOWING;
KNOWING = (struct DATAFM *)NULL;
// 2540 %while K ## Null %cycle
L_0200:;
if (_imp_ADDR((void *)(K)) == _imp_ADDR((void *)(NULL))) goto L_0201;
// 2541 R == K; K == K_Link
R = (struct DATAFM *)K;
K = (struct DATAFM *)K->LINK;
// 2542 %if R_Reg = Register %or R_V_Base = Register %or %c
if (R->REG == REGISTER) goto L_0202;
if (R->V.BASE == REGISTER) goto L_0202;
if (R->A.BASE != REGISTER) goto L_0203;
L_0202:;
// 2543+ R_A_Base = Register %start
// 2544 Ktail_Link == R
KTAIL->LINK = (struct DATAFM *)R;
// 2545 Ktail == R
KTAIL = (struct DATAFM *)R;
// 2546 Ktail_Link == Null
KTAIL->LINK = (struct DATAFM *)NULL;
// 2547 Kdec(R)
KDEC(R);
// 2548 Mon Regid(Register, "Lost") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_0204;
MONREGID(REGISTER, _imp_str_literal_size(15, "Lost"));
L_0204:;
// 2549 %finish %else %start
goto L_0205;
L_0203:;
// 2550 R_Link == Knowing; Knowing == R {retain it}
R->LINK = (struct DATAFM *)KNOWING;
KNOWING = (struct DATAFM *)R;
// 2551 %finish
L_0205:;
// 2552 %repeat
goto L_0200;
L_0201:;
// 2553 Fail("Still known") %if N # 0
if (*N == 0) goto L_0206;
FAIL(_imp_str_literal_size(63, "Still known"));
L_0206:;
// 2554 %end
return;
} /* end of FORGET */
// 2555 %routine Inherit(%integer New, Old)
void INHERIT(int NEW, int OLD) {
// 2556 %record(Datafm)%name P, K, X
struct DATAFM *P;
struct DATAFM *K;
struct DATAFM *X;
// 2557 %return %if New = Old
if (NEW != OLD) goto L_0207;
return;
L_0207:;
// 2558 Used(New) = Ca
USED[NEW] = *CA;
// 2559 P == Knowing
P = (struct DATAFM *)KNOWING;
// 2560 %while P ## Null %cycle
L_0208:;
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(NULL))) goto L_0209;
// 2561 K == P; P == K_Link
K = (struct DATAFM *)P;
P = (struct DATAFM *)K->LINK;
// 2562 %if K_Reg = Old %start
if (K->REG != OLD) goto L_020A;
// 2563 X == Record(NewK); %return %if X == Null
X = (struct DATAFM *)_imp_RECORD(NEWK());
if (_imp_ADDR((void *)(X)) != _imp_ADDR((void *)(NULL))) goto L_020B;
return;
L_020B:;
// 2564 X = K
*X = *K;
// 2565 X_Reg = New
X->REG = NEW;
// 2566 X_Link == Knowing; Knowing == X
X->LINK = (struct DATAFM *)KNOWING;
KNOWING = (struct DATAFM *)X;
// 2567 Kinc(X)
KINC(X);
// 2568 %finish
L_020A:;
// 2569 %repeat
goto L_0208;
L_0209:;
// 2570 %end
return;
} /* end of INHERIT */
// 2571 %routine Promote(%integer Reg)
void PROMOTE(int REG) {
// 2572 %record(Datafm)%name Front, Back, Next
struct DATAFM *FRONT;
struct DATAFM *BACK;
struct DATAFM *NEXT;
// 2573 %record(Datafm) D
struct DATAFM D;
// 2574 Back == Null
BACK = (struct DATAFM *)NULL;
// 2575 Front == D
FRONT = (struct DATAFM *)/*?*/ &D;
// 2576 %while Knowing ## Null %cycle
L_020C:;
if (_imp_ADDR((void *)(KNOWING)) == _imp_ADDR((void *)(NULL))) goto L_020D;
// 2577 Next == Knowing_Link
NEXT = (struct DATAFM *)KNOWING->LINK;
// 2578 %if Knowing_Reg # Reg %start
if (KNOWING->REG == REG) goto L_020E;
// 2579 Knowing_Link == Back
KNOWING->LINK = (struct DATAFM *)BACK;
// 2580 Back == Knowing
BACK = (struct DATAFM *)KNOWING;
// 2581 %finish %else %start
goto L_020F;
L_020E:;
// 2582 Front_Link == Knowing
FRONT->LINK = (struct DATAFM *)KNOWING;
// 2583 Front == Knowing
FRONT = (struct DATAFM *)KNOWING;
// 2584 %finish
L_020F:;
// 2585 Knowing == Next
KNOWING = (struct DATAFM *)NEXT;
// 2586 %repeat
goto L_020C;
L_020D:;
// 2587 Front_Link == Back
FRONT->LINK = (struct DATAFM *)BACK;
// 2588 Knowing == D_Link
KNOWING = (struct DATAFM *)D.LINK;
// 2589 Display Knowledge %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_0210;
DISPLAYKNOWLEDGE();
L_0210:;
// 2590 %end
return;
} /* end of PROMOTE */
// 2591 %routine Remember(%integer Register, %record(Stackfm)%name V)
void REMEMBER(int REGISTER, struct STACKFM *V) {
// 2592 %record(Datafm)%name K
struct DATAFM *K;
// 2593 %record(Datafm) M
struct DATAFM M;
// 2594 %return %unless R0 <= Register <= F3
{
// Double-sided test on REGISTER (Part I)
int tmp;
if (1 > (tmp = REGISTER)) goto L_0211;
// Double-sided test on REGISTER (Part II)
if (tmp <= 13) goto L_0212;
}
L_0211:;
return;
L_0212:;
// 2595 Used(Register) = Ca
USED[REGISTER] = *CA;
// 2596 %if InReg(V)#0 %start {inherit other register's data}
if (INREG(V) == 0) goto L_0213;
// 2597 Inherit(Register, V_Base)
INHERIT(REGISTER, V->BASE);
// 2598 %return
return;
// 2599 %finish
L_0213:;
// 2600 %return %if Register = V_Base %or Register = V_A_Base
if (REGISTER == V->BASE) goto L_0214;
if (REGISTER != V->A.BASE) goto L_0215;
L_0214:;
return;
L_0215:;
// 2601 %if Memorable(V, M)#0 %start
if (MEMORABLE(V, /*?*/ &M) == 0) goto L_0216;
// 2602 K == Record(NewK); %return %if K == Null
K = (struct DATAFM *)_imp_RECORD(NEWK());
if (_imp_ADDR((void *)(K)) != _imp_ADDR((void *)(NULL))) goto L_0217;
return;
L_0217:;
// 2603 K = M
*K = M;
// 2604 K_Reg = Register
K->REG = REGISTER;
// 2605 K_Link == Knowing; Knowing == K
K->LINK = (struct DATAFM *)KNOWING;
KNOWING = (struct DATAFM *)K;
// 2606 Kinc(K)
KINC(K);
// 2607 Monitor(V, "Remember ".Regid(Register)) %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_0218;
MONITOR(V,
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("Remember "),
(_imp_string *)/*?*/ ®ID[REGISTER]);
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string15 *)&tmp;
})
);
L_0218:;
// 2608 %finish
L_0216:;
// 2609 %end
return;
} /* end of REMEMBER */
// 2610 %routine Forget Destination(%record(Stackfm)%name V)
void FORGETDESTINATION(struct STACKFM * V) {
// 2611 %integer Low, High
int LOW;
int HIGH;
// 2612 %record(Datafm)%name P, K
struct DATAFM *P;
struct DATAFM *K;
// 2613 {%predicate}
// 2614 %integerfn Dangerous
int DANGEROUS(void) {
// 2615 %if V_Form >= VinX %start
if (V->FORM < 4) goto L_0219;
// 2616 %result=-1 %if Control&Trusted # 0
if (CONTROL & 1 == 0) goto L_021A;
return -1;
L_021A:;
// 2617 %result=0
return 0;
// 2618 %finish
L_0219:;
// 2619 %if V_A_Scale # 0 %start {array element altered}
if (V->A.SCALE == 0) goto L_021B;
// 2620 %if K_V_Format # 0 %start {array address known}
if (K->V.FORMAT == 0) goto L_021C;
// 2621 %result=0 %if Control&Trusted = 0 {not always safe!}
if (CONTROL & 1 != 0) goto L_021D;
return 0;
L_021D:;
// 2622 %result=-1 %if 1 <= K_A_Base <= 127 %or {unknown array base} %c
{
// Double-sided test on K->A.BASE (Part I)
int tmp;
if (1 > (tmp = K->A.BASE)) goto L_021E;
// Double-sided test on K->A.BASE (Part II)
if (tmp <= 127) goto L_021F;
}
L_021E:;
{
// Double-sided test on V->A.BASE (Part I)
int tmp;
if (1 > (tmp = V->A.BASE)) goto L_0220;
// Double-sided test on V->A.BASE (Part II)
if (tmp > 127) goto L_0220;
}
L_021F:;
return -1;
L_0220:;
// 2623+ 1 <= V_A_Base <= 127 {unknown altered base}
// 2624 %finish
L_021C:;
// 2625 %result=-1 %if K_A_Form = 3 {indirect}
if (K->A.FORM != 3) goto L_0221;
return -1;
L_0221:;
// 2626 %result=-1 %if 0 < K_V_Base < 128 {unknown base}
{
// Double-sided test on K->V.BASE (Part I)
int tmp;
if (0 >= (tmp = K->V.BASE)) goto L_0222;
// Double-sided test on K->V.BASE (Part II)
if (tmp >= 128) goto L_0222;
}
return -1;
L_0222:;
// 2627 %result=0
return 0;
// 2628 %finish
L_021B:;
// 2629 %if K_V_Format # 0 %start {array element known}
if (K->V.FORMAT == 0) goto L_0223;
// 2630 %result=-1 %if Control&Trusted # 0 %and %c
if (CONTROL & 1 == 0) goto L_0224;
{
// Double-sided test on V->BASE (Part I)
int tmp;
if (1 > (tmp = V->BASE)) goto L_0224;
// Double-sided test on V->BASE (Part II)
if (tmp > 127) goto L_0224;
}
return -1;
L_0224:;
// 2631+ 1 <= V_Base <= 127 {unknown base altered}
// 2632 %result=-1 %if K_V_Base = V_Base %and {index altered} %c
if (K->V.BASE != V->BASE) goto L_0225;
{
// Double-sided test on K->V.DISP (Part I)
int tmp;
if (LOW > (tmp = K->V.DISP)) goto L_0225;
// Double-sided test on K->V.DISP (Part II)
if (tmp >= HIGH) goto L_0225;
}
if (K->V.AREA != V->AREA) goto L_0225;
return -1;
L_0225:;
// 2633+ Low <= K_V_Disp < High %and %c
// 2634+ K_V_Area = V_Area
// 2635 %result=-1 %if K_A_Base = V_Base %and {arrayname altered} %c
if (K->A.BASE != V->BASE) goto L_0226;
{
// Double-sided test on K->A.DISP (Part I)
int tmp;
if (LOW > (tmp = K->A.DISP)) goto L_0226;
// Double-sided test on K->A.DISP (Part II)
if (tmp >= HIGH) goto L_0226;
}
if (K->A.AREA != V->AREA) goto L_0226;
return -1;
L_0226:;
// 2636+ Low <= K_A_Disp < High %and %c
// 2637+ K_A_Area = V_Area
// 2638 %finish %else %if K_V_Form = 1 %start {address}
goto L_0227;
L_0223:;
if (K->V.FORM != 1) goto L_0228;
// 2639 %result=-1 %if Control&Trusted # 0 %and %c
if (CONTROL & 1 == 0) goto L_0229;
{
// Double-sided test on K->V.BASE (Part I)
int tmp;
if (1 > (tmp = K->V.BASE)) goto L_0229;
// Double-sided test on K->V.BASE (Part II)
if (tmp > 127) goto L_0229;
}
return -1;
L_0229:;
// 2640+ 1 <= K_V_Base <= 127 {unknown base}
// 2641 %finish %else %if K_V_Form = 2 %start {direct reference}
goto L_0227;
L_0228:;
if (K->V.FORM != 2) goto L_022A;
// 2642 %result=-1 %if Control&Trusted # 0 %and %c
if (CONTROL & 1 == 0) goto L_022B;
{
// Double-sided test on K->V.BASE (Part I)
int tmp;
if (1 > (tmp = K->V.BASE)) goto L_022C;
// Double-sided test on K->V.BASE (Part II)
if (tmp <= 127) goto L_022D;
}
L_022C:;
{
// Double-sided test on V->BASE (Part I)
int tmp;
if (1 > (tmp = V->BASE)) goto L_022B;
// Double-sided test on V->BASE (Part II)
if (tmp > 127) goto L_022B;
}
L_022D:;
return -1;
L_022B:;
// 2643+ (1 <= K_V_Base <= 127 %or {unknown base} %c
// 2644+ 1 <= V_Base <= 127) {unknown base altered}
// 2645 %result=-1 %if K_V_Base = V_Base %and {direct hit} %c
if (K->V.BASE != V->BASE) goto L_022E;
{
// Double-sided test on K->V.DISP (Part I)
int tmp;
if (LOW > (tmp = K->V.DISP)) goto L_022E;
// Double-sided test on K->V.DISP (Part II)
if (tmp >= HIGH) goto L_022E;
}
if (K->V.AREA != V->AREA) goto L_022E;
return -1;
L_022E:;
// 2646+ Low <= K_V_Disp < High %and %c
// 2647+ K_V_Area = V_Area
// 2648 %finish %else %if K_V_Form = 3 %start {indirect reference}
goto L_0227;
L_022A:;
if (K->V.FORM != 3) goto L_022F;
// 2649 %result=-1 %unless Control&Trusted = 0
if (CONTROL & 1 == 0) goto L_0230;
return -1;
L_0230:;
// 2650 %result=-1 %if K_V_Base = V_Base %and {direct hit} %c
if (K->V.BASE != V->BASE) goto L_0231;
{
// Double-sided test on K->V.DISP (Part I)
int tmp;
if (LOW > (tmp = K->V.DISP)) goto L_0231;
// Double-sided test on K->V.DISP (Part II)
if (tmp >= HIGH) goto L_0231;
}
if (K->V.AREA != V->AREA) goto L_0231;
return -1;
L_0231:;
// 2651+ Low <= K_V_Disp < High %and %c
// 2652+ K_V_Area = V_Area
// 2653 %finish
L_022F:;
L_0227:;
// 2654 %result=0
return 0;
// 2655 %end
} /* end of DANGEROUS */
// 2656 Monitor(V, "Forget Dest") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_0232;
MONITOR(V, _imp_str_literal_size(15, "Forget Dest"));
L_0232:;
// 2657 %return %if V_Base = Ds
if (V->BASE != 6) goto L_0233;
return;
L_0233:;
// 2658 %if InReg(V)#0 %start
if (INREG(V) == 0) goto L_0234;
// 2659 Forget(V_Base)
FORGET(V->BASE);
// 2660 %return
return;
// 2661 %finish
L_0234:;
// 2662 Low = V_Disp; High = Low+Item Size(V_Format)
LOW = V->DISP;
HIGH = LOW + ITEMSIZE(V->FORMAT);
// 2663 P == Knowing; Knowing == Null
P = (struct DATAFM *)KNOWING;
KNOWING = (struct DATAFM *)NULL;
// 2664 %while P ## Null %cycle
L_0235:;
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(NULL))) goto L_0236;
// 2665 K == P; P == P_Link
K = (struct DATAFM *)P;
P = (struct DATAFM *)P->LINK;
// 2666 %if Dangerous#0 %start
if (DANGEROUS() == 0) goto L_0237;
// 2667 Kdec(K)
KDEC(K);
// 2668 Ktail_Link == K
KTAIL->LINK = (struct DATAFM *)K;
// 2669 Ktail == K
KTAIL = (struct DATAFM *)K;
// 2670 Ktail_Link == Null
KTAIL->LINK = (struct DATAFM *)NULL;
// 2671 Mon Regid(K_Reg, "Lost") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_0238;
MONREGID(K->REG, _imp_str_literal_size(15, "Lost"));
L_0238:;
// 2672 %finish %else %start
goto L_0239;
L_0237:;
// 2673 K_Link == Knowing; Knowing == K {remember it}
K->LINK = (struct DATAFM *)KNOWING;
KNOWING = (struct DATAFM *)K;
// 2674 %finish
L_0239:;
// 2675 %repeat
goto L_0235;
L_0236:;
// 2676 %end
return;
} /* end of FORGETDESTINATION */
// 2677
// 2678 {Environment handling}
// 2679
// 2680 %routine Remember Environment(%integer Label)
void REMEMBERENVIRONMENT(int LABEL) {
// 2681 %record(Datafm)%name K, Top
struct DATAFM *K;
struct DATAFM *TOP;
// 2682 Top == Null
TOP = (struct DATAFM *)NULL;
// 2683 %if Kasl_Link ## Null %start
if (_imp_ADDR((void *)(KASL.LINK)) == _imp_ADDR((void *)(NULL))) goto L_023A;
// 2684 K == Knowing
K = (struct DATAFM *)KNOWING;
// 2685 %while K ## Null %cycle
L_023B:;
if (_imp_ADDR((void *)(K)) == _imp_ADDR((void *)(NULL))) goto L_023C;
// 2686
// 2687 %routine Add(%record(Datafm)%name K)
void ADD(struct DATAFM * K) {
// 2688 %record(Datafm)%name P
struct DATAFM *P;
// 2689 P == Record(NewK) {cannot return Null}
P = (struct DATAFM *)_imp_RECORD(NEWK());
// 2690 %if Top == Null %start
if (_imp_ADDR((void *)(TOP)) != _imp_ADDR((void *)(NULL))) goto L_023A;
// 2691 Top == P
TOP = (struct DATAFM *)P;
// 2692 %finish %else %if Top == P %start
goto L_023D;
L_023A:;
if (_imp_ADDR((void *)(TOP)) != _imp_ADDR((void *)(P))) goto L_023E;
// 2693 Top == Kasl_Link
TOP = (struct DATAFM *)KASL.LINK;
// 2694 %finish
L_023E:;
L_023D:;
// 2695 P = K
*P = *K;
// 2696 P_Link == Null
P->LINK = (struct DATAFM *)NULL;
// 2697 P_Label = Label
P->LABEL = LABEL;
// 2698 Ktail_Link == P
KTAIL->LINK = (struct DATAFM *)P;
// 2699 Ktail == P
KTAIL = (struct DATAFM *)P;
// 2700 Mon RegId(P_Reg, "in env") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_023F;
MONREGID(P->REG, _imp_str_literal_size(15, "in env"));
L_023F:;
// 2701 %end
return;
} /* end of ADD */
// 2702
// 2703 Add(K)
ADD(K);
// 2704 K == K_Link {onto the next item}
K = (struct DATAFM *)K->LINK;
// 2705 %repeat
goto L_023B;
L_023C:;
// 2706 CC1_Reg = Cc Rhs %and Add(Cc1_Data) %if Cc1_Cc Ca = Ca
if (CC1.CCCA != *CA) goto L_0240;
CC1.REG = 16;
ADD(/*?*/ &CC1.DATA);
L_0240:;
// 2707 CC2_Reg = Cc Lhs %and Add(Cc2_Data) %if Cc2_Cc Ca = Ca
if (CC2.CCCA != *CA) goto L_0241;
CC2.REG = 15;
ADD(/*?*/ &CC2.DATA);
L_0241:;
// 2708 %finish
L_0242:;
// 2709 Env(Label)_E == Top {remember the start}
ENV[LABEL - 1].E = (struct ENVFM *)TOP;
// 2710 %end
return;
} /* end of REMEMBERENVIRONMENT */
// 2711 %routine Merge Environment(%integer Label)
void MERGEENVIRONMENT(int LABEL) {
// 2712 {Update the saved environment of Label with the data in Knowing}
// 2713 {Knowing is unaltered}
// 2714 %record(Datafm)%name P, K, Next, Top, First
struct DATAFM *P;
struct DATAFM *K;
struct DATAFM *NEXT;
struct DATAFM *TOP;
struct DATAFM *FIRST;
// 2715 Monitor(Null, "Merge") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_0242;
MONITOR(NULL, _imp_str_literal_size(15, "Merge"));
L_0242:;
// 2716 Top == Null; First == Null
TOP = (struct DATAFM *)NULL;
FIRST = (struct DATAFM *)NULL;
// 2717 %if Knowing ## Null %start
if (_imp_ADDR((void *)(KNOWING)) == _imp_ADDR((void *)(NULL))) goto L_0243;
// 2718 Next == Env(Label)_E
NEXT = (struct DATAFM *)ENV[LABEL - 1].E;
// 2719 %cycle
L_0244:;
// 2720 P == Next; %exit %if P == Null %or P == First %or P_Label # Label
P = (struct DATAFM *)NEXT;
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(NULL))) goto L_0245;
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(FIRST))) goto L_0245;
if (P->LABEL == LABEL) goto L_0246;
L_0245:;
goto L_0247;
L_0246:;
// 2721 Next == P_Link
NEXT = (struct DATAFM *)P->LINK;
// 2722 P_Label = 0
P->LABEL = 0;
// 2723 K == Knowing
K = (struct DATAFM *)KNOWING;
// 2724 %cycle
L_0248:;
// 2725 %if K_Reg = P_Reg %and %c
if (K->REG != P->REG) goto L_0249;
if (K->V.DISP != P->V.DISP) goto L_0249;
if (K->V.BASE != P->V.BASE) goto L_0249;
if (K->V.TYPE != P->V.TYPE) goto L_0249;
if (K->V.AREA != P->V.AREA) goto L_0249;
if (K->V.FORM != P->V.FORM) goto L_0249;
if (K->V.EXTRA != P->V.EXTRA) goto L_0249;
if (K->A.DISP != P->A.DISP) goto L_0249;
if (K->A.BASE != P->A.BASE) goto L_0249;
if (K->A.EXTRA != P->A.EXTRA) goto L_0249;
if (K->A.SCALE != P->A.SCALE) goto L_0249;
if (K->A.TYPE != P->A.TYPE) goto L_0249;
if (K->A.AREA != P->A.AREA) goto L_0249;
if (K->A.FORM != P->A.FORM) goto L_0249;
// 2726+ K_V_Disp = P_V_Disp %and K_V_Base = P_V_Base %and %c
// 2727+ K_V_Type = P_V_Type %and K_V_Area = P_V_Area %and %c
// 2728+ K_V_Form = P_V_Form %and K_V_Extra = P_V_Extra %and %c
// 2729+ K_A_Disp = P_A_Disp %and K_A_Base = P_A_Base %and %c
// 2730+ K_A_Extra = P_A_Extra %and K_A_Scale = P_A_Scale %and %c
// 2731+ K_A_Type = P_A_Type %and %c
// 2732+ K_A_Area = P_A_Area %and K_A_Form = P_A_Form %start
// 2733 K == Record(NewK)
K = (struct DATAFM *)_imp_RECORD(NEWK());
// 2734 First == K %if First == Null
if (_imp_ADDR((void *)(FIRST)) != _imp_ADDR((void *)(NULL))) goto L_024A;
FIRST = (struct DATAFM *)K;
L_024A:;
// 2735 %if Top == Null %start
if (_imp_ADDR((void *)(TOP)) != _imp_ADDR((void *)(NULL))) goto L_024B;
// 2736 Top == K
TOP = (struct DATAFM *)K;
// 2737 %finish %else %if Top == K %start
goto L_024C;
L_024B:;
if (_imp_ADDR((void *)(TOP)) != _imp_ADDR((void *)(K))) goto L_024D;
// 2738 Top == Kasl_Link
TOP = (struct DATAFM *)KASL.LINK;
// 2739 %finish
L_024D:;
L_024C:;
// 2740 K = P
*K = *P;
// 2741 K_Link == Null
K->LINK = (struct DATAFM *)NULL;
// 2742 K_Label = Label
K->LABEL = LABEL;
// 2743 Ktail_Link == K
KTAIL->LINK = (struct DATAFM *)K;
// 2744 Ktail == K
KTAIL = (struct DATAFM *)K;
// 2745 Mon RegId(K_Reg, "Merged") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_024E;
MONREGID(K->REG, _imp_str_literal_size(15, "Merged"));
L_024E:;
// 2746 %exit
goto L_024F;
// 2747 %finish
L_0249:;
// 2748 K == K_Link
K = (struct DATAFM *)K->LINK;
// 2749 %repeat %until K == Null
if (_imp_ADDR((void *)(K)) == _imp_ADDR((void *)(NULL))) goto L_024F;
goto L_0248;
L_024F:;
// 2750 %repeat
goto L_0244;
L_0247:;
// 2751 %finish
L_0243:;
// 2752 Env(Label)_E == Top
ENV[LABEL - 1].E = (struct ENVFM *)TOP;
// 2753 %end
return;
} /* end of MERGEENVIRONMENT */
// 2754 %routine Restore Environment(%integer Label)
void RESTOREENVIRONMENT(int LABEL) {
// 2755 {a little care is needed here in case the environment has}
// 2756 {migrated to the top of the asl}
// 2757 %record(Datafm)%name P, K, Next
struct DATAFM *P;
struct DATAFM *K;
struct DATAFM *NEXT;
// 2758 Forget Everything {dispose of old knowledge}
FORGETEVERYTHING();
// 2759 Next == Env(Label)_E
NEXT = (struct DATAFM *)ENV[LABEL - 1].E;
// 2760 %cycle
L_0250:;
// 2761 P == Next; %return %if P == Null %or P_Label # Label
P = (struct DATAFM *)NEXT;
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(NULL))) goto L_0251;
if (P->LABEL == LABEL) goto L_0252;
L_0251:;
return;
L_0252:;
// 2762 Next == P_Link
NEXT = (struct DATAFM *)P->LINK;
// 2763 %if P_Reg >= Cc Lhs %start
if (P->REG < 15) goto L_0253;
// 2764 %if P_Reg = Cc Lhs %start
if (P->REG != 15) goto L_0254;
// 2765 Cc1_Data = P; Cc1_Cc Ca = Ca
CC1.DATA = *P;
CC1.CCCA = *CA;
// 2766 %finish %else %start
goto L_0255;
L_0254:;
// 2767 Cc2_Data = P; Cc2_Cc Ca = Ca
CC2.DATA = *P;
CC2.CCCA = *CA;
// 2768 %finish
L_0255:;
// 2769 %finish %else %start
goto L_0256;
L_0253:;
// 2770 K == Record(NewK)
K = (struct DATAFM *)_imp_RECORD(NEWK());
// 2771 K = P
*K = *P;
// 2772 K_Link == Knowing; Knowing == K
K->LINK = (struct DATAFM *)KNOWING;
KNOWING = (struct DATAFM *)K;
// 2773 Kinc(K)
KINC(K);
// 2774 %finish
L_0256:;
// 2775 Mon RegId(P_Reg, "Back") %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_0257;
MONREGID(P->REG, _imp_str_literal_size(15, "Back"));
L_0257:;
// 2776 %repeat
goto L_0250;
// 2777 %end
} /* end of RESTOREENVIRONMENT */
// 2778 %routine Forget Environment(%integer Label)
void FORGETENVIRONMENT(int LABEL) {
// 2779 Env(Label)_E == Null
ENV[LABEL - 1].E = (struct ENVFM *)NULL;
// 2780 %end
return;
} /* end of FORGETENVIRONMENT */
// 2781
// 2782 {Testing Predicates}
// 2783
// 2784 {%predicate}
// 2785 %integerfn InReg(%record(Stackfm)%name V)
int INREG(struct STACKFM * V) {
// 2786 %result=0 %if V_Form # VinR %or %c
if (V->FORM != 0) goto L_0258;
if (V->DISP != 0) goto L_0258;
if (V->BASE == 0) goto L_0258;
if (V->AREA != 0) goto L_0258;
if (V->OPER != 0) goto L_0258;
if (V->A.SCALE == 0) goto L_0259;
L_0258:;
return 0;
L_0259:;
// 2787+ V_Disp # 0 %or %c
// 2788+ V_Base = 0 %or %c
// 2789+ V_Area # 0 %or %c
// 2790+ V_Oper # 0 %or %c
// 2791+ V_A_Scale # 0
// 2792 %result=-1
return -1;
// 2793 %end
} /* end of INREG */
// 2794 {%predicate}
// 2795 %integerfn Floating(%record(Stackfm)%name V)
int FLOATING(struct STACKFM * V) {
// 2796 %result=-1 %if Reals <= V_Type <= Lreals %or V_Oper >= RNEGx
{
// Double-sided test on V->TYPE (Part I)
int tmp;
if (3 > (tmp = V->TYPE)) goto L_025A;
// Double-sided test on V->TYPE (Part II)
if (tmp <= 4) goto L_025B;
}
L_025A:;
if (V->OPER < 16) goto L_025C;
L_025B:;
return -1;
L_025C:;
// 2797 %result=0
return 0;
// 2798 %end
} /* end of FLOATING */
// 2799 {%predicate}
// 2800 %integerfn Same(%record(Stackfm)%name A, B)
int SAME(struct STACKFM * A, struct STACKFM * B) {
// 2801 %result=0 %if A == Null %or B == Null
if (_imp_ADDR((void *)(A)) == _imp_ADDR((void *)(NULL))) goto L_025D;
if (_imp_ADDR((void *)(B)) != _imp_ADDR((void *)(NULL))) goto L_025E;
L_025D:;
return 0;
L_025E:;
// 2802 %result=0 %if A_Disp # B_Disp %or %c
if (A->DISP != B->DISP) goto L_025F;
if (A->BASE != B->BASE) goto L_025F;
if (A->FORM != B->FORM) goto L_025F;
if (A->EXTRA != B->EXTRA) goto L_025F;
if (A->TYPE != B->TYPE) goto L_025F;
if (A->AREA != B->AREA) goto L_025F;
if (A->A.FORMAT == B->A.FORMAT) goto L_0260;
L_025F:;
return 0;
L_0260:;
// 2803+ A_Base # B_Base %or %c
// 2804+ A_Form # B_Form %or %c
// 2805+ A_Extra # B_Extra %or %c
// 2806+ A_Type # B_Type %or %c
// 2807+ A_Area # B_Area %or %c
// 2808+ A_A_Format # B_A_Format
// 2809
// 2810 %result=-1 %if A_A_Format = 0
if (A->A.FORMAT != 0) goto L_0261;
return -1;
L_0261:;
// 2811
// 2812 %result=0 %if A_A_Disp # B_A_Disp %or %c
if (A->A.DISP != B->A.DISP) goto L_0262;
if (A->A.BASE != B->A.BASE) goto L_0262;
if (A->A.AREA != B->A.AREA) goto L_0262;
if (A->A.FORM != B->A.FORM) goto L_0262;
if (A->A.EXTRA != B->A.EXTRA) goto L_0262;
if (A->BIAS == B->BIAS) goto L_0263;
L_0262:;
return 0;
L_0263:;
// 2813+ A_A_Base # B_A_Base %or %c
// 2814+ A_A_Area # B_A_Area %or %c
// 2815+ A_A_Form # B_A_Form %or %c
// 2816+ A_A_Extra # B_A_Extra %or %c
// 2817+ A_Bias # B_Bias
// 2818 %result=-1
return -1;
// 2819 %end
} /* end of SAME */
// 2820 {%predicate}
// 2821 %integerfn Const(%record(Stackfm)%name V)
int CONST(struct STACKFM * V) {
// 2822 %result=0 %if V_Form # VinR %or V_Base # 0 %or %c
if (V->FORM != 0) goto L_0264;
if (V->BASE != 0) goto L_0264;
if (V->TYPE != 1) goto L_0264;
if (V->AREA != 0) goto L_0264;
if (V->OPER != 0) goto L_0264;
if (V->A.SCALE == 0) goto L_0265;
L_0264:;
return 0;
L_0265:;
// 2823+ V_Type # Integers %or %c
// 2824+ V_Area # 0 %or %c
// 2825+ V_Oper # 0 %or %c
// 2826+ V_A_Scale # 0
// 2827 %result=-1
return -1;
// 2828 %end
} /* end of CONST */
// 2829 %integerfn Power(%integer N)
int POWER(int N) {
// 2830 %integer P, Mask
int P;
int MASK;
// 2831 %result = -1 %if N > ( \( (-1)>>1 ) )>>1 {Beware x'4001' etc.}
if (N <= (unsigned int)~((unsigned int)(-1) >> 1) >> 1) goto L_0266;
return -1;
L_0266:;
// 2832 Mask = 1
MASK = 1;
// 2833 P = 0
P = 0;
// 2834 %cycle
L_0267:;
// 2835 %result = P %if Mask = N
if (MASK != N) goto L_0268;
return P;
L_0268:;
// 2836 %result = -1 %if Mask > N
if (MASK <= N) goto L_0269;
return -1;
L_0269:;
// 2837 Mask = Mask<<1
MASK = MASK << 1;
// 2838 P = P+1
P = P + 1;
// 2839 %repeat
goto L_0267;
// 2840 %end
} /* end of POWER */
// 2841 %integerfn Item Size(%integer F)
int ITEMSIZE(int F) {
// 2842 %result = F %if F >= 0
if (F < 0) goto L_026A;
return F;
L_026A:;
// 2843 %result = Var(-F)_Format
return VAR[-F].FORMAT;
// 2844 %end
} /* end of ITEMSIZE */
// 2845
// 2846 {Register Control}
// 2847
// 2848 %routine Claim(%integer Register)
void CLAIM(int REGISTER) {
// 2849 %return %unless R0 <= Register <= F3 %and Activity(Register) >= 0
{
// Double-sided test on REGISTER (Part I)
int tmp;
if (1 > (tmp = REGISTER)) goto L_026B;
// Double-sided test on REGISTER (Part II)
if (tmp > 13) goto L_026B;
}
if (ACTIVITY[REGISTER] >= 0) goto L_026C;
L_026B:;
return;
L_026C:;
// 2850 Activity(Register) = Activity(Register)+1
ACTIVITY[REGISTER] = ACTIVITY[REGISTER] + 1;
// 2851 Active Registers = Active Registers+1
ACTIVEREGISTERS = ACTIVEREGISTERS + 1;
// 2852 Used(Register) = Ca
USED[REGISTER] = *CA;
// 2853 Monitor Register(Register, "Claimed") %if Diag&MonReg # 0
if (DIAG & 4 == 0) goto L_026D;
MONITORREGISTER(REGISTER, _imp_str_literal_size(15, "Claimed"));
L_026D:;
// 2854 %end
return;
} /* end of CLAIM */
// 2855 %routine Release(%integer Register)
void RELEASE(int REGISTER) {
// 2856 %return %unless R0 <= Register <= F3 %and Activity(Register) >= 0
{
// Double-sided test on REGISTER (Part I)
int tmp;
if (1 > (tmp = REGISTER)) goto L_026E;
// Double-sided test on REGISTER (Part II)
if (tmp > 13) goto L_026E;
}
if (ACTIVITY[REGISTER] >= 0) goto L_026F;
L_026E:;
return;
L_026F:;
// 2857 Monitor Register(Register, "Release") %if Diag&MonReg # 0
if (DIAG & 4 == 0) goto L_0270;
MONITORREGISTER(REGISTER, _imp_str_literal_size(15, "Release"));
L_0270:;
// 2858 Activity(Register) = Activity(Register)-1
ACTIVITY[REGISTER] = ACTIVITY[REGISTER] - 1;
// 2859 Fail("Not claimed") %if Activity(Register) < 0
if (ACTIVITY[REGISTER] >= 0) goto L_0271;
FAIL(_imp_str_literal_size(63, "Not claimed"));
L_0271:;
// 2860 Active Registers = Active Registers-1
ACTIVEREGISTERS = ACTIVEREGISTERS - 1;
// 2861 %end
return;
} /* end of RELEASE */
// 2862 %routine Release and Drop(%record(Stackfm)%name V)
void RELEASEANDDROP(struct STACKFM * V) {
// 2863 Release and Drop(V_Link) %unless V_Link == Null
if (_imp_ADDR((void *)(V->LINK)) == _imp_ADDR((void *)(NULL))) goto L_0272;
RELEASEANDDROP(V->LINK);
L_0272:;
// 2864 Release(V_Base); Release(V_A_Base)
RELEASE(V->BASE);
RELEASE(V->A.BASE);
// 2865 Drop(V)
DROP(V);
// 2866 %end
return;
} /* end of RELEASEANDDROP */
// 2867 %routine Release and Clear(%record(Stackfm)%name V)
void RELEASEANDCLEAR(struct STACKFM * V) {
// 2868 Release(V_Base)
RELEASE(V->BASE);
// 2869 V_Base = 0
V->BASE = 0;
// 2870 %end
return;
} /* end of RELEASEANDCLEAR */
// 2871 %routine Hazard(%integer Register)
void HAZARD(int REGISTER) {
// 2872 %record(Stackfm)%name U
struct STACKFM *U;
// 2873 %integer T, Ar
int T;
int AR;
// 2874 %integername N
int *N;
// 2875 Monitor Register(Register, "Hazard") %if Diag&MonReg # 0
if (DIAG & 4 == 0) goto L_0273;
MONITORREGISTER(REGISTER, _imp_str_literal_size(15, "Hazard"));
L_0273:;
// 2876
// 2877 %routine Set(%record(stackfm)%name V, %integer New)
void SET(struct STACKFM * V, int NEW) {
// 2878 V_Base = Local
V->BASE = LOCAL;
// 2879 V_Flags = V_Flags!Hazarded
V->FLAGS = V->FLAGS | 16;
// 2880 %if V_Form = VinS %start
if (V->FORM != 1) goto L_0274;
// 2881 V_Extra = New
V->EXTRA = NEW;
// 2882 V_Form = VinX
V->FORM = 4;
// 2883 %finish %else %if V_Form = VinX %start
goto L_0275;
L_0274:;
if (V->FORM != 4) goto L_0276;
// 2884 V_Form = AinX
V->FORM = 5;
// 2885 V_Disp = V_Extra
V->DISP = V->EXTRA;
// 2886 V_Extra = New
V->EXTRA = NEW;
// 2887 %finish %else %if V_Form = VinR %start
goto L_0275;
L_0276:;
if (V->FORM != 0) goto L_0277;
// 2888 %if V_Disp # 0 %start
if (V->DISP == 0) goto L_0278;
// 2889 V_Extra = New
V->EXTRA = NEW;
// 2890 V_Form = VinX
V->FORM = 4;
// 2891 Amap(V)
AMAP(V);
// 2892 %finish %else %start
goto L_0279;
L_0278:;
// 2893 V_Disp = New
V->DISP = NEW;
// 2894 V_Form = VinS
V->FORM = 1;
// 2895 %finish
L_0279:;
// 2896 %finish
L_0277:;
L_0275:;
// 2897 %end
return;
} /* end of SET */
// 2898 %routine Simplify(%record(Stackfm)%name V)
void SIMPLIFY(struct STACKFM * V) {
// 2899 %integer Op
int OP;
// 2900 Op = V_Oper
OP = V->OPER;
// 2901 V_Oper = 0
V->OPER = 0;
// 2902 Address(V, 0)
ADDRESS(V, 0);
// 2903 V_Oper = Op
V->OPER = OP;
// 2904 %end
return;
} /* end of SIMPLIFY */
// 2905
// 2906 N == Activity(Register); %return %if N <= 0
N = (int *)/*?*/ &ACTIVITY[REGISTER];
if (*N > 0) goto L_027A;
return;
L_027A:;
// 2907 T = (Frame+Alignment)&(\Alignment)
T = FRAME + 1 & (~1);
// 2908 Frame = T+Word Length {assume integer}
FRAME = T + 2;
// 2909 Ar = Actual(Register)<<6
AR = ACTUAL[REGISTER] << 6;
// 2910 %if Register >= F0 %start {it's real}
if (REGISTER < 10) goto L_027B;
// 2911 Frame = Frame+Word Length*3 {longreal temp}
FRAME = FRAME + 2 * 3;
// 2912 Set Mode(Lreals)
SETMODE(4);
// 2913 Plant(8_174064+Ar, Test Single)
PLANT(63540 + AR, -47);
// 2914 %finish %else %start
goto L_027C;
L_027B:;
// 2915 Plant(8_010064+Ar, Test Single)
PLANT(4148 + AR, -47);
// 2916 %finish
L_027C:;
// 2917 Plant(T, 0)
PLANT(T, 0);
// 2918 Attributes = Attributes!Attr Uses Locals
ATTRIBUTES = ATTRIBUTES | 2048;
// 2919 U == Using
U = (struct STACKFM *)USING;
// 2920 %while U ## Null %cycle
L_027D:;
if (_imp_ADDR((void *)(U)) == _imp_ADDR((void *)(NULL))) goto L_027E;
// 2921 %if U_A_Scale # 0 %start
if (U->A.SCALE == 0) goto L_027F;
// 2922 Simplify(U)
SIMPLIFY(U);
// 2923 U == Using
U = (struct STACKFM *)USING;
// 2924 %continue
goto L_0280;
// 2925 %finish
L_027F:;
// 2926 %if U_Base = Register %start
if (U->BASE != REGISTER) goto L_0281;
// 2927 %if U_Form = AinX %or (U_Form = VinX %and U_Disp # 0) %start
if (U->FORM == 5) goto L_0282;
if (U->FORM != 4) goto L_0283;
if (U->DISP == 0) goto L_0283;
L_0282:;
// 2928 Simplify(U)
SIMPLIFY(U);
// 2929 U == Using
U = (struct STACKFM *)USING;
// 2930 %continue
goto L_0280;
// 2931 %finish
L_0283:;
// 2932 Set(U, T)
SET(U, T);
// 2933 Active Registers = Active Registers-1
ACTIVEREGISTERS = ACTIVEREGISTERS - 1;
// 2934 N = N-1
*N = *N - 1;
// 2935 %finish
L_0281:;
// 2936 U == U_Using
U = (struct STACKFM *)U->USING;
// 2937 %repeat
L_0280:;
goto L_027D;
L_027E:;
// 2938 Fail("Use lost") %if N # 0
if (*N == 0) goto L_0284;
FAIL(_imp_str_literal_size(63, "Use lost"));
L_0284:;
// 2939 %end
return;
} /* end of HAZARD */
// 2940 %routine Hazard All
void HAZARDALL(void) {
// 2941 %while Active Registers # 0 %cycle
L_0285:;
if (ACTIVEREGISTERS == 0) goto L_0286;
// 2942 Hazard(R0); Hazard(R1); Hazard(R2); Hazard(R3)
HAZARD(1);
HAZARD(2);
HAZARD(3);
HAZARD(4);
// 2943 Hazard(F0); Hazard(F1); Hazard(F2); Hazard(F3)
HAZARD(10);
HAZARD(11);
HAZARD(12);
HAZARD(13);
// 2944 %repeat
goto L_0285;
L_0286:;
// 2945 %end
return;
} /* end of HAZARDALL */
// 2946 {%record(Stackfm)%map}
// 2947 %integerfn Register(%integer Reg)
int REGISTER(int REG) {
// 2948 %record(Stackfm)%name R
struct STACKFM *R;
// 2949 R == Record(Descriptor)
R = (struct STACKFM *)_imp_RECORD(DESCRIPTOR());
// 2950 %if Reg <= AnyG %then R_Type = Integers %else R_Type = Lreals
if (REG > 9) goto L_0287;
R->TYPE = 1;
goto L_0288;
L_0287:;
R->TYPE = 4;
L_0288:;
// 2951 R_Base = Reg
R->BASE = REG;
// 2952 %result = Addr(R)
return _imp_ADDR(R);
// 2953 %end
} /* end of REGISTER */
// 2954 %integerfn Cheapest(%integer Base)
int CHEAPEST(int BASE) {
// 2955 %integer R
int R;
// 2956 %integer Min Activity,
int MINACTIVITY;
int MINKNOWN;
int MINREG;
int OLDEST;
// 2957+ Min Known,
// 2958+ Min Reg, {default to R3 or F3}
// 2959+ Oldest
// 2960
// 2961 Min Activity = 1000
MINACTIVITY = 1000;
// 2962 Min Known = 1000
MINKNOWN = 1000;
// 2963 Min Reg = Base+3
MINREG = BASE + 3;
// 2964 Oldest = Ca
OLDEST = *CA;
// 2965 %for R = Base, 1, Base+3 %cycle
// %for R = BASE, 1, BASE + 3 %cycle
{
int _initial = BASE, _final = BASE + 3;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle R = BASE, 1, BASE + 3");
R = _initial - (1);
L_0289:
if (R == _final) goto L_028A;
R += 1;
// 2966 %if Activity(R) = Min Activity %start
if (ACTIVITY[R] != MINACTIVITY) goto L_028C;
// 2967 %if Min Known > Ktimes(R) %start
if (MINKNOWN <= KTIMES[R]) goto L_028D;
// 2968 Min Reg = R
MINREG = R;
// 2969 Min Known = Ktimes(R)
MINKNOWN = KTIMES[R];
// 2970 Oldest = Used(R)
OLDEST = USED[R];
// 2971 %finish %else %if Min Known = Ktimes(R) %start
goto L_028E;
L_028D:;
if (MINKNOWN != KTIMES[R]) goto L_028F;
// 2972 %if Oldest > Used(R) %start
if (OLDEST <= USED[R]) goto L_0290;
// 2973 Min Reg = R
MINREG = R;
// 2974 Oldest = Used(R)
OLDEST = USED[R];
// 2975 %finish
L_0290:;
// 2976 %finish
L_028F:;
L_028E:;
// 2977 %finish %else %if Activity(R) < Min Activity %start
goto L_0291;
L_028C:;
if (ACTIVITY[R] >= MINACTIVITY) goto L_0292;
// 2978 Min Activity = Activity(R)
MINACTIVITY = ACTIVITY[R];
// 2979 Min Reg = R
MINREG = R;
// 2980 Min Known = Ktimes(R)
MINKNOWN = KTIMES[R];
// 2981 Oldest = Used(R)
OLDEST = USED[R];
// 2982 %finish
L_0292:;
L_0291:;
// 2983 %repeat
goto L_0289;
}
L_028A:;
// 2984 Used(Min Reg) = Ca
USED[MINREG] = *CA;
// 2985 %result = Min Reg
return MINREG;
// 2986 %end
} /* end of CHEAPEST */
// 2987 %integerfn Spare Register
int SPAREREGISTER(void) {
// 2988 %result = R0 %if Activity(R0) = 0 %and Ktimes(R0) = 0
if (ACTIVITY[1] != 0) goto L_0293;
if (KTIMES[1] != 0) goto L_0293;
return 1;
L_0293:;
// 2989 %result = R1 %if ACtivity(R1) = 0 %and Ktimes(R1) = 0
if (ACTIVITY[2] != 0) goto L_0294;
if (KTIMES[2] != 0) goto L_0294;
return 2;
L_0294:;
// 2990 %result = R2 %if Activity(R2) = 0 %and Ktimes(R2) = 0
if (ACTIVITY[3] != 0) goto L_0295;
if (KTIMES[3] != 0) goto L_0295;
return 3;
L_0295:;
// 2991 %result = r3 %if Activity(R3) = 0 %and Ktimes(R3) = 0
if (ACTIVITY[4] != 0) goto L_0296;
if (KTIMES[4] != 0) goto L_0296;
return 4;
L_0296:;
// 2992 %result = 0
return 0;
// 2993 %end
} /* end of SPAREREGISTER */
// 2994 %integerfn Gpr
int GPR(void) {
// 2995 %result = Cheapest(R0)
return CHEAPEST(1);
// 2996 %end
} /* end of GPR */
// 2997 %integerfn Fpr
int FPR(void) {
// 2998 %result = Cheapest(F0)
return CHEAPEST(10);
// 2999 %end
} /* end of FPR */
// 3000
// 3001 {Descriptor Control}
// 3002
// 3003 {%record(Stackfm)%map}
// 3004 %integerfn Descriptor
int DESCRIPTOR(void) {
// 3005 %record(Stackfm)%name V
struct STACKFM *V;
// 3006 Fail("Descriptors") %if Dasl == Null
if (_imp_ADDR((void *)(DASL)) != _imp_ADDR((void *)(NULL))) goto L_0297;
FAIL(_imp_str_literal_size(63, "Descriptors"));
L_0297:;
// 3007 V == Dasl; Dasl == V_Using
V = (struct STACKFM *)DASL;
DASL = (struct STACKFM *)V->USING;
// 3008 V = 0
*V = (struct STACKFM){0};
// 3009 V_Using == Using; Using == V
V->USING = (struct STACKFM *)USING;
USING = (struct STACKFM *)V;
// 3010 Monitor(Null, "Descriptor") %if Diag&MonStack # 0
if (DIAG & 2 == 0) goto L_0298;
MONITOR(NULL, _imp_str_literal_size(15, "Descriptor"));
L_0298:;
// 3011 %result = Addr(V)
return _imp_ADDR(V);
// 3012 %end
} /* end of DESCRIPTOR */
// 3013 %routine Drop(%record(Stackfm)%name V)
void DROP(struct STACKFM * V) {
// 3014 %record(Stackfm)%name P, E
struct STACKFM *P;
struct STACKFM *E;
// 3015 Monitor(V, "Drop") %if Diag&MonStack # 0
if (DIAG & 2 == 0) goto L_0299;
MONITOR(V, _imp_str_literal_size(15, "Drop"));
L_0299:;
// 3016 %if V_Flags&In Work # 0 %start {release string workspace}
if (V->FLAGS & 1 == 0) goto L_029A;
// 3017 Ds Bias = Ds Bias-256
DSBIAS = DSBIAS - 256;
// 3018 Fail("String") %if DsBias < 0
if (DSBIAS >= 0) goto L_029B;
FAIL(_imp_str_literal_size(63, "String"));
L_029B:;
// 3019 %finish
L_029A:;
// 3020 %if Using == V %start {first is quick}
if (_imp_ADDR((void *)(USING)) != _imp_ADDR((void *)(V))) goto L_029C;
// 3021 Using == V_Using
USING = (struct STACKFM *)V->USING;
// 3022 %finish %else %start {otherwise search for it}
goto L_029D;
L_029C:;
// 3023 P == Using
P = (struct STACKFM *)USING;
// 3024 %cycle
L_029E:;
// 3025 Fail("Not in use") %if P == Null
if (_imp_ADDR((void *)(P)) != _imp_ADDR((void *)(NULL))) goto L_029F;
FAIL(_imp_str_literal_size(63, "Not in use"));
L_029F:;
// 3026 E == P
E = (struct STACKFM *)P;
// 3027 P == P_Using
P = (struct STACKFM *)P->USING;
// 3028 %repeat %until P == V
if (_imp_ADDR((void *)(P)) == _imp_ADDR((void *)(V))) goto L_02A0;
goto L_029E;
L_02A0:;
// 3029 E_Using == P_Using
E->USING = (struct STACKFM *)P->USING;
// 3030 %finish
L_029D:;
// 3031 V_Using == Dasl; Dasl == V
V->USING = (struct STACKFM *)DASL;
DASL = (struct STACKFM *)V;
// 3032 %end
return;
} /* end of DROP */
// 3033 %routine Pop Release and Drop
void POPRELEASEANDDROP(void) {
// 3034 %record(Stackfm)%name S
struct STACKFM *S;
// 3035 S == Stack
S = (struct STACKFM *)STACK;
// 3036 Stack == S_Stack
STACK = (struct STACKFM *)S->STACK;
// 3037 Release and Drop(S)
RELEASEANDDROP(S);
// 3038 %end
return;
} /* end of POPRELEASEANDDROP */
// 3039 {%record(Stackfm)%map}
// 3040 %integerfn Literal(%integer N)
int LITERAL(int N) {
// 3041 %record(Stackfm)%name V
struct STACKFM *V;
// 3042 V == Record(Descriptor)
V = (struct STACKFM *)_imp_RECORD(DESCRIPTOR());
// 3043 V_Disp = N
V->DISP = N;
// 3044 V_Type = Integers
V->TYPE = 1;
// 3045 %result = Addr(V)
return _imp_ADDR(V);
// 3046 %end
} /* end of LITERAL */
// 3047 {%record(Stackfm)%map}
// 3048 %integerfn Temporary
int TEMPORARY(void) {
// 3049 %record(Stackfm)%name T
struct STACKFM *T;
// 3050 Frame = (Frame+Alignment)&(\Alignment)
FRAME = FRAME + 1 & (~1);
// 3051 T == Record(Literal(Frame))
T = (struct STACKFM *)_imp_RECORD(LITERAL(FRAME));
// 3052 Frame = Frame+Word Length
FRAME = FRAME + 2;
// 3053 T_Base = Local
T->BASE = LOCAL;
// 3054 T_Form = VinS
T->FORM = 1;
// 3055 %result = Addr(T)
return _imp_ADDR(T);
// 3056 %end
} /* end of TEMPORARY */
// 3057 {%record(Stackfm)%map}
// 3058 %integerfn Copy(%record(Stackfm)%name V)
int COPY(struct STACKFM * V) {
// 3059 %record(Stackfm)%name C
struct STACKFM *C;
// 3060 %result = Addr(Null) %if V == Null
if (_imp_ADDR((void *)(V)) != _imp_ADDR((void *)(NULL))) goto L_02A1;
return _imp_ADDR(NULL);
L_02A1:;
// 3061 C == Record(Descriptor)
C = (struct STACKFM *)_imp_RECORD(DESCRIPTOR());
// 3062 C_Data = V_Data; Claim(C_Base); Claim(C_A_Base)
C->DATA = V->DATA;
CLAIM(C->BASE);
CLAIM(C->A.BASE);
// 3063 C_Oper = V_Oper
C->OPER = V->OPER;
// 3064 C_Link == Record(Copy(V_Link)) %unless V_Link == Null
if (_imp_ADDR((void *)(V->LINK)) == _imp_ADDR((void *)(NULL))) goto L_02A2;
C->LINK = (struct STACKFM *)_imp_RECORD(COPY(V->LINK));
L_02A2:;
// 3065 %result = Addr(C)
return _imp_ADDR(C);
// 3066 %end
} /* end of COPY */
// 3067
// 3068 {Stack control}
// 3069
// 3070 %routine Stack Var(%integer Varno)
void STACKVAR(int VARNO) {
// 3071 %record(Stackfm)%name V
struct STACKFM *V;
// 3072 V == Record(Descriptor)
V = (struct STACKFM *)_imp_RECORD(DESCRIPTOR());
// 3073 V_V = Var(Varno)
V->V = VAR[VARNO];
// 3074 V_Stack == Stack
V->STACK = (struct STACKFM *)STACK;
// 3075 Stack == V
STACK = (struct STACKFM *)V;
// 3076 %if V_Form = VinX %or V_Form = AinX %start
if (V->FORM == 4) goto L_028B;
if (V->FORM != 5) goto L_02A3;
L_028B:;
// 3077 V_Extra = V_Disp; V_Disp = 0
V->EXTRA = V->DISP;
V->DISP = 0;
// 3078 %finish
L_02A3:;
// 3079 %if V_Form = Proc %and Pending # 'p' %start
if (V->FORM != 6) goto L_02A4;
if (PENDING == 112) goto L_02A4;
// 3080 V_Bias = Ds Bias
V->BIAS = DSBIAS;
// 3081 Advance Ds
ADVANCEDS();
// 3082 %finish
L_02A4:;
// 3083 Monitor(V, "Stack Var") %if Diag&MonStack # 0
if (DIAG & 2 == 0) goto L_02A5;
MONITOR(V, _imp_str_literal_size(15, "Stack Var"));
L_02A5:;
// 3084 %end
return;
} /* end of STACKVAR */
// 3085 %routine Select(%integer Item)
void SELECT(int ITEM) {
// 3086 %integer X
int X;
// 3087 %record(Stackfm)%name V, Sub
struct STACKFM *V;
struct STACKFM *SUB;
// 3088 V == Stack
V = (struct STACKFM *)STACK;
// 3089 X = Var(-V_Format)_Extra-Item
X = VAR[-V->FORMAT].EXTRA - ITEM;
// 3090 Reduce Array(V) %if V_A_Scale # 0
if (V->A.SCALE == 0) goto L_02A6;
REDUCEARRAY(V);
L_02A6:;
// 3091
// 3092 Stack Var(X)
STACKVAR(X);
// 3093 Sub == Stack; Stack == Stack_Stack
SUB = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)STACK->STACK;
// 3094 Fail("Select") %if V_Form = VinR
if (V->FORM != 0) goto L_02A7;
FAIL(_imp_str_literal_size(63, "Select"));
L_02A7:;
// 3095 Reduce(V) %if V_Form = AinX
if (V->FORM != 5) goto L_02A8;
REDUCE(V);
L_02A8:;
// 3096 %if V_Form = VinS %start
if (V->FORM != 1) goto L_02A9;
// 3097 %if Sub_Form = VinS %start
if (SUB->FORM != 1) goto L_02AA;
// 3098 V_Disp = V_Disp+Sub_Disp
V->DISP = V->DISP + SUB->DISP;
// 3099 %finish %else %start
goto L_02AB;
L_02AA:;
// 3100 V_Form = VinX
V->FORM = 4;
// 3101 V_Extra = V_Disp+Sub_Extra
V->EXTRA = V->DISP + SUB->EXTRA;
// 3102 V_Disp = 0
V->DISP = 0;
// 3103 %finish
L_02AB:;
// 3104 %finish %else %start {VinX}
goto L_02AC;
L_02A9:;
// 3105 %if Sub_Form = VinS %start
if (SUB->FORM != 1) goto L_02AD;
// 3106 V_Disp = V_Disp+Sub_Disp
V->DISP = V->DISP + SUB->DISP;
// 3107 %finish %else %start
goto L_02AE;
L_02AD:;
// 3108 V_Form = AinX
V->FORM = 5;
// 3109 V_Disp = V_Disp+Sub_Extra
V->DISP = V->DISP + SUB->EXTRA;
// 3110 %finish
L_02AE:;
// 3111 %finish
L_02AC:;
// 3112 V_Format = Sub_Format
V->FORMAT = SUB->FORMAT;
// 3113 V_Type = Sub_Type
V->TYPE = SUB->TYPE;
// 3114 V_Flags = Sub_Flags
V->FLAGS = SUB->FLAGS;
// 3115 Monitor(V, "Select") %if Diag&MonStack # 0
if (DIAG & 2 == 0) goto L_02AF;
MONITOR(V, _imp_str_literal_size(15, "Select"));
L_02AF:;
// 3116 Drop(Sub)
DROP(SUB);
// 3117 %end
return;
} /* end of SELECT */
// 3118 %routine Stack Integer(%integer N)
void STACKINTEGER(int N) {
// 3119 %record(Stackfm)%name V
struct STACKFM *V;
// 3120 V == Record(Literal(N))
V = (struct STACKFM *)_imp_RECORD(LITERAL(N));
// 3121 V_Stack == Stack
V->STACK = (struct STACKFM *)STACK;
// 3122 Stack == V
STACK = (struct STACKFM *)V;
// 3123 %end
return;
} /* end of STACKINTEGER */
// 3124 %integerfn Popped Value
int POPPEDVALUE(void) {
// 3125 %record(Stackfm)%name V
struct STACKFM *V;
// 3126 V == Stack
V = (struct STACKFM *)STACK;
// 3127 Stack == V_Stack
STACK = (struct STACKFM *)V->STACK;
// 3128 Drop(V)
DROP(V);
// 3129 %result = V_Disp
return V->DISP;
// 3130 %end
} /* end of POPPEDVALUE */
// 3131
// 3132 {Label & Jump Handling}
// 3133
// 3134 %integerfn New Label
int NEWLABEL(void) {
// 3135 Free Label = Free Label+1
FREELABEL = FREELABEL + 1;
// 3136 %result = Free Label
return FREELABEL;
// 3137 %end
} /* end of NEWLABEL */
// 3138 %routine Jump to(%integer Internal Label, Cond Code)
void JUMPTO(int INTERNALLABEL, int CONDCODE) {
// 3139 %record(Stackfm) Z
struct STACKFM Z;
// 3140 Jlab = Internal Label {remember for Events}
JLAB = INTERNALLABEL;
// 3141 Cond Code = Reverse(Cond Code) %and Invert = 0 %if Invert # 0
if (INVERT == 0) goto L_02B0;
CONDCODE = REVERSE[CONDCODE - 1];
INVERT = 0;
L_02B0:;
// 3142 %if Cond Code = Always %then Dcode(Dir Ujump) %c
if (CONDCODE != 7) goto L_02B1;
DCODE(1);
goto L_02B2;
L_02B1:;
DCODE(2);
L_02B2:;
// 3143+ %else Dcode(Dir Cjump)
// 3144 Put with Ca(Internal Label)
PUTWITHCA(INTERNALLABEL);
// 3145 Ocode(Obj Jump); Printch(Cond Code+Unsigned); Unsigned = 0
OCODE(38);
PRINTCH(CONDCODE + UNSIGNED);
UNSIGNED = 0;
// 3146 %if Z Ca = Ca %and Cond Code = NE %start {zero known}
if (ZCA != *CA) goto L_02B3;
if (CONDCODE != 6) goto L_02B3;
// 3147 Z = 0
Z = (struct STACKFM){0};
// 3148 Z_Type = Integers
Z.TYPE = 1;
// 3149 Remember(Z Reg, Z)
REMEMBER(ZREG, /*?*/ &Z);
// 3150 %finish
L_02B3:;
// 3151 Ca = Ca+2 {assume 2 bytes worth}
*CA = *CA + 2;
// 3152 Cc1_Cc Ca = Cc1_Cc Ca+2
CC1.CCCA = CC1.CCCA + 2;
// 3153 Cc2_Cc Ca = Cc2_Cc Ca+2
CC2.CCCA = CC2.CCCA + 2;
// 3154 Uncond Jump = Ca %if Cond Code = Always {can't get past here}
if (CONDCODE != 7) goto L_02B4;
UNCONDJUMP = *CA;
L_02B4:;
// 3155 %end
return;
} /* end of JUMPTO */
// 3156 %routine Define Label(%integer Internal Label)
void DEFINELABEL(int INTERNALLABEL) {
// 3157 Dcode(Dir Label); Put with Ca(Internal Label)
DCODE(5);
PUTWITHCA(INTERNALLABEL);
// 3158 Ocode(Obj Label); Put(Internal Label)
OCODE(45);
PUT(INTERNALLABEL);
// 3159 Uncond Jump = -1 {can get here now}
UNCONDJUMP = -1;
// 3160 %end
return;
} /* end of DEFINELABEL */
// 3161 %routine Define Compiler Label(%integer Label)
void DEFINECOMPILERLABEL(int LABEL) {
// 3162 %integername L
int *L;
// 3163 L == Ilabel(Label)
L = (int *)/*?*/ &ILABEL[LABEL - 1];
// 3164 %if L&Defined # 0 %start {redefinition}
if (*L & 32768 == 0) goto L_02B5;
// 3165 Forget Environment(Label)
FORGETENVIRONMENT(LABEL);
// 3166 L = New Label
*L = NEWLABEL();
// 3167 %finish
L_02B5:;
// 3168 L = L!Defined {show it's defined}
*L = *L | 32768;
// 3169 Merge Environment(Label) %if Uncond Jump # Ca
if (UNCONDJUMP == *CA) goto L_02B6;
MERGEENVIRONMENT(LABEL);
L_02B6:;
// 3170 Define Label(L&Label Mask)
DEFINELABEL(*L & (-32769));
// 3171 Restore Environment(Label)
RESTOREENVIRONMENT(LABEL);
// 3172 %end
return;
} /* end of DEFINECOMPILERLABEL */
// 3173 %routine Jump Forward(%integer Label, Cond Code)
void JUMPFORWARD(int LABEL, int CONDCODE) {
// 3174 %integername L
int *L;
// 3175 L == Ilabel(Label)
L = (int *)/*?*/ &ILABEL[LABEL - 1];
// 3176 %if L&Defined # 0 %start {redefine it}
if (*L & 32768 == 0) goto L_02B7;
// 3177 L = New Label
*L = NEWLABEL();
// 3178 Remember Environment(Label)
REMEMBERENVIRONMENT(LABEL);
// 3179 %finish %else %start {another reference}
goto L_02B8;
L_02B7:;
// 3180 Merge Environment(Label)
MERGEENVIRONMENT(LABEL);
// 3181 %finish
L_02B8:;
// 3182 Jump To(L, Cond Code)
JUMPTO(*L, CONDCODE);
// 3183 %end
return;
} /* end of JUMPFORWARD */
// 3184 %routine Jump Backward(%integer Label)
void JUMPBACKWARD(int LABEL) {
// 3185 %record(Stackfm) C, F
struct STACKFM C;
struct STACKFM F;
// 3186 %record(Forfm)%name For
struct FORFM *FOR;
// 3187 %integername L
int *L;
// 3188 %integer How
int HOW;
// 3189 L == Ilabel(Label)
L = (int *)/*?*/ &ILABEL[LABEL - 1];
// 3190 How = Always
HOW = 7;
// 3191 Fail("Label missing") %if L&Defined = 0
if (*L & 32768 != 0) goto L_02B9;
FAIL(_imp_str_literal_size(63, "Label missing"));
L_02B9:;
// 3192 %if Forp # 0 %start
if (FORP == 0) goto L_02BA;
// 3193 For == Fors(Forp)
FOR = (struct FORFM *)/*?*/ &FORS[FORP];
// 3194 %if Label = For_Label %start {repeat of a %for statement}
if (LABEL != FOR->LABEL) goto L_02BB;
// 3195 C_Data = For_Control
C.DATA = FOR->CONTROL;
// 3196 Load(C, For_Reg)
LOAD(/*?*/ &C, FOR->REG);
// 3197 Define Compiler Label(For_Entry) %if For_Entry # 0
if (FOR->ENTRY == 0) goto L_02BC;
DEFINECOMPILERLABEL(FOR->ENTRY);
L_02BC:;
// 3198 F_Data = For_Final
F.DATA = FOR->FINAL;
// 3199 Compare(F, C)
COMPARE(/*?*/ &F, /*?*/ &C);
// 3200 Release(For_Reg)
RELEASE(FOR->REG);
// 3201 How = NE
HOW = 6;
// 3202 Forp = Forp-1
FORP = FORP - 1;
// 3203 %finish
L_02BB:;
// 3204 %finish
L_02BA:;
// 3205 Jump To(L&Label Mask, How)
JUMPTO(*L & (-32769), HOW);
// 3206 %end
return;
} /* end of JUMPBACKWARD */
// 3207 %routine Set User Label(%integer Label)
void SETUSERLABEL(int LABEL) {
// 3208 %record(Varfm)%name V
struct VARFM *V;
// 3209 V == Var(Label)
V = (struct VARFM *)/*?*/ &VAR[LABEL];
// 3210 Clear Vars(Label)
CLEARVARS(LABEL);
// 3211 V_Type = Labels
V->TYPE = 8;
// 3212 V_Disp = New Label
V->DISP = NEWLABEL();
// 3213 %end
return;
} /* end of SETUSERLABEL */
// 3214 %routine User Jump(%integer Label)
void USERJUMP(int LABEL) {
// 3215 %record(Varfm)%name V
struct VARFM *V;
// 3216 V == Var(Label)
V = (struct VARFM *)/*?*/ &VAR[LABEL];
// 3217 Set User Label(Label) %if Label > Vars {not yet allocated a var}
if (LABEL <= VARS) goto L_02BD;
SETUSERLABEL(LABEL);
L_02BD:;
// 3218 Jump To(V_Disp, Always)
JUMPTO(V->DISP, 7);
// 3219 %end
return;
} /* end of USERJUMP */
// 3220 %routine Define User Label(%integer Label)
void DEFINEUSERLABEL(int LABEL) {
// 3221 %record(Varfm)%name V
struct VARFM *V;
// 3222 V == Var(Label)
V = (struct VARFM *)/*?*/ &VAR[LABEL];
// 3223 Set User Label(Label) %if Label > Vars {not yet allocated a var}
if (LABEL <= VARS) goto L_02BE;
SETUSERLABEL(LABEL);
L_02BE:;
// 3224 Define Label(V_Disp)
DEFINELABEL(V->DISP);
// 3225 Forget Everything
FORGETEVERYTHING();
// 3226 %end
return;
} /* end of DEFINEUSERLABEL */
// 3227 %routine Return(%integer How)
void RETURN(int HOW) {
// 3228 %record(Stackfm)%name V
struct STACKFM *V;
// 3229 %if Uncond Jump = Ca %start
if (UNCONDJUMP != *CA) goto L_02BF;
// 3230 Pop Release and Drop %if How # 0
if (HOW == 0) goto L_02C0;
POPRELEASEANDDROP();
L_02C0:;
// 3231 %return
return;
// 3232 %finish
L_02BF:;
// 3233 %if How = True %start
if (HOW != 1) goto L_02C1;
// 3234 Plant0(SEC)
PLANT0(94);
// 3235 %finish %else %if How = False %start
goto L_02C2;
L_02C1:;
if (HOW != 2) goto L_02C3;
// 3236 Plant0(CLC)
PLANT0(38);
// 3237 %finish %else %if How # 0 %start
goto L_02C2;
L_02C3:;
if (HOW == 0) goto L_02C4;
// 3238 V == Stack; Stack == Stack_Stack
V = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)STACK->STACK;
// 3239 Loadup(V) %if V_Type = Strings %and V_Oper # 0
if (V->TYPE != 5) goto L_02C5;
if (V->OPER == 0) goto L_02C5;
LOADUP(V);
L_02C5:;
// 3240 Amap(V) %if How = Map
if (HOW != 4) goto L_02C6;
AMAP(V);
L_02C6:;
// 3241 Load(V, Result Reg)
LOAD(V, RESULTREG);
// 3242 Release and Drop(V)
RELEASEANDDROP(V);
// 3243 %finish
L_02C4:;
L_02C2:;
// 3244 Dcode(Dir Return); Put with Ca(0)
DCODE(4);
PUTWITHCA(0);
// 3245 Ocode(Obj Return)
OCODE(39);
// 3246 Ca = Ca+2 {assume two bytes}
*CA = *CA + 2;
// 3247 Uncond Jump = Ca {Can't get past here}
UNCONDJUMP = *CA;
// 3248 Open = 0 {the procedure returns}
OPEN = 0;
// 3249 %end
return;
} /* end of RETURN */
// 3250 %routine Compile For(%integer Repeat Label)
void COMPILEFOR(int REPEATLABEL) {
// 3251 %integer Type
int TYPE;
// 3252 %record(Stackfm)%name Initial, {initial value}
struct STACKFM *INITIAL;
struct STACKFM *FINAL;
struct STACKFM *INC;
struct STACKFM *CONTROL;
struct STACKFM *INCREMENT;
struct STACKFM *C;
// 3253+ Final, {final value}
// 3254+ Inc, {increment}
// 3255+ Control, {control variable}
// 3256+ Increment, {copy of increment}
// 3257+ C {copy of control}
// 3258
// 3259 %record(Forfm)%name For
struct FORFM *FOR;
// 3260 %routine Stab(%record(Stackfm)%name V)
void STAB(struct STACKFM * V) {
// 3261 %record(Stackfm)%name T
struct STACKFM *T;
// 3262 %return %if Const(V)#0
if (CONST(V) == 0) goto L_02C7;
return;
L_02C7:;
// 3263 T == Record(Temporary)
T = (struct STACKFM *)_imp_RECORD(TEMPORARY());
// 3264 T_Base = Local; T_Form = VinS
T->BASE = LOCAL;
T->FORM = 1;
// 3265 Store(T, V)
STORE(T, V);
// 3266 Replace(V, T)
REPLACE(V, T);
// 3267 Drop(T)
DROP(T);
// 3268 %end
return;
} /* end of STAB */
// 3269 %integerfn Loop Type
int LOOPTYPE(void) {
// 3270 %integer I, N
int I;
int N;
// 3271 %result = 1 %unless Const(Initial)#0 %and Const(Inc)#0 %c
if (CONST(INITIAL) == 0) goto L_02C8;
if (CONST(INC) == 0) goto L_02C8;
if (CONST(FINAL) != 0) goto L_02C9;
L_02C8:;
return 1;
L_02C9:;
// 3272+ %and Const(Final)#0
// 3273 I = Inc_Disp
I = INC->DISP;
// 3274 %if I # 0 %start
if (I == 0) goto L_02CA;
// 3275 N = Final_Disp-Initial_Disp+I
N = FINAL->DISP - INITIAL->DISP + I;
// 3276 %result = 1 %if N = 0 {zero iterations?}
if (N != 0) goto L_02CB;
return 1;
L_02CB:;
// 3277 %result = 0 %if N!!I >= 0 %and N-N//I*I = 0
if (N ^ I < 0) goto L_02CC;
if (N - ((long)N / (long)I) * I != 0) goto L_02CC;
return 0;
L_02CC:;
// 3278 %finish %else I = 1
goto L_02CD;
L_02CA:;
I = 1;
L_02CD:;
// 3279 Warn("Non-integral %for loop")
WARN(_imp_str_literal_size(63, "Non-integral %for loop"));
// 3280 Final_Disp = Initial_Disp+N//I*I
FINAL->DISP = INITIAL->DISP + ((long)N / (long)I) * I;
// 3281 %result = 1
return 1;
// 3282 %end
} /* end of LOOPTYPE */
// 3283
// 3284 Initial == Stack
INITIAL = (struct STACKFM *)STACK;
// 3285 Final == Initial_Stack
FINAL = (struct STACKFM *)INITIAL->STACK;
// 3286 Inc == Final_Stack
INC = (struct STACKFM *)FINAL->STACK;
// 3287 Control == Inc_Stack
CONTROL = (struct STACKFM *)INC->STACK;
// 3288 Stack == Control_Stack
STACK = (struct STACKFM *)CONTROL->STACK;
// 3289
// 3290 Stab(Inc)
STAB(INC);
// 3291 Stab(Final)
STAB(FINAL);
// 3292 %unless Control_Form = VinS %and Control_A_Scale = 0 %and %c
if (CONTROL->FORM != 1) goto L_02CE;
if (CONTROL->A.SCALE != 0) goto L_02CE;
if (CONTROL->BASE == 0) goto L_02CF;
if (CONTROL->BASE == LOCAL) goto L_02CF;
L_02CE:;
// 3293+ (Control_Base = 0 %or Control_Base = Local) %start
// 3294 {protect expensive (i.e. non-local) or moveable control variable}
// 3295 Type = Control_Type
TYPE = CONTROL->TYPE;
// 3296 Amap(Control); Stab(Control) {save its address}
AMAP(CONTROL);
STAB(CONTROL);
// 3297 Vmap(Control, Type)
VMAP(CONTROL, TYPE);
// 3298 %finish
L_02CF:;
// 3299
// 3300 Fail("Fors nested too deeply") %if Forp = Max Fors
if (FORP != 8) goto L_02D0;
FAIL(_imp_str_literal_size(63, "Fors nested too deeply"));
L_02D0:;
// 3301 Forp = Forp+1; For == Fors(Forp)
FORP = FORP + 1;
FOR = (struct FORFM *)/*?*/ &FORS[FORP];
// 3302 For_Label = Repeat Label
FOR->LABEL = REPEATLABEL;
// 3303 For_Control = Control_Data
FOR->CONTROL = CONTROL->DATA;
// 3304 For_Final = Final_Data
FOR->FINAL = FINAL->DATA;
// 3305 For_Entry = Loop Type {and check on the fly}
FOR->ENTRY = LOOPTYPE();
// 3306
// 3307 Increment == Record(Copy(Inc)) {beware of corruption in operate}
INCREMENT = (struct STACKFM *)_imp_RECORD(COPY(INC));
// 3308 Operate(SUBX, Initial, Inc)
OPERATE(4, INITIAL, INC);
// 3309 Loadup(Initial)
LOADUP(INITIAL);
// 3310 For_Reg = Initial_Base
FOR->REG = INITIAL->BASE;
// 3311 %if For_Entry # 0 %start
if (FOR->ENTRY == 0) goto L_02D1;
// 3312 {may never execute the loop}
// 3313 C == Record(Copy(Control))
C = (struct STACKFM *)_imp_RECORD(COPY(CONTROL));
// 3314 Store(C, Initial)
STORE(C, INITIAL);
// 3315 Drop(C)
DROP(C);
// 3316 For_Entry = Repeat Label+2
FOR->ENTRY = REPEATLABEL + 2;
// 3317 Jump Forward(For_Entry, Always)
JUMPFORWARD(FOR->ENTRY, 7);
// 3318 %finish
L_02D1:;
// 3319 Define Compiler Label(Repeat Label)
DEFINECOMPILERLABEL(REPEATLABEL);
// 3320
// 3321 Operate(ADDX, Initial, Increment)
OPERATE(3, INITIAL, INCREMENT);
// 3322 Store(Control, Initial)
STORE(CONTROL, INITIAL);
// 3323
// 3324 Release and Drop(Control)
RELEASEANDDROP(CONTROL);
// 3325 Release and Drop(Initial)
RELEASEANDDROP(INITIAL);
// 3326 Release and Drop(Final)
RELEASEANDDROP(FINAL);
// 3327 %end
return;
} /* end of COMPILEFOR */
// 3328 %routine Call External(%integer N)
void CALLEXTERNAL(int N) {
// 3329 Cword(8_004737); Plant(0, N) {JSR_Pc,@#0}
CWORD(2527);
PLANT(0, N);
// 3330 %end
return;
} /* end of CALLEXTERNAL */
// 3331 %routine Perm(%integer N)
void PERM(int N) {
// 3332 %integername P
int *P;
// 3333 %record(Varfm) V
struct VARFM V;
// 3334 %integer For
int FOR;
// 3335 For = N&Pall; N = N&255
FOR = N & 3840;
N = N & 255;
// 3336 Fail("Perm ") %unless Signal&255 <= N <= ShiftR&255
{
// Double-sided test on N (Part I)
int tmp;
if (1 & 255 > (tmp = N)) goto L_02D2;
// Double-sided test on N (Part II)
if (tmp <= 2331 & 255) goto L_02D3;
}
L_02D2:;
FAIL(_imp_str_literal_size(63, "Perm "));
L_02D3:;
// 3337 %if Diag&MonOperate # 0 %start
if (DIAG & 16 == 0) goto L_02D4;
// 3338 Select Output(0)
_imp_SELECTOUTPUT(0);
// 3339 Printstring("Perm "); Printstring(PermId(N)); Newline
_imp_PRINTSTRING(_imp_str_literal("Perm "));
_imp_PRINTSTRING(
*({
__typeof__(_imp_string9) tmp = PERMID[N - 1] /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 3340 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 3341 %finish
L_02D4:;
// 3342 P == Perm Used(N)
P = (int *)/*?*/ &PERMUSED[N - 1];
// 3343 %if P = 0 %start {first use}
if (*P != 0) goto L_02D5;
// 3344 External Id = Perm Id(N)
_imp_strncpy(/*?*/ &EXTERNALID, ({
__typeof__(_imp_string9) tmp; /*B*/
tmp = PERMID[N - 1];
(void *)&tmp;
}),
/*max:*/ 15);
// 3345 Dump External(Dir Notex, V)
DUMPEXTERNAL(10, /*?*/ &V);
// 3346 P = V_Area
*P = V.AREA;
// 3347 %finish
L_02D5:;
// 3348 Call External(P)
CALLEXTERNAL(*P);
// 3349 Forget(R0) %if For&Pr0 = 0
if (FOR & 256 != 0) goto L_02D6;
FORGET(1);
L_02D6:;
// 3350 Forget(R1) %if For&Pr1 = 0
if (FOR & 512 != 0) goto L_02D7;
FORGET(2);
L_02D7:;
// 3351 Forget(R2) %if For&Pr2 = 0
if (FOR & 1024 != 0) goto L_02D8;
FORGET(3);
L_02D8:;
// 3352 Forget(R3) %if For&Pr3 = 0
if (FOR & 2048 != 0) goto L_02D9;
FORGET(4);
L_02D9:;
// 3353 %end
return;
} /* end of PERM */
// 3354 %routine Perm Operation(%integer Oper, %record(Stackfm)%name A, B)
void PERMOPERATION(int OPER, struct STACKFM *A, struct STACKFM *B) {
// 3355 %if Oper = REXPx %start
if (OPER != 21) goto L_02DA;
// 3356 Load(A, F0)
LOAD(A, 10);
// 3357 Load(B, R2)
LOAD(B, 3);
// 3358 %finish %else %start
goto L_02DB;
L_02DA:;
// 3359 Load Pair(A, B)
LOADPAIR(A, B);
// 3360 %finish
L_02DB:;
// 3361 Release(A_Base)
RELEASE(A->BASE);
// 3362 Release(B_Base)
RELEASE(B->BASE);
// 3363 Perm(Perm Op(Oper))
PERM(PERMOP[OPER - 1]);
// 3364 Claim(A_Base)
CLAIM(A->BASE);
// 3365 %end
return;
} /* end of PERMOPERATION */
// 3366 %routine Compile Tostring
void COMPILETOSTRING(void) {
// 3367 %record(Stackfm)%name W, One
struct STACKFM *W;
struct STACKFM *ONE;
// 3368 %if Pending = '.' %start
if (PENDING != 46) goto L_02DC;
// 3369 loadup(stack) %if stack_oper # 0
if (STACK->OPER == 0) goto L_02DD;
LOADUP(STACK);
L_02DD:;
// 3370 %return
return;
// 3371 %finish
L_02DC:;
// 3372 %if Const(Stack) # 0 %start
if (CONST(STACK) == 0) goto L_02DE;
// 3373 String Value = Tostring(Stack_Disp)
_imp_strncpy(/*?*/ &STRINGVALUE, ({
__typeof__(_imp_string1) tmp; /*B*/
tmp = _imp_TOSTRING(STACK->DISP);
(void *)&tmp;
}),
/*max:*/ 255);
// 3374 Select Constant Area
SELECTCONSTANTAREA();
// 3375 Stack_Disp = Ca
STACK->DISP = *CA;
// 3376 Stack_Area = Constant Area
STACK->AREA = 2;
// 3377 Dump Text(1)
DUMPTEXT(1);
// 3378 Select Code Area
SELECTCODEAREA();
// 3379 %finish %else %start
goto L_02DF;
L_02DE:;
// 3380 W == Record(Temporary)
W = (struct STACKFM *)_imp_RECORD(TEMPORARY());
// 3381 W_Type = Bytes
W->TYPE = 2;
// 3382 W_Disp = W_Disp+1
W->DISP = W->DISP + 1;
// 3383 Move(Stack, W)
MOVE(STACK, W);
// 3384 One == Record(Literal(1))
ONE = (struct STACKFM *)_imp_RECORD(LITERAL(1));
// 3385 W_Disp = W_Disp - 1
W->DISP = W->DISP - 1;
// 3386 Plant2(Movb, One, W); Drop(One)
PLANT2(74, ONE, W);
DROP(ONE);
// 3387 Replace(Stack, W)
REPLACE(STACK, W);
// 3388 Drop(W)
DROP(W);
// 3389 %finish
L_02DF:;
// 3390 Stack_Form = VinS
STACK->FORM = 1;
// 3391 Stack_Type = Strings; Stack_Format = 2
STACK->TYPE = 5;
STACK->FORMAT = 2;
// 3392 %end
return;
} /* end of COMPILETOSTRING */
// 3393 %routine Special Call(%integer N)
void SPECIALCALL(int N) {
// 3394 %switch Sp(1:19)
int SP_index;
int SP_line;
char *SP_file;
static const void *SP[19] = {&&case_SP_missing, &&case_SP_missing, &&case_SP_missing, &&case_SP_missing,
&&case_SP_missing, &&case_SP_missing, &&case_SP_missing, &&case_SP_missing,
&&case_SP_missing, &&case_SP_missing, &&case_SP_missing, &&case_SP_missing,
&&case_SP_missing, &&case_SP_missing, &&case_SP_missing, &&case_SP_missing,
&&case_SP_missing, &&case_SP_missing, &&case_SP_missing};
// 3395 %record(Stackfm)%name V
struct STACKFM *V;
// 3396 V == Stack
V = (struct STACKFM *)STACK;
// 3397 %constbytearray Type Map(3:8) = Strings, Integers, Bytes, Reals,
const unsigned char TYPEMAP[6] = {5, 1, 2, 3, 4, 6};
// 3398+ Lreals, Records
// 3399 %constbytearray Len Map(3:8) = 0, 2, 1, 2, 4, 0
const unsigned char LENMAP[6] = {0, 2, 1, 2, 4, 0};
// 3400
// 3401 ->Sp(N)
SP_line = __LINE__;
SP_file = __FILE__;
SP_index = N;
goto case_SP_dispatch;
// 3402 Sp(19): Amap(V); %return {addr}
case_SP_19:;
AMAP(V);
return;
// 3403 Sp(1): {Readch}
case_SP_1:;
// 3404 Sp(2):Hazard All; Attributes = Attributes ! Attr Dynamic
case_SP_2:;
HAZARDALL();
ATTRIBUTES = ATTRIBUTES | 4096;
// 3405 Perm(Getch) {Getch}
PERM(25);
// 3406 V == Record(Register(R2)); Claim(R2)
V = (struct STACKFM *)_imp_RECORD(REGISTER(3));
CLAIM(3);
// 3407 V_Stack == Stack; Stack == V
V->STACK = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)V;
// 3408 Compile Tostring %if Stack_Stack_Type = Strings
if (STACK->STACK->TYPE != 5) goto L_02E1;
COMPILETOSTRING();
L_02E1:;
// 3409 Assign(Equals)
ASSIGN(0);
// 3410 %return
return;
// 3411 Sp(3): {string}
case_SP_3:;
// 3412 Sp(4): {integer, shortinteger, integer}
case_SP_4:;
// 3413 Sp(5): {byteinteger, byte}
case_SP_5:;
// 3414 Sp(6): {real}
case_SP_6:;
// 3415 Sp(7): {longreal, long}
case_SP_7:;
// 3416 Sp(8): Vmap(V, Type Map(N)) {record}
case_SP_8:;
VMAP(V, TYPEMAP[N - 3]);
// 3417 V_Format = Len Map(N)
V->FORMAT = LENMAP[N - 3];
// 3418 %return
return;
// 3419 Sp(9): Stack == Stack_Stack {rem}
case_SP_9:;
STACK = (struct STACKFM *)STACK->STACK;
// 3420 Operate(REMx, Stack, V)
OPERATE(14, STACK, V);
// 3421 %return
return;
// 3422 Sp(11): Amap(V) {length}
case_SP_11:;
AMAP(V);
// 3423 Vmap(V, Bytes)
VMAP(V, 2);
// 3424 V_Flags = V_Flags!Safe Byte %if 1 <= V_Format-1 <= 127
{
// Double-sided test on V->FORMAT - 1 (Part I)
int tmp;
if (1 > (tmp = V->FORMAT - 1)) goto L_02E2;
// Double-sided test on V->FORMAT - 1 (Part II)
if (tmp > 127) goto L_02E2;
}
V->FLAGS = V->FLAGS | 128;
L_02E2:;
// 3425 %return
return;
// 3426 Sp(12): Stack == Stack_Stack {charno}
case_SP_12:;
STACK = (struct STACKFM *)STACK->STACK;
// 3427 Amap(Stack)
AMAP(STACK);
// 3428 Operate(ADDx, Stack, V)
OPERATE(3, STACK, V);
// 3429 Vmap(Stack, Bytes)
VMAP(STACK, 2);
// 3430 %return
return;
// 3431 Sp(13): Stack Integer(Nl) {snl}
case_SP_13:;
STACKINTEGER(10);
// 3432 Sp(14): Compile Tostring; %return {tostring}
case_SP_14:;
COMPILETOSTRING();
return;
// 3433 Sp(15): {sizeof}
case_SP_15:;
// 3434 Sp(16): %if V_Type = Generals %start {typeof}
case_SP_16:;
if (V->TYPE != 7) goto L_02E3;
// 3435 Amap(V)
AMAP(V);
// 3436 V_Disp = V_Disp+(N-14)*2 {<addr><size><type>}
V->DISP = V->DISP + (N - 14) * 2;
// 3437 %finish %else %start
goto L_02E4;
L_02E3:;
// 3438 %if N = 15 {sizeof} %start
if (N != 15) goto L_02E5;
// 3439 N = Item Size(V_Format)
N = ITEMSIZE(V->FORMAT);
// 3440 %if N = 1 %and V_Type = Strings %start
if (N != 1) goto L_02E6;
if (V->TYPE != 5) goto L_02E6;
// 3441 V_Type = Integers
V->TYPE = 1;
// 3442 V_Form = VinS
V->FORM = 1;
// 3443 V_Disp = V_Disp+2
V->DISP = V->DISP + 2;
// 3444 %return
return;
// 3445 %finish
L_02E6:;
// 3446 %finish %else %start
goto L_02E7;
L_02E5:;
// 3447 N = Type Code(V_Type)
N = TYPECODE[V->TYPE];
// 3448 %finish
L_02E7:;
// 3449 Release(V_Base); Release(V_A_Base)
RELEASE(V->BASE);
RELEASE(V->A.BASE);
// 3450 V_Data = 0
V->DATA = (struct STACKFM){0};
// 3451 V_Disp = N
V->DISP = N;
// 3452 V_Type = Integers
V->TYPE = 1;
// 3453 %finish
L_02E4:;
// 3454 Sp(17): %return {intpt}
case_SP_17:;
return;
// 3455 Sp(18): Load(V, AnyF) {int}
case_SP_18:;
LOAD(V, 14);
// 3456 Cword(8_172027+Actual(V_Base)<<6) {ADDF_V,0.5}
CWORD(62487 + (ACTUAL[V->BASE] << 6));
// 3457 Cword(8_040000)
CWORD(16384);
// 3458 Forget(V_Base)
FORGET(V->BASE);
// 3459 %end
return;
case_SP_dispatch:
if (SP_index < 1 || SP_index > 19)
_imp_signalf(6, 3, SP_index, "->SP(%d) out of bounds at %s line %d", SP_index, SP_file, SP_line);
goto *SP[SP_index - 1];
case_SP_missing:
_imp_signalf(8, 2, SP_index, "switch jump to undefined label SP(%d): at %s line %d", SP_index, SP_file, SP_line);
} /* end of SPECIALCALL */
// 3460 %routine Pick Params(%record(Stackfm)%name P)
void PICKPARAMS(struct STACKFM * P) {
// 3461 %return %if P == Null
if (_imp_ADDR((void *)(P)) != _imp_ADDR((void *)(NULL))) goto L_02E8;
return;
L_02E8:;
// 3462 Optimise(P, 1)
OPTIMISE(P, 1);
// 3463 Pick Params(P_Params)
PICKPARAMS(P->PARAMS);
// 3464 %end
return;
} /* end of PICKPARAMS */
// 3465 %routine Load Params(%record(Stackfm)%name P)
void LOADPARAMS(struct STACKFM * P) {
// 3466 %record(Stackfm)%name W
struct STACKFM *W;
// 3467 %integer Reg
int REG;
// 3468 %return %if P == Null
if (_imp_ADDR((void *)(P)) != _imp_ADDR((void *)(NULL))) goto L_02E9;
return;
L_02E9:;
// 3469 W == P_Params; Reg = P_Preg
W = (struct STACKFM *)P->PARAMS;
REG = P->PREG;
// 3470 Load(P, Reg) %if Activity(Reg) = 0
if (ACTIVITY[REG] != 0) goto L_02EA;
LOAD(P, REG);
L_02EA:;
// 3471 Load Params(W)
LOADPARAMS(W);
// 3472 Load(P, Reg)
LOAD(P, REG);
// 3473 Release and Drop(P)
RELEASEANDDROP(P);
// 3474 %end
return;
} /* end of LOADPARAMS */
// 3475 %routine Call
void CALL(void) {
// 3476 %record(Stackfm)%name V, R
struct STACKFM *V;
struct STACKFM *R;
// 3477 %integer Dir, Ep
int DIR;
int EP;
// 3478 %integerfn Can Save R1
int CANSAVER1(void) {
// 3479 %record(Stackfm)%name W
struct STACKFM *W;
// 3480 %result = 0 %if V_Flags&Simple P = 0 %or Activity(R1) # 1
if (V->FLAGS & 2 == 0) goto L_02EB;
if (ACTIVITY[2] == 1) goto L_02EC;
L_02EB:;
return 0;
L_02EC:;
// 3481 W == Using
W = (struct STACKFM *)USING;
// 3482 %cycle
L_02ED:;
// 3483 %result = 0 %if W == Null
if (_imp_ADDR((void *)(W)) != _imp_ADDR((void *)(NULL))) goto L_02EE;
return 0;
L_02EE:;
// 3484 %exit %if W_Base = R1 %and W_Form = VinR %and W_Disp = 0
if (W->BASE != 2) goto L_02EF;
if (W->FORM != 0) goto L_02EF;
if (W->DISP != 0) goto L_02EF;
goto L_02F0;
L_02EF:;
// 3485 W == W_Using
W = (struct STACKFM *)W->USING;
// 3486 %repeat
goto L_02ED;
L_02F0:;
// 3487 W_Base = DS; W_Form = Adec
W->BASE = 6;
W->FORM = 3;
// 3488 Release(R1)
RELEASE(2);
// 3489 %result =-1
return -1;
// 3490 %end
} /* end of CANSAVER1 */
// 3491 V == Stack
V = (struct STACKFM *)STACK;
// 3492 Stack == Stack_Stack
STACK = (struct STACKFM *)STACK->STACK;
// 3493 %if V_Flags&Primitive # 0 %start
if (V->FLAGS & 32 == 0) goto L_02F1;
// 3494 Special Call(V_Disp)
SPECIALCALL(V->DISP);
// 3495 Drop(V)
DROP(V);
// 3496 %return
return;
// 3497 %finish
L_02F1:;
// 3498
// 3499 %routine Prefix Parameters(%record(Stackfm)%name W)
void PREFIXPARAMETERS(struct STACKFM * W) {
// 3500 %integer Z, N, Pass
int Z;
int N;
int PASS;
// 3501 %integername P
int *P;
// 3502 %record(Varfm)%name Q
struct VARFM *Q;
// 3503 %return %if W == Null %or V_Flags&(Xproc!Parameter) # 0
if (_imp_ADDR((void *)(W)) == _imp_ADDR((void *)(NULL))) goto L_02F2;
if (V->FLAGS & (64 | 4) == 0) goto L_02F3;
L_02F2:;
return;
L_02F3:;
// 3504 Prefix Parameters(W_Params) %if W_Params ## Null
if (_imp_ADDR((void *)(W->PARAMS)) == _imp_ADDR((void *)(NULL))) goto L_02F4;
PREFIXPARAMETERS(W->PARAMS);
L_02F4:;
// 3505 %return %if W_Preg = R3
if (W->PREG != 4) goto L_02F5;
return;
L_02F5:;
// 3506 %if Const(W)#0 %and (W_Disp = 1 %or W_Disp = -1) %start
if (CONST(W) == 0) goto L_02F6;
if (W->DISP == 1) goto L_02F7;
if (W->DISP != -1) goto L_02F6;
L_02F7:;
// 3507 W_Oper = ADDx
W->OPER = 3;
// 3508 W_Link == Record(Literal(W_Disp))
W->LINK = (struct STACKFM *)_imp_RECORD(LITERAL(W->DISP));
// 3509 W_Disp = 0
W->DISP = 0;
// 3510 %finish
L_02F6:;
// 3511 %if W_Oper = ADDx %and Const(W_Link)#0 %start
if (W->OPER != 3) goto L_02F8;
if (CONST(W->LINK) == 0) goto L_02F8;
// 3512 %if W_Preg = R1 %then N = 0 %else N = 1
if (W->PREG != 2) goto L_02F9;
N = 0;
goto L_02FA;
L_02F9:;
N = 1;
L_02FA:;
// 3513 Z = W_Link_Disp
Z = W->LINK->DISP;
// 3514 Q == Var(V_Area)
Q = (struct VARFM *)/*?*/ &VAR[V->AREA];
// 3515 %if N = 0 %then P == Q_Disp %else P == Q_Extra
if (N != 0) goto L_02FB;
P = (int *)/*?*/ &Q->DISP;
goto L_02FC;
L_02FB:;
P = (int *)/*?*/ &Q->EXTRA;
L_02FC:;
// 3516 Pass = 0
PASS = 0;
// 3517 Pass = 1 %if N = 0 %or Dir = Dir Prefix1 %or Q_Disp = 0
if (N == 0) goto L_02FD;
if (DIR == 21) goto L_02FD;
if (Q->DISP != 0) goto L_02FE;
L_02FD:;
PASS = 1;
L_02FE:;
// 3518 %if P = 0 %start
if (*P != 0) goto L_02FF;
// 3519 %return %if Q_Extra # 0 %or Pass = 0
if (Q->EXTRA != 0) goto L_0300;
if (PASS != 0) goto L_0301;
L_0300:;
return;
L_0301:;
// 3520 P = Z
*P = Z;
// 3521 %if Q_Area = 0 %start
if (Q->AREA != 0) goto L_0302;
// 3522 Free Label = Free Label+3
FREELABEL = FREELABEL + 3;
// 3523 Q_Area = Free Label
Q->AREA = FREELABEL;
// 3524 %finish
L_0302:;
// 3525 Dcode(Dir Entry1+N); Put(Z); Put(V_Disp); Put(Q_Area)
DCODE(16 + N);
PUT(Z);
PUT(V->DISP);
PUT(Q->AREA);
// 3526 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 3527 %finish
L_02FF:;
// 3528 %if P = Z %and Pass # 0 %start
if (*P != Z) goto L_0303;
if (PASS == 0) goto L_0303;
// 3529 Drop(W_Link); W_Oper = 0; W_Link == Null
DROP(W->LINK);
W->OPER = 0;
W->LINK = (struct STACKFM *)NULL;
// 3530 Ep = Q_Area-N
EP = Q->AREA - N;
// 3531 Dir = Dir Prefix1+N
DIR = 21 + N;
// 3532 %finish
L_0303:;
// 3533 %finish
L_02F8:;
// 3534 %end
return;
} /* end of PREFIXPARAMETERS */
// 3535
// 3536 Attributes = Attributes!Attr Dynamic
ATTRIBUTES = ATTRIBUTES | 4096;
// 3537 Ep = V_Disp
EP = V->DISP;
// 3538 Dir = Dir Call
DIR = 20;
// 3539 Prefix Parameters(V_Params)
PREFIXPARAMETERS(V->PARAMS);
// 3540 Pick Params(V_Params)
PICKPARAMS(V->PARAMS);
// 3541 Load Params(V_Params)
LOADPARAMS(V->PARAMS);
// 3542 %unless Can save R1#0 %start
if (CANSAVER1() != 0) goto L_0304;
// 3543 Hazard All
HAZARDALL();
// 3544 %finish %else %start
goto L_0305;
L_0304:;
// 3545 Cword(8_010125)
CWORD(4181);
// 3546 %finish
L_0305:;
// 3547 %if V_Flags&Xproc # 0 %start {external Call}
if (V->FLAGS & 64 == 0) goto L_0306;
// 3548 Call External(Ep)
CALLEXTERNAL(EP);
// 3549 %finish %else %if V_Flags&Parameter # 0 %start {procedure parameter call}
goto L_0307;
L_0306:;
if (V->FLAGS & 4 == 0) goto L_0308;
// 3550 %finish %else %start {normal internal call}
goto L_0307;
L_0308:;
// 3551 Dir = Dir+3 %if V_Flags&Closed # 0 {cannot return}
if (V->FLAGS & 128 == 0) goto L_0309;
DIR = DIR + 3;
L_0309:;
// 3552 Dcode(Dir); Put with Ca(Ep)
DCODE(DIR);
PUTWITHCA(EP);
// 3553 Ocode(Obj Call)
OCODE(36);
// 3554 Ca = Ca+2
*CA = *CA + 2;
// 3555 %finish
L_0307:;
// 3556 Retreat Ds(V_Bias)
RETREATDS(V->BIAS);
// 3557 Forget Everything
FORGETEVERYTHING();
// 3558
// 3559 %if V_Flags&Answer # 0 %start {set up result descriptor}
if (V->FLAGS & 16 == 0) goto L_030A;
// 3560 R == Record(Literal(0))
R = (struct STACKFM *)_imp_RECORD(LITERAL(0));
// 3561 R_Type = V_Type
R->TYPE = V->TYPE;
// 3562 R_Format = V_Format
R->FORMAT = V->FORMAT;
// 3563 %if R_Type >= Reals %then R_Base = F0 %else R_Base = Iresult
if (R->TYPE < 3) goto L_030B;
R->BASE = 10;
goto L_030C;
L_030B:;
R->BASE = 3;
L_030C:;
// 3564 %if V_Flags&Indirect # 0 %or V_Type = Strings %c
if (V->FLAGS & 8 != 0) goto L_030D;
if (V->TYPE == 5) goto L_030D;
if (V->TYPE != 6) goto L_030E;
L_030D:;
// 3565+ %or V_Type = Records %start
// 3566 R_Base = Iresult
R->BASE = 3;
// 3567 R_Form = VinS
R->FORM = 1;
// 3568 %finish
L_030E:;
// 3569 Claim(R_Base)
CLAIM(R->BASE);
// 3570 %if V_Flags&Indirect = 0 %and V_Type = Strings %c
if (V->FLAGS & 8 != 0) goto L_030F;
if (V->TYPE != 5) goto L_030F;
if (PENDING == 63) goto L_030F;
if (PENDING == 83) goto L_030F;
if (PENDING == 112) goto L_030F;
// 3571+ %and Pending # '?' %c
// 3572+ %and Pending # 'S' %c
// 3573+ %and Pending # 'p' %start
// 3574 To Work Area(R); Vmap(R, Strings)
TOWORKAREA(R);
VMAP(R, 5);
// 3575 %finish
L_030F:;
// 3576 R_Stack == Stack; Stack == R
R->STACK = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)R;
// 3577 %finish
L_030A:;
// 3578 Uncond Jump = Ca %if V_Flags&Closed # 0
if (V->FLAGS & 128 == 0) goto L_0310;
UNCONDJUMP = *CA;
L_0310:;
// 3579 Drop(V)
DROP(V);
// 3580 %end
return;
} /* end of CALL */
// 3581 %routine Switch Label(%integer Tag)
void SWITCHLABEL(int TAG) {
// 3582 %record(Varfm)%name V
struct VARFM *V;
// 3583 %integer X
int X;
// 3584 V == Var(Tag)
V = (struct VARFM *)/*?*/ &VAR[TAG];
// 3585 X = V_Extra+Popped Value
X = V->EXTRA + POPPEDVALUE();
// 3586 Dcode(Dir Slab); Put with Ca(X)
DCODE(18);
PUTWITHCA(X);
// 3587 Ocode(Obj Label); Put(X)
OCODE(45);
PUT(X);
// 3588 Uncond Jump = -1
UNCONDJUMP = -1;
// 3589 Forget Everything
FORGETEVERYTHING();
// 3590 %end
return;
} /* end of SWITCHLABEL */
// 3591 %routine Switch Jump(%integer Tag)
void SWITCHJUMP(int TAG) {
// 3592 %record(Varfm)%name V
struct VARFM *V;
// 3593 %record(Stackfm)%name X
struct STACKFM *X;
// 3594 V == Var(Tag)
V = (struct VARFM *)/*?*/ &VAR[TAG];
// 3595 X == Stack
X = (struct STACKFM *)STACK;
// 3596 Stack == Stack_Stack
STACK = (struct STACKFM *)STACK->STACK;
// 3597 Operate(MULx, X, Record(Literal(2))) {index*2}
OPERATE(5, X, _imp_RECORD(LITERAL(2)));
// 3598 %if Const(X)#0 %start
if (CONST(X) == 0) goto L_0311;
// 3599 X_Extra = X_Disp+V_Disp
X->EXTRA = X->DISP + V->DISP;
// 3600 %finish %else %start
goto L_0312;
L_0311:;
// 3601 Loadup(X)
LOADUP(X);
// 3602 X_Extra = V_Disp
X->EXTRA = V->DISP;
// 3603 %finish
L_0312:;
// 3604 X_Disp = 0
X->DISP = 0;
// 3605 X_Form = VinX
X->FORM = 4;
// 3606 X_Area = V_Area
X->AREA = V->AREA;
// 3607 Plant1(JMP, X); Release and Drop(X)
PLANT1(63, X);
RELEASEANDDROP(X);
// 3608 Uncond Jump = Ca {can't get past}
UNCONDJUMP = *CA;
// 3609 %end
return;
} /* end of SWITCHJUMP */
// 3610 %routine Event Trap(%integer Bits)
void EVENTTRAP(int BITS) {
// 3611 {###################################################}
// 3612 {# Block(......) #}
// 3613 {# ............ #}
// 3614 {# %on EVENT BITS %start #}
// 3615 {# Event Label -> ....... #}
// 3616 {# ....... #}
// 3617 {# %finish #}
// 3618 {# Event Body -> ....... #}
// 3619 {# ....... #}
// 3620 {# %end #}
// 3621 {###################################################}
// 3622 %integer Lab
int LAB;
// 3623 Lab = Tag
LAB = TAG();
// 3624 Frame = (Frame+Alignment)&(\Alignment)
FRAME = FRAME + 1 & (~1);
// 3625 Cword(8_010564); Cword(Frame) {MOV_DS,Frame}
CWORD(4468);
CWORD(FRAME);
// 3626 Jump Forward(Lab, Always)
JUMPFORWARD(LAB, 7);
// 3627 Event Bits = Bits
EVENTBITS = BITS;
// 3628 Event Body = Jlab
EVENTBODY = JLAB;
// 3629 Event Label = New Label
EVENTLABEL = NEWLABEL();
// 3630 Define Label(Event Label)
DEFINELABEL(EVENTLABEL);
// 3631 Dcode(Dir McUsed); Put with Ca(Event Label) {force used}
DCODE(14);
PUTWITHCA(EVENTLABEL);
// 3632 Ocode(Obj Dummy)
OCODE(35);
// 3633 Cword(8_016405); Cword(Frame) {MOV_Frame,DS}
CWORD(7429);
CWORD(FRAME);
// 3634 Frame = Frame+Word Length
FRAME = FRAME + 2;
// 3635 Attributes = Attributes!Attr Dynamic!Attr Uses Locals
ATTRIBUTES = ATTRIBUTES | 4096 | 2048;
// 3636 Event Count = Event Count+8 {size of event list}
EVENTCOUNT = EVENTCOUNT + 8;
// 3637 %end
return;
} /* end of EVENTTRAP */
// 3638 %routine Signal Event(%integer Event)
void SIGNALEVENT(int EVENT) {
// 3639 %record(Stackfm)%name E, Sub Event, Extra
struct STACKFM *E;
struct STACKFM *SUBEVENT;
struct STACKFM *EXTRA;
// 3640 Extra == Stack
EXTRA = (struct STACKFM *)STACK;
// 3641 Sub Event == Extra_Stack
SUBEVENT = (struct STACKFM *)EXTRA->STACK;
// 3642 Stack == Sub Event_Stack
STACK = (struct STACKFM *)SUBEVENT->STACK;
// 3643 %if Const(Sub Event)#0 %and Const(Extra)#0 %and Extra_Disp = 0 %start
if (CONST(SUBEVENT) == 0) goto L_0313;
if (CONST(EXTRA) == 0) goto L_0313;
if (EXTRA->DISP != 0) goto L_0313;
// 3644 Perm(Const Sig)
PERM(20);
// 3645 Cword(Sub Event_Disp<<8+Event)
CWORD((SUBEVENT->DISP << 8) + EVENT);
// 3646 Drop(Sub Event); Drop(Extra)
DROP(SUBEVENT);
DROP(EXTRA);
// 3647 %finish %else %start
goto L_0314;
L_0313:;
// 3648 Load Pair(Sub Event, Extra)
LOADPAIR(SUBEVENT, EXTRA);
// 3649 E == Record(Literal(Event))
E = (struct STACKFM *)_imp_RECORD(LITERAL(EVENT));
// 3650 Load(E, R0)
LOAD(E, 1);
// 3651 Release and Drop(E)
RELEASEANDDROP(E);
// 3652 Release and Drop(Sub Event)
RELEASEANDDROP(SUBEVENT);
// 3653 Release and Drop(Extra)
RELEASEANDDROP(EXTRA);
// 3654 Perm(Signal)
PERM(1);
// 3655 %finish
L_0314:;
// 3656 Uncond Jump = Ca
UNCONDJUMP = *CA;
// 3657 Attributes = Attributes!Attr Dynamic
ATTRIBUTES = ATTRIBUTES | 4096;
// 3658 %end
return;
} /* end of SIGNALEVENT */
// 3659
// 3660
// 3661 %routine Operation(%integer Oper)
void OPERATION(int OPER) {
// 3662 %record(Stackfm)%name V
struct STACKFM *V;
// 3663 V == Stack
V = (struct STACKFM *)STACK;
// 3664 Stack == Stack_Stack
STACK = (struct STACKFM *)STACK->STACK;
// 3665 Operate(Oper, Stack, V)
OPERATE(OPER, STACK, V);
// 3666 %end
return;
} /* end of OPERATION */
// 3667
// 3668
// 3669 %routine Test Zero(%record(Stackfm)%name V)
void TESTZERO(struct STACKFM * V) {
// 3670 %record(Stackfm)%name W
struct STACKFM *W;
// 3671 %integer Op
int OP;
// 3672 Monitor(V, "Tzero") %if Diag&MonCond # 0
if (DIAG & 256 == 0) goto L_0315;
MONITOR(V, _imp_str_literal_size(15, "Tzero"));
L_0315:;
// 3673 %if V_Oper # 0 %start
if (V->OPER == 0) goto L_0316;
// 3674 W == V_Link
W = (struct STACKFM *)V->LINK;
// 3675 %if (Pending = '=' %or Pending = '#') %and V_Oper = BICx %c
if (PENDING == 61) goto L_0317;
if (PENDING != 35) goto L_0318;
L_0317:;
if (V->OPER != 11) goto L_0318;
if (CONST(W) == 0) goto L_0318;
// 3676+ %and Const(W)#0 %start
// 3677 W_Disp = \W_Disp
W->DISP = (~W->DISP);
// 3678 V_Oper = 0; V_Link == Null
V->OPER = 0;
V->LINK = (struct STACKFM *)NULL;
// 3679 %if V_Type = Integers %then Op = Bit %else Op = Bitb
if (V->TYPE != 1) goto L_0319;
OP = 23;
goto L_031A;
L_0319:;
OP = 24;
L_031A:;
// 3680 %if Op = Bit %and W_Disp&x'FFFF' = x'8000' %start
if (OP != 23) goto L_031B;
if (W->DISP & 65535 != 32768) goto L_031B;
// 3681 Test Zero(V)
TESTZERO(V);
// 3682 %if Pending = '=' %then Pending = ')' %c
if (PENDING != 61) goto L_031C;
PENDING = 41;
goto L_031D;
L_031C:;
PENDING = 60;
L_031D:;
// 3683+ %else Pending = '<'
// 3684 %finish %else %start
goto L_031E;
L_031B:;
// 3685 Plant2(Op, V, W)
PLANT2(OP, V, W);
// 3686 %finish
L_031E:;
// 3687 Drop(W)
DROP(W);
// 3688 %return
return;
// 3689 %finish
L_0318:;
// 3690 Loadup(V)
LOADUP(V);
// 3691 %finish
L_0316:;
// 3692 Unsigned = 0
UNSIGNED = 0;
// 3693 %if V_Type = Bytes %start
if (V->TYPE != 2) goto L_031F;
// 3694 Unsigned = 10; Op = Tstb
UNSIGNED = 10;
OP = 115;
// 3695 %finish %else %if Floating(V)#0 %start
goto L_0320;
L_031F:;
if (FLOATING(V) == 0) goto L_0321;
// 3696 Op = TstF
OP = 116;
// 3697 %finish %else %start
goto L_0320;
L_0321:;
// 3698 Op = Tst
OP = 114;
// 3699 %finish
L_0320:;
// 3700 Plant1(Op, V)
PLANT1(OP, V);
// 3701 %if Op = TSTF %start
if (OP != 116) goto L_0322;
// 3702 Plant0(Cfcc)
PLANT0(37);
// 3703 %finish %else %if V_Form = VinR %start
goto L_0323;
L_0322:;
if (V->FORM != 0) goto L_0324;
// 3704 Z Reg = V_Base
ZREG = V->BASE;
// 3705 Z Ca = Ca
ZCA = *CA;
// 3706 %finish
L_0324:;
L_0323:;
// 3707 %end
return;
} /* end of TESTZERO */
// 3708 %routine Test Null(%record(Stackfm)%name V)
void TESTNULL(struct STACKFM * V) {
// 3709 V == Record(Copy(V))
V = (struct STACKFM *)_imp_RECORD(COPY(V));
// 3710 V_Type = Bytes
V->TYPE = 2;
// 3711 Test Zero(V)
TESTZERO(V);
// 3712 Release and Drop(V)
RELEASEANDDROP(V);
// 3713 %end
return;
} /* end of TESTNULL */
// 3714 %routine Compare Strings(%record(Stackfm)%name Left, Right)
void COMPARESTRINGS(struct STACKFM * LEFT, struct STACKFM * RIGHT) {
// 3715 %if Left_Oper = 0 = Right_Oper %start
{
// Double-sided test on 0 (Part I)
int tmp;
if (LEFT->OPER != (tmp = 0)) goto L_0325;
// Double-sided test on 0 (Part II)
if (tmp != RIGHT->OPER) goto L_0325;
}
// 3716 %if Right_Format = 1 %and Right_Form = V in S %start {Null string}
if (RIGHT->FORMAT != 1) goto L_0326;
if (RIGHT->FORM != 1) goto L_0326;
// 3717 Test Null(Left)
TESTNULL(LEFT);
// 3718 %return
return;
// 3719 %finish
L_0326:;
// 3720 %if Left_Format = 1 %and Left_Form = V in S %start {Null string}
if (LEFT->FORMAT != 1) goto L_0327;
if (LEFT->FORM != 1) goto L_0327;
// 3721 Test Null(Right)
TESTNULL(RIGHT);
// 3722 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3723 %return
return;
// 3724 %finish
L_0327:;
// 3725 %finish
L_0325:;
// 3726 %if Left_Base = R2 %or Right_Base = R1 %start
if (LEFT->BASE == 3) goto L_0328;
if (RIGHT->BASE != 2) goto L_0329;
L_0328:;
// 3727 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3728 Load Pair(Right, Left)
LOADPAIR(RIGHT, LEFT);
// 3729 %finish %else %start
goto L_032A;
L_0329:;
// 3730 Load Pair(Left, Right)
LOADPAIR(LEFT, RIGHT);
// 3731 %finish
L_032A:;
// 3732 Perm(Scomp)
PERM(9);
// 3733 %end
return;
} /* end of COMPARESTRINGS */
// 3734 %routine Compare Bytes(%record(Stackfm)%name L, R)
void COMPAREBYTES(struct STACKFM * L, struct STACKFM * R) {
// 3735 %if R_Type = Bytes %or (Const(R)#0 %and R_Disp>>8 = 0) %start
if (R->TYPE == 2) goto L_032B;
if (CONST(R) == 0) goto L_032C;
if ((unsigned int)R->DISP >> 8 != 0) goto L_032C;
L_032B:;
// 3736 %if InReg(L)#0 %start
if (INREG(L) == 0) goto L_032D;
// 3737 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3738 Plant2(Cmpb, R, L)
PLANT2(46, R, L);
// 3739 %finish %else %start
goto L_032E;
L_032D:;
// 3740 Plant2(Cmpb, L, R)
PLANT2(46, L, R);
// 3741 %finish
L_032E:;
// 3742 %finish %else %start
goto L_032F;
L_032C:;
// 3743 Load(L, AnyG)
LOAD(L, 9);
// 3744 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3745 Plant2(Cmp, R, L)
PLANT2(45, R, L);
// 3746 %finish
L_032F:;
// 3747 Unsigned = 10
UNSIGNED = 10;
// 3748 %end
return;
} /* end of COMPAREBYTES */
// 3749 %routine Compare Reals(%record(Stackfm)%name Left, Right)
void COMPAREREALS(struct STACKFM * LEFT, struct STACKFM * RIGHT) {
// 3750 {Beware: Cmpf is reversed in relation to Cmp}
// 3751 Float(Right, Left) %unless Floating(Right)#0
if (FLOATING(RIGHT) != 0) goto L_0330;
FLOAT(RIGHT, LEFT);
L_0330:;
// 3752 %if InReg(Left)#0 %start
if (INREG(LEFT) == 0) goto L_0331;
// 3753 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3754 PlantF(CMPF, Left_Base, Right)
PLANTF(47, LEFT->BASE, RIGHT);
// 3755 %finish %else %start
goto L_0332;
L_0331:;
// 3756 Load(Right, AnyF)
LOAD(RIGHT, 14);
// 3757 PlantF(CMPF,Right_Base, Left)
PLANTF(47, RIGHT->BASE, LEFT);
// 3758 %finish
L_0332:;
// 3759 %end
return;
} /* end of COMPAREREALS */
// 3760 %routine Try for Zero(%record(Stackfm)%name V, %integer Mod)
void TRYFORZERO(struct STACKFM * V, int MOD) {
// 3761 %integer Old
int OLD;
// 3762 Old = Pending
OLD = PENDING;
// 3763 %if V_Disp-Mod = 0 %start
if (V->DISP - MOD != 0) goto L_0333;
// 3764 %if Pending = '<' %start {>=1 :: >0}
if (PENDING != 60) goto L_0334;
// 3765 Pending = '('
PENDING = 40;
// 3766 %finish %else %if Pending = ')' %start {<1 :: <=0}
goto L_0335;
L_0334:;
if (PENDING != 41) goto L_0336;
// 3767 Pending = '>'
PENDING = 62;
// 3768 %finish
L_0336:;
L_0335:;
// 3769 %finish %else %if V_Disp+Mod = 0 %start
goto L_0337;
L_0333:;
if (V->DISP + MOD != 0) goto L_0338;
// 3770 %if Pending = '>' %start {<=-1 :: <0}
if (PENDING != 62) goto L_0339;
// 3771 Pending = ')'
PENDING = 41;
// 3772 %finish %else %if Pending = '(' %start {>-1 :: >=0}
goto L_033A;
L_0339:;
if (PENDING != 40) goto L_033B;
// 3773 Pending = '<'
PENDING = 60;
// 3774 %finish
L_033B:;
L_033A:;
// 3775 %finish
L_0338:;
L_0337:;
// 3776 V_Disp = 0 %if Pending # Old
if (PENDING == OLD) goto L_033C;
V->DISP = 0;
L_033C:;
// 3777 %end
return;
} /* end of TRYFORZERO */
// 3778 %routine Compare(%record(Stackfm)%name Left, Right)
void COMPARE(struct STACKFM * LEFT, struct STACKFM * RIGHT) {
// 3779 %if Pending Tag # 0 %start
if (PENDINGTAG == 0) goto L_033D;
// 3780 %if (Pending # '>' %and Pending # ')') %or %c
if (PENDING == 62) goto L_033E;
if (PENDING != 41) goto L_033F;
L_033E:;
if (RIGHT->DISP < 0) goto L_033F;
if (CONST(RIGHT) != 0) goto L_0340;
L_033F:;
// 3781+ Right_Disp < 0 %or Const(Right)=0 %start
// 3782 Test Zero(Left)
TESTZERO(LEFT);
// 3783 Jump Forward(Pending Tag, LT)
JUMPFORWARD(PENDINGTAG, 2);
// 3784 %finish %else %start
goto L_0341;
L_0340:;
// 3785 Unsigned = 10
UNSIGNED = 10;
// 3786 %finish
L_0341:;
// 3787 Pending Tag = 0
PENDINGTAG = 0;
// 3788 %finish
L_033D:;
// 3789 %if Left_Type = Strings %start
if (LEFT->TYPE != 5) goto L_0342;
// 3790 Compare Strings(Left, Right)
COMPARESTRINGS(LEFT, RIGHT);
// 3791 %return
return;
// 3792 %finish
L_0342:;
// 3793 %if Const(Right)#0 %start
if (CONST(RIGHT) == 0) goto L_0343;
// 3794 Try for zero(Right, 1)
TRYFORZERO(RIGHT, 1);
// 3795 %if Right_Disp = 0 %start
if (RIGHT->DISP != 0) goto L_0344;
// 3796 Test Zero(Left); %return
TESTZERO(LEFT);
return;
// 3797 %finish
L_0344:;
// 3798 %finish %else %if Const(Left)#0 %start
goto L_0345;
L_0343:;
if (CONST(LEFT) == 0) goto L_0346;
// 3799 Try for zero(Left, -1)
TRYFORZERO(LEFT, -1);
// 3800 %if Left_Disp = 0 %start
if (LEFT->DISP != 0) goto L_0347;
// 3801 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3802 Test Zero(Right); %return
TESTZERO(RIGHT);
return;
// 3803 %finish
L_0347:;
// 3804 %finish
L_0346:;
L_0345:;
// 3805 Loadup(Left) %if Left_Oper # 0
if (LEFT->OPER == 0) goto L_0348;
LOADUP(LEFT);
L_0348:;
// 3806 Loadup(Right) %if Right_Oper # 0
if (RIGHT->OPER == 0) goto L_0349;
LOADUP(RIGHT);
L_0349:;
// 3807 %if Floating(Left)#0 %start
if (FLOATING(LEFT) == 0) goto L_034A;
// 3808 Compare Reals(Left, Right); %return
COMPAREREALS(LEFT, RIGHT);
return;
// 3809 %finish %else %if Floating(Right)#0 %start
L_034A:;
if (FLOATING(RIGHT) == 0) goto L_034B;
// 3810 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3811 Compare Reals(Right, Left); %return
COMPAREREALS(RIGHT, LEFT);
return;
// 3812 %finish
L_034B:;
// 3813 %if Left_Type = Bytes %start
if (LEFT->TYPE != 2) goto L_034C;
// 3814 Compare Bytes(Left, Right); %return
COMPAREBYTES(LEFT, RIGHT);
return;
// 3815 %finish %else %if Right_Type = Bytes %start
L_034C:;
if (RIGHT->TYPE != 2) goto L_034D;
// 3816 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3817 Compare Bytes(Right, Left); %return
COMPAREBYTES(RIGHT, LEFT);
return;
// 3818 %finish
L_034D:;
// 3819 %if InReg(Left)#0 %start
if (INREG(LEFT) == 0) goto L_034E;
// 3820 Invert = Invert!!Inverted
INVERT = INVERT ^ 1;
// 3821 Plant2(Cmp, Right, Left)
PLANT2(45, RIGHT, LEFT);
// 3822 %finish %else %start
goto L_034F;
L_034E:;
// 3823 Plant2(Cmp, Left, Right)
PLANT2(45, LEFT, RIGHT);
// 3824 %finish
L_034F:;
// 3825 %end
return;
} /* end of COMPARE */
// 3826 %routine Compare Values
void COMPAREVALUES(void) {
// 3827 %record(Stackfm)%name L, R
struct STACKFM *L;
struct STACKFM *R;
// 3828 R == Stack
R = (struct STACKFM *)STACK;
// 3829 L == R_Stack; Stack == L_Stack
L = (struct STACKFM *)R->STACK;
STACK = (struct STACKFM *)L->STACK;
// 3830 Compare(L, R)
COMPARE(L, R);
// 3831 Release and Drop(L); Release and Drop(R)
RELEASEANDDROP(L);
RELEASEANDDROP(R);
// 3832 %end
return;
} /* end of COMPAREVALUES */
// 3833 %routine Compare Double
void COMPAREDOUBLE(void) {
// 3834 %integer Type
int TYPE;
// 3835 %record(Stackfm)%name L, R
struct STACKFM *L;
struct STACKFM *R;
// 3836 R == Stack
R = (struct STACKFM *)STACK;
// 3837 L == R_Stack
L = (struct STACKFM *)R->STACK;
// 3838 R_Stack == L_Stack
R->STACK = (struct STACKFM *)L->STACK;
// 3839 Type = R_Type
TYPE = R->TYPE;
// 3840 Loadup(R) %if R_Oper # 0 %or %c
if (R->OPER != 0) goto L_0350;
if (TYPE > 4) goto L_0351;
if (R->DISP == 0) goto L_0351;
if (CONST(R) != 0) goto L_0351;
L_0350:;
LOADUP(R);
L_0351:;
// 3841+ (Type <= Lreals %and R_Disp # 0 %and %not Const(R)#0)
// 3842 {beware %if 0 # X&7 # 5}
// 3843 {Note: CMP_X,?&CMP_X,? slower than MOV_X,R&CMP_R&CMP_R}
// 3844 %if Pending = '>' %and L_Disp = 0 %and Const(L)#0 %start
if (PENDING != 62) goto L_0352;
if (L->DISP != 0) goto L_0352;
if (CONST(L) == 0) goto L_0352;
// 3845 {optimise 0<=N<=...}
// 3846 Readch(Pending)
READCH(/*?*/ &PENDING);
// 3847 Pending Tag = Tag
PENDINGTAG = TAG();
// 3848 %finish %else %start
goto L_0353;
L_0352:;
// 3849 Compare(L, R)
COMPARE(L, R);
// 3850 Vmap(R, Strings) %if Type = Strings
if (TYPE != 5) goto L_0354;
VMAP(R, 5);
L_0354:;
// 3851 %finish
L_0353:;
// 3852 Release and Drop(L)
RELEASEANDDROP(L);
// 3853 %end
return;
} /* end of COMPAREDOUBLE */
// 3854 %routine Compare Addresses
void COMPAREADDRESSES(void) {
// 3855 %record(Stackfm)%name L, R
struct STACKFM *L;
struct STACKFM *R;
// 3856 R == Stack
R = (struct STACKFM *)STACK;
// 3857 L == R_Stack; Stack == L_Stack
L = (struct STACKFM *)R->STACK;
STACK = (struct STACKFM *)L->STACK;
// 3858 Amap(L); Amap(R)
AMAP(L);
AMAP(R);
// 3859 Compare(L, R)
COMPARE(L, R);
// 3860 Release and Drop(L); Release and Drop(R)
RELEASEANDDROP(L);
RELEASEANDDROP(R);
// 3861 %end
return;
} /* end of COMPAREADDRESSES */
// 3862 %routine Push and Pop
void PUSHANDPOP(void) {
// 3863 %record(Stackfm)%name S
struct STACKFM *S;
// 3864 S == Stack
S = (struct STACKFM *)STACK;
// 3865 Stack == S_Stack
STACK = (struct STACKFM *)S->STACK;
// 3866 Push(S)
PUSH(S);
// 3867 Release and Drop(S)
RELEASEANDDROP(S);
// 3868 %end
return;
} /* end of PUSHANDPOP */
// 3869 %routine Resolve(%integer Flag)
void RESOLVE(int FLAG) {
// 3870 {S -> A.(B).C}
// 3871
// 3872 Attributes = Attributes!Attr Dynamic
ATTRIBUTES = ATTRIBUTES | 4096;
// 3873 Stack Integer(0) %if Flag&1 = 0
if (FLAG & 1 != 0) goto L_0355;
STACKINTEGER(0);
L_0355:;
// 3874 Push and Pop {A}
PUSHANDPOP();
// 3875 Push and Pop {B}
PUSHANDPOP();
// 3876 Stack Integer(0) %if Flag&2 = 0
if (FLAG & 2 != 0) goto L_0356;
STACKINTEGER(0);
L_0356:;
// 3877 Push and Pop {C}
PUSHANDPOP();
// 3878 Push and Pop {S}
PUSHANDPOP();
// 3879 Perm(Sres)
PERM(12);
// 3880 Perm(Resflop) %if Flag&4 = 0
if (FLAG & 4 != 0) goto L_0357;
PERM(3858);
L_0357:;
// 3881 %end
return;
} /* end of RESOLVE */
// 3882
// 3883
// 3884 %routine Record Assign(%record(Stackfm)%name L, R)
void RECORDASSIGN(struct STACKFM * L, struct STACKFM * R) {
// 3885 %integer LenL, LenR, J, Op, Reg
int LENL;
int LENR;
int J;
int OP;
int REG;
// 3886 %record(Stackfm)%name N
struct STACKFM *N;
// 3887 %record(Stackfm) Hold
struct STACKFM HOLD;
// 3888 LenL = Item Size(L_Format)
LENL = ITEMSIZE(L->FORMAT);
// 3889 LenR = Item Size(R_Format) {note: Var(0)_Format=0 - constants}
LENR = ITEMSIZE(R->FORMAT);
// 3890 LenL = LenR %if LenR # 0 %and LenR < LenL
if (LENR == 0) goto L_0358;
if (LENR >= LENL) goto L_0358;
LENL = LENR;
L_0358:;
// 3891 Fail("Record(*) = Record(*)") %if LenL = 0
if (LENL != 0) goto L_0359;
FAIL(_imp_str_literal_size(63, "Record(*) = Record(*)"));
L_0359:;
// 3892 L_Format = LenL
L->FORMAT = LENL;
// 3893 Hold_Data = L_Data
HOLD.DATA = L->DATA;
// 3894 Loadup(L) %unless l_base = ds
if (L->BASE == 6) goto L_035A;
LOADUP(L);
L_035A:;
// 3895 %if Const(R)#0 %start {record = 0}
if (CONST(R) == 0) goto L_035B;
// 3896 Op = 8_005020 {Clr_(L)+ }
OP = 2576;
// 3897 %finish %else %start
goto L_035C;
L_035B:;
// 3898 Loadup(R); Forget(R_Base)
LOADUP(R);
FORGET(R->BASE);
// 3899 Op = 8_012020+Actual(R_Base)<<6 {Mov_(R)+,(L)+ }
OP = 5136 + (ACTUAL[R->BASE] << 6);
// 3900 %finish
L_035C:;
// 3901 Op = Op+Actual(L_Base)
OP = OP + ACTUAL[L->BASE];
// 3902 Forget Destination(Hold)
FORGETDESTINATION(/*?*/ &HOLD);
// 3903 Forget(L_Base)
FORGET(L->BASE);
// 3904 L_Form = VinS; Forget Destination(L)
L->FORM = 1;
FORGETDESTINATION(L);
// 3905 LenL = LenL>>1 {2 bytes a time}
LENL = (unsigned int)LENL >> 1;
// 3906 %if LenL > 8 %start {to much to do explicitly}
if (LENL <= 8) goto L_035D;
// 3907 N == Record(Literal(LenL)); Loadup(N)
N = (struct STACKFM *)_imp_RECORD(LITERAL(LENL));
LOADUP(N);
// 3908 Forget(N_Base)
FORGET(N->BASE);
// 3909 Cword(Op)
CWORD(OP);
// 3910 Reg = Actual(N_Base)
REG = ACTUAL[N->BASE];
// 3911 %if Control&No Eis = 0 %start
if (CONTROL & 256 != 0) goto L_035E;
// 3912 Cword(8_077000+2+Reg<<6) {SOB_N,.-2}
CWORD(32256 + 2 + (REG << 6));
// 3913 %finish %else %start
goto L_035F;
L_035E:;
// 3914 Cword(8_005300+Reg) {DEC_N}
CWORD(2752 + REG);
// 3915 Cword(8_003000+ (-3)&255) {BGT_.-3}
CWORD(1536 + ((-3) & 255));
// 3916 %finish
L_035F:;
// 3917 Release and Drop(N)
RELEASEANDDROP(N);
// 3918 %finish %else %start
goto L_0360;
L_035D:;
// 3919 Cword(Op) %for J = 1, 1, LenL
// %for J = 1, 1, LENL %cycle
{
int _final = LENL;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, LENL");
J = 0;
L_0361:
if (J == _final) goto L_0362;
J += 1;
CWORD(OP);
goto L_0361;
}
L_0362:;
// 3920 %finish
L_0360:;
// 3921 %end
return;
} /* end of RECORDASSIGN */
// 3922 %routine String Assign(%record(Stackfm)%name L, R)
void STRINGASSIGN(struct STACKFM * L, struct STACKFM * R) {
// 3923 %record(Stackfm)%name W
struct STACKFM *W;
// 3924 {%predicate}
// 3925 %integerfn Safe(%record(Stackfm)%name Target, Chain)
int SAFE(struct STACKFM * TARGET, struct STACKFM * CHAIN) {
// 3926 %result=-1 %if Target_Flags&In Work # 0
if (TARGET->FLAGS & 1 == 0) goto L_0364;
return -1;
L_0364:;
// 3927 %cycle
L_0365:;
// 3928 %result=0 %if Same(Target, Chain)#0
if (SAME(TARGET, CHAIN) == 0) goto L_0366;
return 0;
L_0366:;
// 3929 %result=-1 %if Chain_Oper = 0
if (CHAIN->OPER != 0) goto L_0367;
return -1;
L_0367:;
// 3930 Chain == Chain_Link
CHAIN = (struct STACKFM *)CHAIN->LINK;
// 3931 %repeat
goto L_0365;
// 3932 %end
} /* end of SAFE */
// 3933 Forget Destination(L)
FORGETDESTINATION(L);
// 3934 %if R_Oper # 0 %start {L = X.Y....}
if (R->OPER == 0) goto L_0368;
// 3935 W == R_Link
W = (struct STACKFM *)R->LINK;
// 3936 %if Safe(L, W)#0 %start {W does not reference L}
if (SAFE(L, W) == 0) goto L_0369;
// 3937 R_Oper = 0; R_Link == Null
R->OPER = 0;
R->LINK = (struct STACKFM *)NULL;
// 3938 String Assign(L, R) %unless Same(L, R)#0 {L = R}
if (SAME(L, R) != 0) goto L_036A;
STRINGASSIGN(L, R);
L_036A:;
// 3939 L_Flags = L_Flags!In Work
L->FLAGS = L->FLAGS | 1;
// 3940 L_Oper = CONCX; L_Link == W
L->OPER = 15;
L->LINK = (struct STACKFM *)W;
// 3941 Loadup(L)
LOADUP(L);
// 3942 L_Flags = L_Flags&(\In Work)
L->FLAGS = L->FLAGS & (~1);
// 3943 %return
return;
// 3944 %finish
L_0369:;
// 3945 %finish
L_0368:;
// 3946 %if L_Base = Ds %start
if (L->BASE != 6) goto L_036B;
// 3947 Load(R, R1)
LOAD(R, 2);
// 3948 Release and Clear(R)
RELEASEANDCLEAR(R);
// 3949 Perm(Spmove); Cword(L_Format-1)
PERM(1035);
CWORD(L->FORMAT - 1);
// 3950 %finish %else %if R_FORM = VinS %and R_Format = 1 %start {L = ""}
goto L_036C;
L_036B:;
if (R->FORM != 1) goto L_036D;
if (R->FORMAT != 1) goto L_036D;
// 3951 L_Type = Bytes
L->TYPE = 2;
// 3952 Plant1(Clrb, L)
PLANT1(41, L);
// 3953 %finish %else %start
goto L_036C;
L_036D:;
// 3954 Load Pair(R, L)
LOADPAIR(R, L);
// 3955 Release(L_Base); Release and Clear(R)
RELEASE(L->BASE);
RELEASEANDCLEAR(R);
// 3956 Perm(Smove)
PERM(1031);
// 3957 L_Type = Strings; L_Form = VinS; Claim(R2)
L->TYPE = 5;
L->FORM = 1;
CLAIM(3);
// 3958 %finish
L_036C:;
// 3959 %end
return;
} /* end of STRINGASSIGN */
// 3960 %routine Store(%record(Stackfm)%name L, R)
void STORE(struct STACKFM * L, struct STACKFM * R) {
// 3961 %unless R_Oper = 0 %and Same(L, R)#0 %start
if (R->OPER != 0) goto L_036E;
if (SAME(L, R) != 0) goto L_036F;
L_036E:;
// 3962 %if L_Type = Records %start
if (L->TYPE != 6) goto L_0370;
// 3963 Record Assign(L, R)
RECORDASSIGN(L, R);
// 3964 %finish %else %if L_Type = Strings %start
goto L_0371;
L_0370:;
if (L->TYPE != 5) goto L_0372;
// 3965 String Assign(L, R)
STRINGASSIGN(L, R);
// 3966 %finish %else %start
goto L_0371;
L_0372:;
// 3967 Move(R, L)
MOVE(R, L);
// 3968 %finish
L_0371:;
// 3969 %finish
L_036F:;
// 3970 %end
return;
} /* end of STORE */
// 3971 %routine Move and Advance(%record(Stackfm)%name L, R)
void MOVEANDADVANCE(struct STACKFM * L, struct STACKFM * R) {
// 3972 %record(Stackfm)%name Rr
struct STACKFM *RR;
// 3973 Rr == Record(Copy(R))
RR = (struct STACKFM *)_imp_RECORD(COPY(R));
// 3974 Store(L, Rr); Release and Drop(Rr)
STORE(L, RR);
RELEASEANDDROP(RR);
// 3975 L_Disp = L_Disp+2 %unless L_Form = Ainc
if (L->FORM == 2) goto L_0373;
L->DISP = L->DISP + 2;
L_0373:;
// 3976 R_Disp = R_Disp+2
R->DISP = R->DISP + 2;
// 3977 %end
return;
} /* end of MOVEANDADVANCE */
// 3978 %routine Store Address(%record(Stackfm)%name L, R)
void STOREADDRESS(struct STACKFM * L, struct STACKFM * R) {
// 3979 %record(Stackfm)%name T
struct STACKFM *T;
// 3980 %integer Rt
int RT;
// 3981 %if L_Type = Generals %start
if (L->TYPE != 7) goto L_0374;
// 3982 Amap(L)
AMAP(L);
// 3983 Rt = R_Type
RT = R->TYPE;
// 3984 Amap(R)
AMAP(R);
// 3985 Move and Advance(L, R)
MOVEANDADVANCE(L, R);
// 3986 %if Rt = Generals %start
if (RT != 7) goto L_0375;
// 3987 Move and Advance(L, R)
MOVEANDADVANCE(L, R);
// 3988 Move and Advance(L, R)
MOVEANDADVANCE(L, R);
// 3989 %finish %else %start
goto L_0376;
L_0375:;
// 3990 T == Record(Literal(Item Size(R_Format)))
T = (struct STACKFM *)_imp_RECORD(LITERAL(ITEMSIZE(R->FORMAT)));
// 3991 Move and Advance(L, T); Release and Drop(T)
MOVEANDADVANCE(L, T);
RELEASEANDDROP(T);
// 3992 T == Record(Literal(Type Code(Rt)))
T = (struct STACKFM *)_imp_RECORD(LITERAL(TYPECODE[RT]));
// 3993 Move and Advance(L, T); Release and Drop(T)
MOVEANDADVANCE(L, T);
RELEASEANDDROP(T);
// 3994 %finish
L_0376:;
// 3995 %finish %else %if L_Form = Proc %start
goto L_0377;
L_0374:;
if (L->FORM != 6) goto L_0378;
// 3996 Fail("Not implemented")
FAIL(_imp_str_literal_size(63, "Not implemented"));
// 3997 %finish %else %if L_Flags&Arrayname # 0 %start
L_0378:;
if (L->FLAGS & 64 == 0) goto L_0379;
// 3998 Amap(L)
AMAP(L);
// 3999 Amap(R)
AMAP(R);
// 4000 Move and Advance(L, R)
MOVEANDADVANCE(L, R);
// 4001 %if R_Flags&Arrayname # 0 %start
if (R->FLAGS & 64 == 0) goto L_037A;
// 4002 Move and Advance(L, R)
MOVEANDADVANCE(L, R);
// 4003 %finish %else %start
goto L_037B;
L_037A:;
// 4004 T == Record(Literal(0))
T = (struct STACKFM *)_imp_RECORD(LITERAL(0));
// 4005 Store(L, T); Release and Drop(T)
STORE(L, T);
RELEASEANDDROP(T);
// 4006 %finish
L_037B:;
// 4007 %finish %else %if L_Type = Strings %and L_Format = 1 %start
goto L_0377;
L_0379:;
if (L->TYPE != 5) goto L_037C;
if (L->FORMAT != 1) goto L_037C;
// 4008 N = R_Format-1
N = R->FORMAT - 1;
// 4009 Amap(L)
AMAP(L);
// 4010 Amap(R)
AMAP(R);
// 4011 Move and Advance(L, R)
MOVEANDADVANCE(L, R);
// 4012 %if N = 0 %start
if (N != 0) goto L_037D;
// 4013 Move and Advance(L, R)
MOVEANDADVANCE(L, R);
// 4014 %finish %else %start
goto L_037E;
L_037D:;
// 4015 T == Record(Literal(N))
T = (struct STACKFM *)_imp_RECORD(LITERAL(N));
// 4016 Move and Advance(L, T); Release and Drop(T)
MOVEANDADVANCE(L, T);
RELEASEANDDROP(T);
// 4017 %finish
L_037E:;
// 4018 %finish %else %start
goto L_0377;
L_037C:;
// 4019 Amap(L)
AMAP(L);
// 4020 Amap(R)
AMAP(R);
// 4021 Store(L, R)
STORE(L, R);
// 4022 %finish
L_0377:;
// 4023 %end
return;
} /* end of STOREADDRESS */
// 4024 %routine Jam Transfer(%record(Stackfm)%name L, R)
void JAMTRANSFER(struct STACKFM * L, struct STACKFM * R) {
// 4025 %integer N, Type
int N;
int TYPE;
// 4026 %record(Stackfm)%name M
struct STACKFM *M;
// 4027 Type = L_Type
TYPE = L->TYPE;
// 4028 %if Type # Strings %start {just omit the remember}
if (TYPE == 5) goto L_037F;
// 4029 Store(L, R)
STORE(L, R);
// 4030 Forget Destination(L)
FORGETDESTINATION(L);
// 4031 %finish %else %start
goto L_0380;
L_037F:;
// 4032 N = L_Format-1 {maximum length}
N = L->FORMAT - 1;
// 4033 %if N <= 0 %start {string(*)%name}
if (N > 0) goto L_0381;
// 4034 M == Record(Copy(L))
M = (struct STACKFM *)_imp_RECORD(COPY(L));
// 4035 Amap (M)
AMAP(M);
// 4036 M_Disp = M_Disp+2; M_Type = Integers
M->DISP = M->DISP + 2;
M->TYPE = 1;
// 4037 Load Pair(L, R)
LOADPAIR(L, R);
// 4038 Load(M, R0); Release and Drop(M)
LOAD(M, 1);
RELEASEANDDROP(M);
// 4039 Perm(Sjam2)
PERM(1048);
// 4040 %finish %else %start
goto L_0382;
L_0381:;
// 4041 Load Pair(L, R)
LOADPAIR(L, R);
// 4042 Perm(Sjam1)
PERM(1034);
// 4043 Cword(N)
CWORD(N);
// 4044 %finish
L_0382:;
// 4045 %finish
L_0380:;
// 4046 %end
return;
} /* end of JAMTRANSFER */
// 4047 %routine Assign(%integer How)
void ASSIGN(int HOW) {
// 4048 %record(Stackfm)%name L, R
struct STACKFM *L;
struct STACKFM *R;
// 4049 R == Stack
R = (struct STACKFM *)STACK;
// 4050 L == R_Stack; Stack == L_Stack
L = (struct STACKFM *)R->STACK;
STACK = (struct STACKFM *)L->STACK;
// 4051 %if Diag&MonMove # 0 %start
if (DIAG & 32 == 0) goto L_0383;
// 4052 Monitor(L, "A-L")
MONITOR(L, _imp_str_literal_size(15, "A-L"));
// 4053 Monitor(R, "A-R")
MONITOR(R, _imp_str_literal_size(15, "A-R"));
// 4054 %finish
L_0383:;
// 4055 %if How = Equals %start
if (HOW != 0) goto L_0384;
// 4056 Store(L, R)
STORE(L, R);
// 4057 %finish %else %if How = EqualsEquals %start
goto L_0385;
L_0384:;
if (HOW != 1) goto L_0386;
// 4058 Store Address(L, R)
STOREADDRESS(L, R);
// 4059 %finish %else %start
goto L_0385;
L_0386:;
// 4060 Jam Transfer(L, R)
JAMTRANSFER(L, R);
// 4061 %finish
L_0385:;
// 4062 Release and Drop(L); Release and Drop(R)
RELEASEANDDROP(L);
RELEASEANDDROP(R);
// 4063 %end
return;
} /* end of ASSIGN */
// 4064 %routine Assign Parameter
void ASSIGNPARAMETER(void) {
// 4065 %record(Stackfm)%name P, Rt, V
struct STACKFM *P;
struct STACKFM *RT;
struct STACKFM *V;
// 4066 P == Stack; Stack == P_Stack
P = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)P->STACK;
// 4067 Rt == Stack
RT = (struct STACKFM *)STACK;
// 4068 %if Rt_Flags&Primitive # 0 %start
if (RT->FLAGS & 32 == 0) goto L_0387;
// 4069 P_Stack == Rt_Stack; Rt_Stack == P
P->STACK = (struct STACKFM *)RT->STACK;
RT->STACK = (struct STACKFM *)P;
// 4070 %return
return;
// 4071 %finish
L_0387:;
// 4072 Rt_Extra = Rt_Extra-1; Stack Var(Rt_Extra)
RT->EXTRA = RT->EXTRA - 1;
STACKVAR(RT->EXTRA);
// 4073 V == Stack; Stack == Stack_Stack
V = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)STACK->STACK;
// 4074 %if V_Flags&Parameter # 0 %start {parameter in register}
if (V->FLAGS & 4 == 0) goto L_0388;
// 4075 %if V_Form # VinS %start
if (V->FORM == 1) goto L_0389;
// 4076 %if P_Oper = CONCx %then Load(P, R3) %c
if (P->OPER != 15) goto L_038A;
LOAD(P, 4);
goto L_038B;
L_038A:;
AMAP(P);
L_038B:;
// 4077+ %else Amap(P)
// 4078 %finish
L_0389:;
// 4079 Optimise(P, 1)
OPTIMISE(P, 1);
// 4080 P_Preg = V_Base
P->PREG = V->BASE;
// 4081 P_Params == Rt_Params
P->PARAMS = (struct STACKFM *)RT->PARAMS;
// 4082 Rt_Params == P
RT->PARAMS = (struct STACKFM *)P;
// 4083 Drop(V)
DROP(V);
// 4084 %return
return;
// 4085 %finish
L_0388:;
// 4086 %if V_Flags&Awanted = 0 %start
if (V->FLAGS & 16 != 0) goto L_038C;
// 4087 %if V_Type = Strings %start
if (V->TYPE != 5) goto L_038D;
// 4088 Load(P, R3)
LOAD(P, 4);
// 4089 Release and Drop(P)
RELEASEANDDROP(P);
// 4090 Perm(SpMove)
PERM(1035);
// 4091 Cword(V_Format)
CWORD(V->FORMAT);
// 4092 %finish %else %start
goto L_038E;
L_038D:;
// 4093 Store(V, P)
STORE(V, P);
// 4094 Release and Drop(P)
RELEASEANDDROP(P);
// 4095 %finish
L_038E:;
// 4096 %finish %else %start
goto L_038F;
L_038C:;
// 4097 Store Address(V, P)
STOREADDRESS(V, P);
// 4098 Release and Drop(P)
RELEASEANDDROP(P);
// 4099 %finish
L_038F:;
// 4100 Release and Drop(V)
RELEASEANDDROP(V);
// 4101 %end
return;
} /* end of ASSIGNPARAMETER */
// 4102
// 4103
// 4104 %routine Array Access
void ARRAYACCESS(void) {
// 4105 %integer Type, Flags, N
int TYPE;
int FLAGS;
int N;
// 4106 %record(Stackfm)%name X, A
struct STACKFM *X;
struct STACKFM *A;
// 4107 X == Stack {index value}
X = (struct STACKFM *)STACK;
// 4108 A == X_Stack {array descriptor}
A = (struct STACKFM *)X->STACK;
// 4109 Stack == A_Stack
STACK = (struct STACKFM *)A->STACK;
// 4110 Flags = A_Flags
FLAGS = A->FLAGS;
// 4111 Type = A_Type {type of result}
TYPE = A->TYPE;
// 4112 %if A_Oper # 0 %start {final of multi-dimensional}
if (A->OPER == 0) goto L_0390;
// 4113 Push(X) {Stack the last one}
PUSH(X);
// 4114 Release and Drop(X)
RELEASEANDDROP(X);
// 4115 X == Record(Literal(A_Oper+1))
X = (struct STACKFM *)_imp_RECORD(LITERAL(A->OPER + 1));
// 4116 A_Oper = 0
A->OPER = 0;
// 4117 Amap(A)
AMAP(A);
// 4118 Load Pair(X, A)
LOADPAIR(X, A);
// 4119 Release and Drop(X)
RELEASEANDDROP(X);
// 4120 Release and Drop(A)
RELEASEANDDROP(A);
// 4121 Perm(Aref)
PERM(15);
// 4122 X == Record(Literal(0)); X_Base = R1; Claim(R1)
X = (struct STACKFM *)_imp_RECORD(LITERAL(0));
X->BASE = 2;
CLAIM(2);
// 4123 Vmap(X, Integers) %if Flags&Indirect # 0 {namearray}
if (FLAGS & 8 == 0) goto L_0391;
VMAP(X, 1);
L_0391:;
// 4124 Vmap(X, Type)
VMAP(X, TYPE);
// 4125 %finish %else %start {Single dimensional}
goto L_0392;
L_0390:;
// 4126 Loadup(X) %if X_A_Scale # 0 {simplify index}
if (X->A.SCALE == 0) goto L_0393;
LOADUP(X);
L_0393:;
// 4127 N = 0
N = 0;
// 4128 %if X_Oper = ADDx %and X_Link_Form = VinR %start
if (X->OPER != 3) goto L_0394;
if (X->LINK->FORM != 0) goto L_0394;
// 4129 N = X_Link_Disp; X_Link_Disp = 0
N = X->LINK->DISP;
X->LINK->DISP = 0;
// 4130 %if X_Link_Base = 0 %start
if (X->LINK->BASE != 0) goto L_0395;
// 4131 Drop(X_Link)
DROP(X->LINK);
// 4132 X_Oper = 0
X->OPER = 0;
// 4133 X_Link == Null
X->LINK = (struct STACKFM *)NULL;
// 4134 %finish
L_0395:;
// 4135 %finish
L_0394:;
// 4136 Loadup(X) %if X_Oper # 0
if (X->OPER == 0) goto L_0396;
LOADUP(X);
L_0396:;
// 4137 %if X_Form = VinR %start
if (X->FORM != 0) goto L_0397;
// 4138 N = N+X_Disp
N = N + X->DISP;
// 4139 X_Disp = 0
X->DISP = 0;
// 4140 %finish
L_0397:;
// 4141 Address(A, 1) %if A_A_Scale # 0 {record arrays?}
if (A->A.SCALE == 0) goto L_0398;
ADDRESS(A, 1);
L_0398:;
// 4142 X_A = A_V
X->A = A->V;
// 4143 X_A_Type = X_Type
X->A.TYPE = X->TYPE;
// 4144 %if A_Flags & Indirect # 0 %start
if (A->FLAGS & 8 == 0) goto L_0399;
// 4145 X_A_Scale = 2
X->A.SCALE = 2;
// 4146 X_A_Scale = 4 %if A_Type = strings %and A_format=1
if (A->TYPE != 5) goto L_039A;
if (A->FORMAT != 1) goto L_039A;
X->A.SCALE = 4;
L_039A:;
// 4147 %finish %else %start
goto L_039B;
L_0399:;
// 4148 X_A_Scale = Item Size(A_Format)
X->A.SCALE = ITEMSIZE(A->FORMAT);
// 4149 %finish
L_039B:;
// 4150 X_Bias = N*X_A_Scale
X->BIAS = N * X->A.SCALE;
// 4151 X_Type = Type
X->TYPE = TYPE;
// 4152 Drop(A)
DROP(A);
// 4153 %finish
L_0392:;
// 4154 X_Format = A_Format
X->FORMAT = A->FORMAT;
// 4155 X_Stack == Stack
X->STACK = (struct STACKFM *)STACK;
// 4156 Stack == X
STACK = (struct STACKFM *)X;
// 4157 %end
return;
} /* end of ARRAYACCESS */
// 4158 %routine Array Index
void ARRAYINDEX(void) {
// 4159 Push and Pop
PUSHANDPOP();
// 4160 Stack_Oper = Stack_Oper+1 {count stacked index values}
STACK->OPER = STACK->OPER + 1;
// 4161 %end
return;
} /* end of ARRAYINDEX */
// 4162 %routine Constant Bounds
void CONSTANTBOUNDS(void) {
// 4163 Vub = Popped Value
VUB = POPPEDVALUE();
// 4164 Vlb = Popped Value
VLB = POPPEDVALUE();
// 4165 %end
return;
} /* end of CONSTANTBOUNDS */
// 4166
// 4167 {%Predicate}
// 4168 %integerfn Alternate format
int ALTERNATEFORMAT(void) {
// 4169 %integer Code
int CODE;
// 4170 %record(Varfm) Dummy
struct VARFM DUMMY;
// 4171 Code = Pending; Readch(Pending)
CODE = PENDING;
READCH(/*?*/ &PENDING);
// 4172 %if Code = 'A' %start {Start of alternatives}
if (CODE != 65) goto L_039C;
// 4173 Assemble(Dummy, -2, Vars, Local, -1)
ASSEMBLE(/*?*/ &DUMMY, -2, VARS, LOCAL, -1);
// 4174 Alt Align = Alt Align!Falign
ALTALIGN = ALTALIGN | FALIGN;
// 4175 %finish %else %if Code = 'C' %start {Next alternative}
goto L_039D;
L_039C:;
if (CODE != 67) goto L_039E;
// 4176 Max Frame = Frame %if Frame > Max Frame
if (FRAME <= MAXFRAME) goto L_039F;
MAXFRAME = FRAME;
L_039F:;
// 4177 Frame = Frame Base
FRAME = FRAMEBASE;
// 4178 %finish %else %if Code = 'B' %start {End of alternatives}
goto L_039D;
L_039E:;
if (CODE != 66) goto L_03A0;
// 4179 Frame = Max Frame %if Max Frame > Frame
if (MAXFRAME <= FRAME) goto L_03A1;
FRAME = MAXFRAME;
L_03A1:;
// 4180 Falign = Alt Align
FALIGN = ALTALIGN;
// 4181 %result=-1
return -1;
// 4182 %finish %else %start
L_03A0:;
// 4183 !#if e(=true)
// 4184 Fail("Format ".ItoS(Code))
FAIL(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("Format "), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = ITOS(CODE);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string63 *)&tmp;
})
);
// 4185 !#else(=false)
// 4186 { Fail("Format ".ItoS(Code,1))}
// 4187 !#fi
// 4188 %finish
L_039D:;
// 4189 %result=0
return 0;
// 4190 %end
} /* end of ALTERNATEFORMAT */
// 4191
// 4192 {Monitoring Control}
// 4193
// 4194 %routine Set CD(%integer Value, %integername CD)
void SETCD(int VALUE, int *CD) {
// 4195 CD = Value&x'3FFF' %if Value&x'C000' = 2<<14
if (VALUE & 49152 != 2 << 14) goto L_03A2;
*CD = VALUE & 16383;
L_03A2:;
// 4196 %if CD == Control %and Control&NoEis # 0 %start
if (_imp_ADDR((void *)(CD)) != _imp_ADDR((void *)(/*?*/ &CONTROL))) goto L_03A3;
if (CONTROL & 256 == 0) goto L_03A3;
// 4197 Oper Flags(MULx) = Oper Flags(MULx)!In Prim
OPERFLAGS[4] = OPERFLAGS[4] | 2;
// 4198 Oper Flags(DIVx) = Oper Flags(DIVx)!In Prim
OPERFLAGS[5] = OPERFLAGS[5] | 2;
// 4199 Oper Flags(REMx) = Oper Flags(REMx)!In Prim
OPERFLAGS[13] = OPERFLAGS[13] | 2;
// 4200 Oper Flags(XORx) = Oper Flags(XORx)!In Prim
OPERFLAGS[9] = OPERFLAGS[9] | 2;
// 4201 %finish
L_03A3:;
// 4202 %end
return;
} /* end of SETCD */
// 4203 %routine Call Monitor
void CALLMONITOR(void) {
// 4204 Perm(RtMonitor)
PERM(19);
// 4205 Uncond Jump = Ca
UNCONDJUMP = *CA;
// 4206 %end
return;
} /* end of CALLMONITOR */
// 4207 %routine Update Line(%integer This Line)
void UPDATELINE(int THISLINE) {
// 4208 Fail("Stack") %unless Stack == Null
if (_imp_ADDR((void *)(STACK)) == _imp_ADDR((void *)(NULL))) goto L_03A4;
FAIL(_imp_str_literal_size(63, "Stack"));
L_03A4:;
// 4209 Fail("Registers") %unless Active Registers = 0
if (ACTIVEREGISTERS == 0) goto L_03A5;
FAIL(_imp_str_literal_size(63, "Registers"));
L_03A5:;
// 4210 Fail("Descriptors") %unless Using == Null
if (_imp_ADDR((void *)(USING)) == _imp_ADDR((void *)(NULL))) goto L_03A6;
FAIL(_imp_str_literal_size(63, "Descriptors"));
L_03A6:;
// 4211 Fail("Corrupt") %if RegV(AnyG)_Base # AnyG %or %c
if (REGV[8].BASE != 9) goto L_03A7;
if (REGV[13].BASE != 14) goto L_03A7;
if (REGV[5].BASE != 6) goto L_03A7;
if (REGV[4].BASE != 5) goto L_03A7;
if (REGV[6].BASE != 7) goto L_03A7;
if (REGV[7].BASE == 8) goto L_03A8;
L_03A7:;
FAIL(_imp_str_literal_size(63, "Corrupt"));
L_03A8:;
// 4212+ RegV(AnyF)_Base # AnyF %or %c
// 4213+ RegV(Ds) _Base # Ds %or %c
// 4214+ RegV(Lnb) _Base # Lnb %or %c
// 4215+ RegV(Sp) _Base # Sp %or %c
// 4216+ RegV(Pc) _Base # Pc
// 4217 %if This Line # Current Line %start
if (THISLINE == CURRENTLINE) goto L_03A9;
// 4218 Current Line = This Line
CURRENTLINE = THISLINE;
// 4219 Printch(Obj Line); Put(Current Line)
PRINTCH(40);
PUT(CURRENTLINE);
// 4220 %finish
L_03A9:;
// 4221 Ds Bias = 0
DSBIAS = 0;
// 4222 %if Diag&MonLine # 0 %start
if (DIAG & 64 == 0) goto L_03AA;
// 4223 Select Output(0)
_imp_SELECTOUTPUT(0);
// 4224 Printstring("Line:"); Write(This Line, 1); Newline
_imp_PRINTSTRING(_imp_str_literal("Line:"));
_imp_WRITE(THISLINE, 1);
_imp_NEWLINE();
// 4225 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 4226 %finish
L_03AA:;
// 4227 Display Knowledge %if Diag&MonOpt # 0
if (DIAG & 128 == 0) goto L_03AB;
DISPLAYKNOWLEDGE();
L_03AB:;
// 4228 %end
return;
} /* end of UPDATELINE */
// 4229
// 4230 {Parameter and Format processing}
// 4231
// 4232 %routine Compile Begin
void COMPILEBEGIN(void) {
// 4233 %record(Varfm) B
struct VARFM B;
// 4234 B = 0 {Dummy heading}
B = (struct VARFM){0};
// 4235 B_Type = Generals
B.TYPE = 7;
// 4236 B_Disp = New Label
B.DISP = NEWLABEL();
// 4237 B_Base = 0 {show an internal routine}
B.BASE = 0;
// 4238 %if Local # 128 %start {internal}
if (LOCAL == 128) goto L_03AC;
// 4239 Stack Integer(B_Disp)
STACKINTEGER(B.DISP);
// 4240 Call
CALL();
// 4241 Ostate = 0
OSTATE = 0;
// 4242 %finish %else %start
goto L_03AD;
L_03AC:;
// 4243 Ostate = External
OSTATE = 3;
// 4244 External Id = "%GO"
_imp_strncpy(/*?*/ &EXTERNALID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("%GO");
(void *)&tmp;
}),
/*max:*/ 15);
// 4245 %finish
L_03AD:;
// 4246 Assemble(B, 0, Vars, Local+1, 0)
ASSEMBLE(/*?*/ &B, 0, VARS, LOCAL + 1, 0);
// 4247 %end
return;
} /* end of COMPILEBEGIN */
// 4248 %routine End of Block
void ENDOFBLOCK(void) {
// 4249 %if Local # 128 %start {not first (dummy) call}
if (LOCAL == 128) goto L_03AE;
// 4250 Return(Routine) %if Uncond Jump # Ca %and Avar_Type = Generals
if (UNCONDJUMP == *CA) goto L_03AF;
if (AVAR->TYPE != 7) goto L_03AF;
RETURN(0);
L_03AF:;
// 4251 %finish
L_03AE:;
// 4252 %end
return;
} /* end of ENDOFBLOCK */
// 4253 %routine Terminate Block
void TERMINATEBLOCK(void) {
// 4254 %integer J
int J;
// 4255 %record(Varfm)%name V
struct VARFM *V;
// 4256 %if Amode < 0 %start {format - align alternatives}
if (AMODE >= 0) goto L_03B0;
// 4257 Falign = Alt Align {pass back nested alignment}
FALIGN = ALTALIGN;
// 4258 %if Frame Extra # 0 %and Falign = 0 %start
if (FRAMEEXTRA == 0) goto L_03B1;
if (FALIGN != 0) goto L_03B1;
// 4259 {i byte added at start but not needed}
// 4260 %for J = parms, 1, First Alt %cycle
// %for J = PARMS, 1, FIRSTALT %cycle
{
int _initial = PARMS, _final = FIRSTALT;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = PARMS, 1, FIRSTALT");
J = _initial - (1);
L_03B2:
if (J == _final) goto L_03B3;
J += 1;
// 4261 V == Var(J)
V = (struct VARFM *)/*?*/ &VAR[J];
// 4262 V_Disp = V_Disp-1
V->DISP = V->DISP - 1;
// 4263 %repeat
goto L_03B2;
}
L_03B3:;
// 4264 Max Frame = Max Frame-1
MAXFRAME = MAXFRAME - 1;
// 4265 %finish
L_03B1:;
// 4266 Frame = Max Frame %if Max Frame > Frame
if (MAXFRAME <= FRAME) goto L_03B5;
FRAME = MAXFRAME;
L_03B5:;
// 4267 %if Amode = -2 %start {end of alternative}
if (AMODE != -2) goto L_03B6;
// 4268 Old Frame = Frame {pass it back}
OLDFRAME = FRAME;
// 4269 %finish %else %start {end of complete format}
goto L_03B7;
L_03B6:;
// 4270 Frame = (Frame+Alignment)&(\Alignment) {word align formats?}
FRAME = FRAME + 1 & (~1);
// 4271 Avar_Format = Frame
AVAR->FORMAT = FRAME;
// 4272 %finish
L_03B7:;
// 4273 %finish
L_03B0:;
// 4274 Frame = Old Frame
FRAME = OLDFRAME;
// 4275 %end
return;
} /* end of TERMINATEBLOCK */
// 4276
// 4277 {%Predicate}
// 4278 %integerfn Finish Params
int FINISHPARAMS(void) {
// 4279 %integer J, P, R, A
int J;
int P;
int R;
int A;
// 4280 %record(Stackfm)%name S
struct STACKFM *S;
// 4281 %record(Varfm)%name Ap, Fp
struct VARFM *AP;
struct VARFM *FP;
// 4282 Parameter List = 0 {no longer in params or format}
PARAMETERLIST = 0;
// 4283 %result=-1 %if Amode < 0 {end of format}
if (AMODE >= 0) goto L_03B8;
return -1;
L_03B8:;
// 4284 %if Varbase # Vars %start {parameters given}
if (VARBASE == VARS) goto L_03B9;
// 4285 Frame = (Frame+1) & (\1)
FRAME = FRAME + 1 & (~1);
// 4286 P = Parms
P = PARMS;
// 4287 Avar_Extra = Parms {start of formals+1}
AVAR->EXTRA = PARMS;
// 4288 %for J = Varbase+1, 1, Vars %cycle
// %for J = VARBASE + 1, 1, VARS %cycle
{
int _initial = VARBASE + 1, _final = VARS;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = VARBASE + 1, 1, VARS");
J = _initial - (1);
L_03BA:
if (J == _final) goto L_03BB;
J += 1;
// 4289 Ap == Var(J) {actual}
AP = (struct VARFM *)/*?*/ &VAR[J];
// 4290 P = 0 %if Ap_Type = 0 %or (Ap_Type # Integers %and Ap_Form = 1) %c
if (AP->TYPE == 0) goto L_03B4;
if (AP->TYPE == 1) goto L_03BC;
if (AP->FORM == 1) goto L_03B4;
L_03BC:;
if (AP->TYPE != 5) goto L_03BD;
if (AP->FORMAT == 1) goto L_03B4;
L_03BD:;
if (AP->FLAGS & 64 == 0) goto L_03BE;
L_03B4:;
P = 0;
L_03BE:;
// 4291+ %or (Ap_Type = Strings %and Ap_Format = 1) %c
// 4292+ %or Ap_Flags&Arrayname # 0
// 4293 Parms = Parms-1
PARMS = PARMS - 1;
// 4294 Fp == Var(Parms) {formal}
FP = (struct VARFM *)/*?*/ &VAR[PARMS];
// 4295 Fp = Ap
*FP = *AP;
// 4296 Fp_Base = Ds
FP->BASE = 6;
// 4297 Fp_Disp = 0
FP->DISP = 0;
// 4298 Fp_Form = Ainc
FP->FORM = 2;
// 4299 Fp_Flags = Fp_Flags!Awanted %if Ap_Form # VinS
if (AP->FORM == 1) goto L_03BF;
FP->FLAGS = FP->FLAGS | 16;
L_03BF:;
// 4300 %repeat
goto L_03BA;
}
L_03BB:;
// 4301 %if Ap_Type = Strings %and Ap_Form = VinS %c
if (AP->TYPE != 5) goto L_03C0;
if (AP->FORM != 1) goto L_03C0;
if (AP->FLAGS & 2 != 0) goto L_03C0;
// 4302+ %and Ap_Flags&Array = 0 %start
// 4303 Fp_Form = VinR
FP->FORM = 0;
// 4304 Fp_Base = R3
FP->BASE = 4;
// 4305 Fp_Flags = Fp_Flags!Parameter
FP->FLAGS = FP->FLAGS | 4;
// 4306 SpSize = (Ap_Format+1) & (\1) %if Amode = 0
if (AMODE != 0) goto L_03C1;
SPSIZE = AP->FORMAT + 1 & (~1);
L_03C1:;
// 4307 Attributes = Attributes!Attr Dynamic
ATTRIBUTES = ATTRIBUTES | 4096;
// 4308 %finish
L_03C0:;
// 4309 %if P # 0 %and Frame <= 4 %start {pass in registers}
if (P == 0) goto L_03C2;
if (FRAME > 4) goto L_03C2;
// 4310 Avar_Flags = Avar_Flags!Simple P
AVAR->FLAGS = AVAR->FLAGS | 2;
// 4311 %if Frame # 0 %and Avar_Area = 0 %start {Beware of specs}
if (FRAME == 0) goto L_03C3;
if (AVAR->AREA != 0) goto L_03C3;
// 4312 Parms = Parms-1; Avar_Area = Parms
PARMS = PARMS - 1;
AVAR->AREA = PARMS;
// 4313 Var(Parms) = 0
VAR[PARMS] = (struct VARFM){0};
// 4314 %finish
L_03C3:;
// 4315 R = R1
R = 2;
// 4316 A = Attr R1
A = 256;
// 4317 %for J = Varbase+1, 1, Vars %cycle
// %for J = VARBASE + 1, 1, VARS %cycle
{
int _initial = VARBASE + 1, _final = VARS;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = VARBASE + 1, 1, VARS");
J = _initial - (1);
L_03C4:
if (J == _final) goto L_03C5;
J += 1;
// 4318 P = P-1; Fp == Var(P)
P = P - 1;
FP = (struct VARFM *)/*?*/ &VAR[P];
// 4319 Fp_Flags = Fp_Flags!Parameter
FP->FLAGS = FP->FLAGS | 4;
// 4320 Fp_Base = R
FP->BASE = R;
// 4321 Fp_Form = Var(J)_Form
FP->FORM = VAR[J].FORM;
// 4322 Attributes = Attributes!A
ATTRIBUTES = ATTRIBUTES | A;
// 4323 %if Amode = 0 %start {definition}
if (AMODE != 0) goto L_03C7;
// 4324 Stack Var(J)
STACKVAR(J);
// 4325 S == Stack; Stack == Stack_Stack
S = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)STACK->STACK;
// 4326 %if S_Form = VinX %start
if (S->FORM != 4) goto L_03C8;
// 4327 S_Form = VinS
S->FORM = 1;
// 4328 S_Type = Integers
S->TYPE = 1;
// 4329 S_Disp = S_Extra
S->DISP = S->EXTRA;
// 4330 S_Extra = 0
S->EXTRA = 0;
// 4331 %finish
L_03C8:;
// 4332 S_Format = 0
S->FORMAT = 0;
// 4333 Remember(R, S)
REMEMBER(R, S);
// 4334 Drop(S)
DROP(S);
// 4335 %finish
L_03C7:;
// 4336 R = R2
R = 3;
// 4337 A = Attr R2
A = 512;
// 4338 %repeat
goto L_03C4;
}
L_03C5:;
// 4339 %finish
L_03C2:;
// 4340 %finish
L_03B9:;
// 4341 %result=-1 %if Amode # 0 {not a definition}
if (AMODE == 0) goto L_03C9;
return -1;
L_03C9:;
// 4342 Parameter Frame = Frame
PARAMETERFRAME = FRAME;
// 4343 %result=0 {the body follows}
return 0;
// 4344 %end
} /* end of FINISHPARAMS */
// 4345
// 4346 %integerfn Tag
int TAG(void) {
// 4347 %integer N
int N;
// 4348 Readch(N)
READCH(/*?*/ &N);
// 4349 N = Pending<<8+N
N = (PENDING << 8) + N;
// 4350 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4351 %result = N
return N;
// 4352 %end
} /* end of TAG */
// 4353 %routine Get String(%string(*)%name Text)
void GETSTRING(_imp_string * TEXT) {
// 4354 %string (255) s
_imp_string255 S;
// 4355 %integer J
int J;
// 4356 Length(S) = Pending
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S) = PENDING;
// 4357 %for J = 1, 1, Pending %cycle
// %for J = 1, 1, PENDING %cycle
{
int _final = PENDING;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, PENDING");
J = 0;
L_03CA:
if (J == _final) goto L_03CB;
J += 1;
// 4358 %integer ch
int CH;
// 4359 Readch(ch)
READCH(/*?*/ &CH);
// 4360 Charno(S, J) = ch
*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &S, J) = CH;
// 4361 %repeat
goto L_03CA;
}
L_03CB:;
// 4362 Text <- S
_imp_strncpy(TEXT, ({
__typeof__(_imp_string255) tmp; /*C*/
tmp = S;
(void *)&tmp;
}),
/*max:*/ 255);
// 4363 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4364 %end
return;
} /* end of GETSTRING */
// 4365 %realfn Real Constant
float REALCONSTANT(void) {
// 4366 %longreal N,
double N;
double FACTOR;
double BASE;
// 4367+ Factor,
// 4368+ Base
// 4369 %integer Short
int SHORT;
// 4370 %integer J, Q, P
int J;
int Q;
int P;
// 4371
// 4372 N = 0; Factor = 1; Base = 10.0
N = 0;
FACTOR = 1;
BASE = 10.0;
// 4373 P = 0
P = 0;
// 4374
// 4375 %for J = 1,1,Tag %cycle
// %for J = 1, 1, TAG() %cycle
{
int _final = TAG();
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, TAG()");
J = 0;
L_03CD:
if (J == _final) goto L_03CE;
J += 1;
// 4376 %if Pending = '.' %start
if (PENDING != 46) goto L_03CF;
// 4377 P = 1
P = 1;
// 4378 %finish %else %if Pending = '_' %start
goto L_03D0;
L_03CF:;
if (PENDING != 95) goto L_03D1;
// 4379 Base = N; N = 0
BASE = N;
N = 0;
// 4380 %finish %else %if Pending = '@' %start
goto L_03D0;
L_03D1:;
if (PENDING != 64) goto L_03D2;
// 4381 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4382 Short <- Tag
SHORT = (int)(TAG());
// 4383 !#if e(=true)
// 4384 { N = N*Base**Short}
// 4385 !#else(=false)
// 4386 N = N*Base^Short
N = N * (_imp_REXP(BASE, SHORT));
// 4387 !#fi
// 4388 %exit
goto L_03CE;
// 4389 %finish %else %start
L_03D2:;
// 4390 Q = Pending-'0'
Q = PENDING - 48;
// 4391 Q = Q+'0'-'A'+10 %if Q > 9
if (Q <= 9) goto L_03D3;
Q = Q + 48 - 65 + 10;
L_03D3:;
// 4392 %if P = 0 %start {no decimal point yet}
if (P != 0) goto L_03D4;
// 4393 N = N*Base+Q
N = N * BASE + Q;
// 4394 %finish %else %start
goto L_03D5;
L_03D4:;
// 4395 Factor = Factor/Base
FACTOR = (double)(FACTOR / BASE);
// 4396 N = N+Q*Factor
N = N + Q * FACTOR;
// 4397 %finish
L_03D5:;
// 4398 %finish
L_03D0:;
// 4399 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4400 %repeat
goto L_03CD;
}
L_03CE:;
// 4401 %if Pending = 'U' %start
if (PENDING != 85) goto L_03D6;
// 4402 N = -N
N = -N;
// 4403 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4404 %finish
L_03D6:;
// 4405 %result = N
return N;
// 4406 %end
} /* end of REALCONSTANT */
// 4407 %integerfn Four Bytes
int FOURBYTES(void) {
// 4408 %integer A,B,C,D
int A;
int B;
int C;
int D;
// 4409 A = Pending
A = PENDING;
// 4410 Readch(B); Readch(C); Readch(D)
READCH(/*?*/ &B);
READCH(/*?*/ &C);
READCH(/*?*/ &D);
// 4411 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4412 %result = ((A<<8+B)<<8+C)<<8+D
return (((A << 8) + B << 8) + C << 8) + D;
// 4413 %end
} /* end of FOURBYTES */
// 4414 %routine Input Integer Value
void INPUTINTEGERVALUE(void) {
// 4415 Constant Type = Integers
CONSTANTTYPE = 1;
// 4416 Integer Value = Four Bytes
INTEGERVALUE = FOURBYTES();
// 4417 %if Pending = 'U' %start
if (PENDING != 85) goto L_03D7;
// 4418 Integer Value = -Integer Value
INTEGERVALUE = -INTEGERVALUE;
// 4419 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4420 %finish %else %if Pending = '\' %start
goto L_03D8;
L_03D7:;
if (PENDING != 92) goto L_03D9;
// 4421 Integer Value = \Integer Value
INTEGERVALUE = (~INTEGERVALUE);
// 4422 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4423 %finish
L_03D9:;
L_03D8:;
// 4424 Stack Integer(Integer Value) %unless Pending = 'A' %or Pending = '$'
if (PENDING == 65) goto L_03DA;
if (PENDING == 36) goto L_03DA;
STACKINTEGER(INTEGERVALUE);
L_03DA:;
// 4425 %end
return;
} /* end of INPUTINTEGERVALUE */
// 4426 %routine Input Real Value
void INPUTREALVALUE(void) {
// 4427 Constant Type = Reals
CONSTANTTYPE = 3;
// 4428 Real Value_R = Real Constant
REALVALUE.R = REALCONSTANT();
// 4429 %if Pending # 'A' %and Pending # '$' %start
if (PENDING == 65) goto L_03DB;
if (PENDING == 36) goto L_03DB;
// 4430 Stack Integer(0)
STACKINTEGER(0);
// 4431 Set Real(Stack)
SETREAL(STACK);
// 4432 %finish
L_03DB:;
// 4433 %end
return;
} /* end of INPUTREALVALUE */
// 4434 %routine Set Real(%record(Stackfm)%name V)
void SETREAL(struct STACKFM * V) {
// 4435 %if Real Value_R # 0 %start
if (REALVALUE.R == 0) goto L_03DC;
// 4436 Select Constant Area
SELECTCONSTANTAREA();
// 4437 Word Align
WORDALIGN();
// 4438 V_Form = VinS
V->FORM = 1;
// 4439 V_Area = Constant Area
V->AREA = 2;
// 4440 V_Disp = Ca
V->DISP = *CA;
// 4441 V_Type = Reals
V->TYPE = 3;
// 4442 V_Type = Lreals %if Real Value_W3!Real Value_W4 # 0
if (REALVALUE.W3 | REALVALUE.W4 == 0) goto L_03DD;
V->TYPE = 4;
L_03DD:;
// 4443 Dump Real(V_Type)
DUMPREAL(V->TYPE);
// 4444 Select Code Area
SELECTCODEAREA();
// 4445 %finish
L_03DC:;
// 4446 %end
return;
} /* end of SETREAL */
// 4447 %routine Input String Value
void INPUTSTRINGVALUE(void) {
// 4448 Constant Type = Strings
CONSTANTTYPE = 5;
// 4449 Get String(String Value)
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &STRINGVALUE);
// 4450 %if Length(String Value) = 1 %and Pending = '.' %start
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &STRINGVALUE) != 1) goto L_03DE;
if (PENDING != 46) goto L_03DE;
// 4451 Stack Integer(Charno(String Value, 1))
STACKINTEGER(*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &STRINGVALUE, 1));
// 4452 %finish %else %if '$' # Pending # 'A' %start {not an own initial value}
goto L_03DF;
L_03DE:;
{
// Double-sided test on PENDING (Part I)
int tmp;
if (36 == (tmp = PENDING)) goto L_03E0;
// Double-sided test on PENDING (Part II)
if (tmp == 65) goto L_03E0;
}
// 4453 Select Constant Area
SELECTCONSTANTAREA();
// 4454 Stack Integer(Ca)
STACKINTEGER(*CA);
// 4455 Stack_Type = Strings
STACK->TYPE = 5;
// 4456 Stack_Form = VinS
STACK->FORM = 1;
// 4457 Stack_Area = Constant Area
STACK->AREA = 2;
// 4458 Stack_Format = Length(String Value)+1
STACK->FORMAT = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &STRINGVALUE) + 1;
// 4459 Dump Text(0)
DUMPTEXT(0);
// 4460 Select Code Area
SELECTCODEAREA();
// 4461 %finish
L_03E0:;
L_03DF:;
// 4462 %end
return;
} /* end of INPUTSTRINGVALUE */
// 4463
// 4464 {Var control}
// 4465
// 4466 %routine Clear Vars(%integer Limit)
void CLEARVARS(int LIMIT) {
// 4467 Fail("Too many objects") %if Limit >= Parms
if (LIMIT < PARMS) goto L_03E1;
FAIL(_imp_str_literal_size(63, "Too many objects"));
L_03E1:;
// 4468 %while Vars < Limit %cycle
L_03E2:;
if (VARS >= LIMIT) goto L_03E3;
// 4469 Vars = Vars+1
VARS = VARS + 1;
// 4470 Var(Vars) = 0
VAR[VARS] = (struct VARFM){0};
// 4471 %repeat
goto L_03E2;
L_03E3:;
// 4472 %end
return;
} /* end of CLEARVARS */
// 4473 %routine Dump External(%integer C, %record(Varfm)%name V)
void DUMPEXTERNAL(int C, struct VARFM *V) {
// 4474 %integer D
int D;
// 4475 %if C = Dir Notex %start
if (C != 10) goto L_03E4;
// 4476 D = External Spec+2
D = EXTERNALSPEC + 2;
// 4477 External Spec = D
EXTERNALSPEC = D;
// 4478 %if V_Form = Proc %then V_Disp = D %c
if (V->FORM != 6) goto L_03E5;
V->DISP = D;
goto L_03E6;
L_03E5:;
V->AREA = D;
L_03E6:;
// 4479+ %else V_Area = D
// 4480 %finish %else %start
goto L_03E7;
L_03E4:;
// 4481 D = V_Disp
D = V->DISP;
// 4482 %finish
L_03E7:;
// 4483 Dcode(C); Put(D); Put Text(External Id)
DCODE(C);
PUT(D);
PUTTEXT((_imp_string255 *)/*p*/ /*?*/ &EXTERNALID);
// 4484 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 4485 %end
return;
} /* end of DUMPEXTERNAL */
// 4486 %routine Define Var
void DEFINEVAR(void) {
// 4487 %integer Decl, Tf, New
int DECL;
int TF;
int NEW;
// 4488 %integer Spec, Round,
int SPEC;
int ROUND;
int TYPE;
int FORM;
int FORMAT;
int DIM;
int DATASIZE;
// 4489+ Type, {item type}
// 4490+ Form, {item form}
// 4491+ Format, {Size or format}
// 4492+ Dim,
// 4493+ Data Size {Size of allocated object}
// 4494 {Decl size is size of actual object}
// 4495
// 4496 %constbytearray Form Map(0:15) = 0, {Unknown}
const unsigned char FORMMAP[16] = {0, 1, 4, [3 ... 6] = 0, [7 ... 10] = 6, 1, 4, 1, 4, 0};
// 4497+ VinS, {integer}
// 4498+ VinX, {integername}
// 4499+ 0(4), {label/format/?/switch}
// 4500+ Proc(4), {rt/fn/map/pred}
// 4501+ VinS, {array}
// 4502+ VinX, {arrayname}
// 4503+ VinS, {namearray}
// 4504+ VinX, {namearrayname}
// 4505+ 0
// 4506
// 4507 New = 1
NEW = 1;
// 4508 Decl = Tag
DECL = TAG();
// 4509 %if Decl # 0 %start {normal item}
if (DECL == 0) goto L_03E8;
// 4510 New = 0 %if Decl <= Vars
if (DECL > VARS) goto L_03E9;
NEW = 0;
L_03E9:;
// 4511 DefV == Var(Decl); Clear Vars(Decl)
DEFV = (struct VARFM *)/*?*/ &VAR[DECL];
CLEARVARS(DECL);
// 4512 %finish %else %start {format item}
goto L_03EA;
L_03E8:;
// 4513 Parms = Parms-1
PARMS = PARMS - 1;
// 4514 DefV == Var(Parms); DefV = 0
DEFV = (struct VARFM *)/*?*/ &VAR[PARMS];
*DEFV = (struct VARFM){0};
// 4515 %finish
L_03EA:;
// 4516 Fail("Too many objects") %if Parms <= Vars
if (PARMS > VARS) goto L_03EB;
FAIL(_imp_str_literal_size(63, "Too many objects"));
L_03EB:;
// 4517 Internal Id = ""
_imp_strncpy(/*?*/ &INTERNALID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 15);
// 4518 %while Pending # ',' %cycle
L_03EC:;
if (PENDING == 44) goto L_03ED;
// 4519 %if Length(Internal Id) # 15 %start
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &INTERNALID) == 15) goto L_03EE;
// 4520 Internal Id = Internal Id.Tostring(Pending)
_imp_strncpy(/*?*/ &INTERNALID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &INTERNALID, ({
__typeof__(_imp_string1) tmp; /*E*/
tmp = _imp_TOSTRING(PENDING);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 15);
// 4521 %finish
L_03EE:;
// 4522 Readch(Pending)
READCH(/*?*/ &PENDING);
// 4523 %repeat
goto L_03EC;
L_03ED:;
// 4524 Readch(Pending) {skip comma}
READCH(/*?*/ &PENDING);
// 4525 Tf = Tag
TF = TAG();
// 4526 Format = Tag
FORMAT = TAG();
// 4527 Ostate = Tag
OSTATE = TAG();
// 4528
// 4529 Dim = Ostate>>8
DIM = (unsigned int)OSTATE >> 8;
// 4530 Spec = Ostate&8
SPEC = OSTATE & 8;
// 4531 Ostate = Ostate&7; Ostate = External %if Ostate = Dynamic
OSTATE = OSTATE & 7;
if (OSTATE != 5) goto L_03EF;
OSTATE = 3;
L_03EF:;
// 4532 Type = Tf>>4
TYPE = (unsigned int)TF >> 4;
// 4533 Form = Tf&15
FORM = TF & 15;
// 4534
// 4535 %if Alias # "" %start
if (_imp_strcmp((_imp_string *)/*?*/ &ALIAS, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) == 0) goto L_03F0;
// 4536 External Id = Alias; Alias = ""
_imp_strncpy(/*?*/ &EXTERNALID, ({
__typeof__(_imp_string15) tmp; /*B*/
tmp = ALIAS;
(void *)&tmp;
}),
/*max:*/ 15);
_imp_strncpy(/*?*/ &ALIAS, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 15);
// 4537 %finish %else %start
goto L_03F1;
L_03F0:;
// 4538 %if Ostate = System %start
if (OSTATE != 4) goto L_03F2;
// 4539 Ostate = External
OSTATE = 3;
// 4540 External Id = "$".Internal Id
_imp_strncpy(/*?*/ &EXTERNALID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("$"), (_imp_string *)/*?*/ &INTERNALID);
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 15);
// 4541 %finish %else %start
goto L_03F3;
L_03F2:;
// 4542 External Id = Internal Id
_imp_strncpy(/*?*/ &EXTERNALID, ({
__typeof__(_imp_string15) tmp; /*B*/
tmp = INTERNALID;
(void *)&tmp;
}),
/*max:*/ 15);
// 4543 %finish
L_03F3:;
// 4544 %finish
L_03F1:;
// 4545
// 4546 Data Size = Word Length; Round = Alignment
DATASIZE = 2;
ROUND = 1;
// 4547 %if Type = 0 {general} %start
if (TYPE != 0) goto L_03F4;
// 4548 Type = Generals
TYPE = 7;
// 4549 Data Size = Word Length*3
DATASIZE = 2 * 3;
// 4550 DefV_Format = Word Length*3
DEFV->FORMAT = 2 * 3;
// 4551 %finish %else %if Type = 1 {integer} %start
goto L_03F5;
L_03F4:;
if (TYPE != 1) goto L_03F6;
// 4552 Type = Integers
TYPE = 1;
// 4553 %if Format = 2 {byte} %start
if (FORMAT != 2) goto L_03F7;
// 4554 %if Form # 8 %and (Parameter List <= 0 %or Form # 1) %start
if (FORM == 8) goto L_03F8;
if (PARAMETERLIST <= 0) goto L_03C6;
if (FORM == 1) goto L_03F8;
L_03C6:;
// 4555 {not a function or parameter}
// 4556 Type = Bytes
TYPE = 2;
// 4557 Data Size = 1
DATASIZE = 1;
// 4558 Round = 0
ROUND = 0;
// 4559 %finish
L_03F8:;
// 4560 %finish
L_03F7:;
// 4561 DefV_Format = Data Size
DEFV->FORMAT = DATASIZE;
// 4562 %finish %else %if Type = 2 {real} %start
goto L_03F5;
L_03F6:;
if (TYPE != 2) goto L_03F9;
// 4563 Type = Reals
TYPE = 3;
// 4564 Type = Lreals %and Data Size = Word Length*2 %if Format = 4
if (FORMAT != 4) goto L_03FA;
TYPE = 4;
DATASIZE = 2 * 2;
L_03FA:;
// 4565 DefV_Format = Data Size
DEFV->FORMAT = DATASIZE;
// 4566 %finish %else %if Type = 3 {string} %start
goto L_03F5;
L_03F9:;
if (TYPE != 3) goto L_03FB;
// 4567 Type = Strings
TYPE = 5;
// 4568 Data Size = Format+1
DATASIZE = FORMAT + 1;
// 4569 Round = 0
ROUND = 0;
// 4570 DefV_Format = Data Size
DEFV->FORMAT = DATASIZE;
// 4571 %finish %else %if Type = 4 {records} %start
goto L_03F5;
L_03FB:;
if (TYPE != 4) goto L_03FC;
// 4572 Parameter Mode = -1
PARAMETERMODE = -1;
// 4573 Type = Records
TYPE = 6;
// 4574 Data Size = Var(Format)_Format %if Format <= Vars
if (FORMAT > VARS) goto L_03FD;
DATASIZE = VAR[FORMAT].FORMAT;
L_03FD:;
// 4575 DefV_Format = -Format
DEFV->FORMAT = -FORMAT;
// 4576 %finish
L_03FC:;
L_03F5:;
// 4577 Decl Size = Data Size
DECLSIZE = DATASIZE;
// 4578
// 4579 DefV_Type = Type
DEFV->TYPE = TYPE;
// 4580 DefV_Form = Form Map(Form)
DEFV->FORM = FORMMAP[FORM];
// 4581
// 4582 %if Form = 4 %start {recordformat}
if (FORM != 4) goto L_03FE;
// 4583 DefV_Extra = Parms
DEFV->EXTRA = PARMS;
// 4584 Parameter Mode = -1
PARAMETERMODE = -1;
// 4585 Block Type = -1
BLOCKTYPE = -1;
// 4586 %finish %else %if Form = 3 {label} %start
goto L_03FF;
L_03FE:;
if (FORM != 3) goto L_0400;
// 4587 Set User Label(Decl)
SETUSERLABEL(DECL);
// 4588 %finish %else %if Form = 6 {switch} %start
goto L_03FF;
L_0400:;
if (FORM != 6) goto L_0401;
// 4589 %return %if Vlb > Vub
if (VLB <= VUB) goto L_0402;
return;
L_0402:;
// 4590 Select Constant Area
SELECTCONSTANTAREA();
// 4591 Word Align
WORDALIGN();
// 4592 DefV_Format = Ca
DEFV->FORMAT = *CA;
// 4593 %if Control&Check Jumps # 0 %start
if (CONTROL & 2048 == 0) goto L_0403;
// 4594 Cword(Vlb); Cword(Vub)
CWORD(VLB);
CWORD(VUB);
// 4595 %finish
L_0403:;
// 4596 DefV_Area = Constant Area
DEFV->AREA = 2;
// 4597 DefV_Disp = Ca-Vlb*2 {zero'th element}
DEFV->DISP = *CA - VLB * 2;
// 4598 DefV_Extra = Free Label-Vlb+1 {zero'th tag}
DEFV->EXTRA = FREELABEL - VLB + 1;
// 4599 Dcode(Dir Switch); Put(Vlb); Put(Vub); Put(Free Label)
DCODE(19);
PUT(VLB);
PUT(VUB);
PUT(FREELABEL);
// 4600 Ocode(Obj Switch); Put(Vlb); Put(Vub); Put(Free Label)
OCODE(37);
PUT(VLB);
PUT(VUB);
PUT(FREELABEL);
// 4601 Free Label = Free Label+Vub-Vlb+1
FREELABEL = FREELABEL + VUB - VLB + 1;
// 4602 Ca = Ca+(Vub-Vlb+1)*2
*CA = *CA + (VUB - VLB + 1) * 2;
// 4603 Select Code Area
SELECTCODEAREA();
// 4604 %finish %else %if 7 <= Form <= 10 {routine, fn, map, predicate} %start
goto L_03FF;
L_0401:;
{
// Double-sided test on FORM (Part I)
int tmp;
if (7 > (tmp = FORM)) goto L_0404;
// Double-sided test on FORM (Part II)
if (tmp > 10) goto L_0404;
}
// 4605 Parameter Mode = 1
PARAMETERMODE = 1;
// 4606 Block Type = Spec {0=definition, 8=specification}
BLOCKTYPE = SPEC;
// 4607 %if 8 <= Form <= 9 %start {fn/map}
{
// Double-sided test on FORM (Part I)
int tmp;
if (8 > (tmp = FORM)) goto L_0405;
// Double-sided test on FORM (Part II)
if (tmp > 9) goto L_0405;
}
// 4608 DefV_Flags = Answer
DEFV->FLAGS = 16;
// 4609 DefV_Flags = Answer!Indirect %if Form = 9 {map}
if (FORM != 9) goto L_0406;
DEFV->FLAGS = 16 | 8;
L_0406:;
// 4610 %finish
L_0405:;
// 4611 %if Ostate = PrimRt %start
if (OSTATE != 6) goto L_0407;
// 4612 Defv_Flags = Defv_Flags!Primitive
DEFV->FLAGS = DEFV->FLAGS | 32;
// 4613 Defv_Disp = Dim
DEFV->DISP = DIM;
// 4614 %finish
L_0407:;
// 4615 %finish %else %start
goto L_03FF;
L_0404:;
// 4616 %if Form = 11 %or Form = 13 %start {array or namearray}
if (FORM == 11) goto L_0363;
if (FORM != 13) goto L_0408;
L_0363:;
// 4617 Defv_Flags = Defv_Flags!Array
DEFV->FLAGS = DEFV->FLAGS | 2;
// 4618 %if Form = 13 %start {namearray}
if (FORM != 13) goto L_0409;
// 4619 Decl Size = Word Length
DECLSIZE = 2;
// 4620 Decl Size = Word Length*2 %if Type = Strings %and %c
if (TYPE != 5) goto L_040A;
if (DATASIZE != 1) goto L_040A;
DECLSIZE = 2 * 2;
L_040A:;
// 4621+ Data Size = 1 {string(*)%namearray}
// 4622 DefV_Flags = Indirect
DEFV->FLAGS = 8;
// 4623 Round = 1 {word aligned}
ROUND = 1;
// 4624 %finish
L_0409:;
// 4625 Data Size = 0 {no space allocated here}
DATASIZE = 0;
// 4626 {leave the rest to 'd'}
// 4627 %finish %else %start {normal declaration}
goto L_040B;
L_0408:;
// 4628 %if Form = 2 %start {%name}
if (FORM != 2) goto L_040C;
// 4629 Round = Alignment
ROUND = 1;
// 4630 %if Type # Generals %start
if (TYPE == 7) goto L_040D;
// 4631 Decl Size = Word Length
DECLSIZE = 2;
// 4632 Decl Size = Word Length*2 %if Type = Strings %and %c
if (TYPE != 5) goto L_040E;
if (DATASIZE != 1) goto L_040E;
DECLSIZE = 2 * 2;
L_040E:;
// 4633+ Data Size = 1 {string(*)name}
// 4634 Data Size = Decl Size
DATASIZE = DECLSIZE;
// 4635 %finish
L_040D:;
// 4636 %finish %else %if Form # 1 %start {arrayname or namearrayname}
goto L_040F;
L_040C:;
if (FORM == 1) goto L_0410;
// 4637 Round = Alignment
ROUND = 1;
// 4638 Data Size = Word Length*2
DATASIZE = 2 * 2;
// 4639 DefV_Flags = Indirect %if Form = 14 {namearrayname}
if (FORM != 14) goto L_0411;
DEFV->FLAGS = 8;
L_0411:;
// 4640 DefV_Flags = DefV_Flags!Arrayname
DEFV->FLAGS = DEFV->FLAGS | 64;
// 4641 %finish
L_0410:;
L_040F:;
// 4642 %finish
L_040B:;
// 4643 %if Ostate = 0 %start
if (OSTATE != 0) goto L_0412;
// 4644 Frame = (Frame+Round)&(\Round)
FRAME = FRAME + ROUND & (~ROUND);
// 4645 DefV_Disp = Frame; Frame = Frame+Data Size
DEFV->DISP = FRAME;
FRAME = FRAME + DATASIZE;
// 4646 DefV_Base = Local
DEFV->BASE = LOCAL;
// 4647 %finish %else %start
goto L_0413;
L_0412:;
// 4648 %if Spec = 0 %start
if (SPEC != 0) goto L_0414;
// 4649 OwnType = Type; OwnForm = Form
OWNTYPE = TYPE;
OWNFORM = FORM;
// 4650 Init Flag = 0
INITFLAG = 0;
// 4651 %if Ostate = Con %start {const something}
if (OSTATE != 2) goto L_0415;
// 4652 %if Form = 2 {constname} %or %c
if (FORM == 2) goto L_0416;
if (FORM == 12) goto L_0416;
if (FORM != 14) goto L_0417;
L_0416:;
// 4653+ Form = 12 {constarrayname} %or %c
// 4654+ Form = 14 {constnamearrayname} %start
// 4655 DefV_Form = VinS
DEFV->FORM = 1;
// 4656 Init Flag = -1
INITFLAG = -1;
// 4657 %return
return;
// 4658 %finish
L_0417:;
// 4659 Select Constant Area
SELECTCONSTANTAREA();
// 4660 %finish %else %start {ownish}
goto L_0418;
L_0415:;
// 4661 Select Own Area
SELECTOWNAREA();
// 4662 %finish
L_0418:;
// 4663 OwnExtra = 1 %if Form = 12 %or Form = 14
if (FORM == 12) goto L_0419;
if (FORM != 14) goto L_041A;
L_0419:;
OWNEXTRA = 1;
L_041A:;
// 4664 %if Type = Strings %start
if (TYPE != 5) goto L_041B;
// 4665 OwnExtra = 1 %if Form = 2 %or Form = 13
if (FORM == 2) goto L_041C;
if (FORM != 13) goto L_041D;
L_041C:;
OWNEXTRA = 1;
L_041D:;
// 4666 %finish
L_041B:;
// 4667 Owntype = Integers %if Form # 1 %and Form # 11
if (FORM == 1) goto L_041E;
if (FORM == 11) goto L_041E;
OWNTYPE = 1;
L_041E:;
// 4668 Word Align %if Round # 0
if (ROUND == 0) goto L_041F;
WORDALIGN();
L_041F:;
// 4669 DefV_Disp = Ca
DEFV->DISP = *CA;
// 4670 %if Form = 11 %or Form = 13 %start {array or namearray}
if (FORM == 11) goto L_0420;
if (FORM != 13) goto L_0421;
L_0420:;
// 4671 Integer value = 0
INTEGERVALUE = 0;
// 4672 Real value = 0
REALVALUE = (struct REALFM){0};
// 4673 String value = ""
_imp_strncpy(/*?*/ &STRINGVALUE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 255);
// 4674 Init Flag = 1
INITFLAG = 1;
// 4675 DefV_Disp = DefV_Disp-Vlb*Decl Size {back to A(0)}
DEFV->DISP = DEFV->DISP - VLB * DECLSIZE;
// 4676 %finish
L_0421:;
// 4677 DefV_Area = Current Area
DEFV->AREA = CURRENTAREA;
// 4678 Dump External(Dir Ddef, DefV) %if Ostate = External
if (OSTATE != 3) goto L_0422;
DUMPEXTERNAL(13, DEFV);
L_0422:;
// 4679 %finish %else %start {external data spec}
goto L_0423;
L_0414:;
// 4680 Dump External(Dir Notex, DefV)
DUMPEXTERNAL(10, DEFV);
// 4681 %finish
L_0423:;
// 4682 %finish
L_0413:;
// 4683 %finish
L_03FF:;
// 4684 Alt Align = Alt Align!Round {remember worst alignment}
ALTALIGN = ALTALIGN | ROUND;
// 4685 %end
return;
} /* end of DEFINEVAR */
// 4686 %routine Dump Real(%integer Type)
void DUMPREAL(int TYPE) {
// 4687 Cword(Real Value_W1); Cword(Real Value_W2)
CWORD(REALVALUE.W1);
CWORD(REALVALUE.W2);
// 4688 %if Type = Lreals %start
if (TYPE != 4) goto L_0424;
// 4689 Cword(Real Value_W3); Cword(Real Value_W4)
CWORD(REALVALUE.W3);
CWORD(REALVALUE.W4);
// 4690 %finish
L_0424:;
// 4691 %end
return;
} /* end of DUMPREAL */
// 4692 %routine Dump Text(%integer Max)
void DUMPTEXT(int MAX) {
// 4693 %integer J, Len
int J;
int LEN;
// 4694 Len = Length(String Value)
LEN = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &STRINGVALUE);
// 4695 %if Max = 0 %start {no upper limit}
if (MAX != 0) goto L_0425;
// 4696 Max = Len {use the actual length}
MAX = LEN;
// 4697 %finish %else %start {check the length}
goto L_0426;
L_0425:;
// 4698 Len = Max %and Warn("String truncated") %if Len > Max
if (LEN <= MAX) goto L_0427;
LEN = MAX;
WARN(_imp_str_literal_size(63, "String truncated"));
L_0427:;
// 4699 %finish
L_0426:;
// 4700 Cbyte(Len) {string length}
CBYTE(LEN);
// 4701 %for J = 1, 1, Max %cycle
// %for J = 1, 1, MAX %cycle
{
int _final = MAX;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, MAX");
J = 0;
L_0428:
if (J == _final) goto L_0429;
J += 1;
// 4702 %if J > Len %then Cbyte(0) %else CByte(Charno(String Value, J))
if (J <= LEN) goto L_042A;
CBYTE(0);
goto L_042B;
L_042A:;
CBYTE(*_imp_CHARNO((_imp_string255 *)/*p*/ /*?*/ &STRINGVALUE, J));
L_042B:;
// 4703 %repeat
goto L_0428;
}
L_0429:;
// 4704 %end
return;
} /* end of DUMPTEXT */
// 4705 %routine Adump
void ADUMP(void) {
// 4706 %integer J
int J;
// 4707 %if OwnType = Integers %start
if (OWNTYPE != 1) goto L_042C;
// 4708 Cword(Integer Value)
CWORD(INTEGERVALUE);
// 4709 %finish %else %if Owntype = Bytes %start
goto L_042D;
L_042C:;
if (OWNTYPE != 2) goto L_042E;
// 4710 Cbyte(Integer Value)
CBYTE(INTEGERVALUE);
// 4711 Warn("Truncation") %unless 0 <= Integer Value <= 255
{
// Double-sided test on INTEGERVALUE (Part I)
int tmp;
if (0 > (tmp = INTEGERVALUE)) goto L_042F;
// Double-sided test on INTEGERVALUE (Part II)
if (tmp <= 255) goto L_0430;
}
L_042F:;
WARN(_imp_str_literal_size(63, "Truncation"));
L_0430:;
// 4712 %finish %else %if OwnType = Reals %or OwnType = Lreals %start
goto L_042D;
L_042E:;
if (OWNTYPE == 3) goto L_03CC;
if (OWNTYPE != 4) goto L_0431;
L_03CC:;
// 4713 Dump Real(OwnType)
DUMPREAL(OWNTYPE);
// 4714 %finish %else %if OwnType = Strings %start
goto L_042D;
L_0431:;
if (OWNTYPE != 5) goto L_0432;
// 4715 Dump Text(Decl Size-1)
DUMPTEXT(DECLSIZE - 1);
// 4716 %finish %else %if OwnType = Records %start
goto L_042D;
L_0432:;
if (OWNTYPE != 6) goto L_0433;
// 4717 Cword(0) %for J = 1, 1, Decl Size>>1
// %for J = 1, 1, (unsigned int)DECLSIZE >> 1 %cycle
{
int _final = (unsigned int)DECLSIZE >> 1;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, (unsigned int)DECLSIZE >> 1");
J = 0;
L_0434:
if (J == _final) goto L_0435;
J += 1;
CWORD(0);
goto L_0434;
}
L_0435:;
// 4718 %finish %else Fail("Init")
goto L_042D;
L_0433:;
FAIL(_imp_str_literal_size(63, "Init"));
L_042D:;
// 4719 %while OwnExtra > 0 %cycle
L_0437:;
if (OWNEXTRA <= 0) goto L_0438;
// 4720 OwnExtra = OwnExtra-1; Cword(0)
OWNEXTRA = OWNEXTRA - 1;
CWORD(0);
// 4721 %repeat
goto L_0437;
L_0438:;
// 4722 %end
return;
} /* end of ADUMP */
// 4723 %routine Init(%integer N)
void INIT(int N) {
// 4724 %if Reals <= OwnType <= Lreals %start
{
// Double-sided test on OWNTYPE (Part I)
int tmp;
if (3 > (tmp = OWNTYPE)) goto L_0439;
// Double-sided test on OWNTYPE (Part II)
if (tmp > 4) goto L_0439;
}
// 4725 Real Value_R = Integer Value %if Constant Type = Integers
if (CONSTANTTYPE != 1) goto L_043A;
REALVALUE.R = INTEGERVALUE;
L_043A:;
// 4726 %finish
L_0439:;
// 4727 %if Init Flag < 0 %start {const?name}
if (INITFLAG >= 0) goto L_043B;
// 4728 DefV_Disp = Integer Value
DEFV->DISP = INTEGERVALUE;
// 4729 %finish %else %start
goto L_043C;
L_043B:;
// 4730 %if Ostate = Con %then Select Constant Area %c
if (OSTATE != 2) goto L_043D;
SELECTCONSTANTAREA();
goto L_043E;
L_043D:;
SELECTOWNAREA();
L_043E:;
// 4731+ %else Select Own Area
// 4732 %if Init Flag > 0 %start {array}
if (INITFLAG <= 0) goto L_043F;
// 4733 %cycle
L_0440:;
// 4734 N = N-1
N = N - 1;
// 4735 %exit %if N < 0
if (N >= 0) goto L_0441;
goto L_0442;
L_0441:;
// 4736 Adump
ADUMP();
// 4737 %repeat
goto L_0440;
L_0442:;
// 4738 %finish %else %start {scalar}
goto L_0443;
L_043F:;
// 4739 Adump
ADUMP();
// 4740 %finish
L_0443:;
// 4741 Select Code Area
SELECTCODEAREA();
// 4742 %finish
L_043C:;
// 4743 String Value = "" {Restore the default values}
_imp_strncpy(/*?*/ &STRINGVALUE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 255);
// 4744 Integer Value = 0
INTEGERVALUE = 0;
// 4745 Real Value = 0
REALVALUE = (struct REALFM){0};
// 4746 %end
return;
} /* end of INIT */
// 4747 %routine Dimension(%integer Dim, N)
void DIMENSION(int DIM, int N) {
// 4748 %integer Bias, Total, X, J
int BIAS;
int TOTAL;
int X;
int J;
// 4749 %record(Stackfm)%name Lb, Ub, B
struct STACKFM *LB;
struct STACKFM *UB;
struct STACKFM *B;
// 4750 %record(Varfm)%name V
struct VARFM *V;
// 4751 %if Parameter List = 0 %then X = Vars-N %c
if (PARAMETERLIST != 0) goto L_0444;
X = VARS - N;
goto L_0445;
L_0444:;
X = PARMS + N;
L_0445:;
// 4752+ %else X = Parms+N
// 4753
// 4754 %if Dim = 1 %start
if (DIM != 1) goto L_0446;
// 4755 Ub == Stack
UB = (struct STACKFM *)STACK;
// 4756 Lb == Ub_Stack
LB = (struct STACKFM *)UB->STACK;
// 4757 %if Const(Lb)#0 %and Const(Ub)#0 %start {constant bounds}
if (CONST(LB) == 0) goto L_0447;
if (CONST(UB) == 0) goto L_0447;
// 4758 Stack == Lb_Stack
STACK = (struct STACKFM *)LB->STACK;
// 4759 Vlb = Lb_Disp
VLB = LB->DISP;
// 4760 Vub = Ub_Disp
VUB = UB->DISP;
// 4761 Total = (Vub-Vlb+1)*Decl Size {total Decl Size}
TOTAL = (VUB - VLB + 1) * DECLSIZE;
// 4762 Bias = Vlb*Decl Size {A(First)-A(0)}
BIAS = VLB * DECLSIZE;
// 4763 Fail("Bounds") %if Total < 0
if (TOTAL >= 0) goto L_0448;
FAIL(_imp_str_literal_size(63, "Bounds"));
L_0448:;
// 4764 %while N > 0 %cycle
L_0449:;
if (N <= 0) goto L_044A;
// 4765 %if Parameter List = 0 %then X = X+1 %else X = X-1
if (PARAMETERLIST != 0) goto L_044B;
X = X + 1;
goto L_044C;
L_044B:;
X = X - 1;
L_044C:;
// 4766 V == Var(X)
V = (struct VARFM *)/*?*/ &VAR[X];
// 4767 V_Flags = V_Flags!Static
V->FLAGS = V->FLAGS | 32;
// 4768 V_Disp = Frame-Bias; Frame = Frame+Total
V->DISP = FRAME - BIAS;
FRAME = FRAME + TOTAL;
// 4769 N = N-1
N = N - 1;
// 4770 %repeat
goto L_0449;
L_044A:;
// 4771 Drop(Lb); Drop(Ub)
DROP(LB);
DROP(UB);
// 4772 %return
return;
// 4773 %finish
L_0447:;
// 4774 %finish
L_0446:;
// 4775 {Create dope-vector}
// 4776 %for J = 1,1,Dim*2 %cycle
// %for J = 1, 1, DIM * 2 %cycle
{
int _final = DIM * 2;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, DIM * 2");
J = 0;
L_044D:
if (J == _final) goto L_044E;
J += 1;
// 4777 B == Stack; Stack == B_Stack
B = (struct STACKFM *)STACK;
STACK = (struct STACKFM *)B->STACK;
// 4778 Push(B)
PUSH(B);
// 4779 Release and Drop(B)
RELEASEANDDROP(B);
// 4780 Cword(8_005025) %if J&1 = 0 {CLR_(DS)+}
if (J & 1 != 0) goto L_0450;
CWORD(2581);
L_0450:;
// 4781 %repeat
goto L_044D;
}
L_044E:;
// 4782 %if Dim = 1 %start
if (DIM != 1) goto L_0451;
// 4783 Perm(Adecl)
PERM(14);
// 4784 %finish %else %start
goto L_0452;
L_0451:;
// 4785 Cword(8_012725); Cword(Dim)
CWORD(5589);
CWORD(DIM);
// 4786 Perm(Multi Dec)
PERM(17);
// 4787 %finish
L_0452:;
// 4788 Cword(Decl Size)
CWORD(DECLSIZE);
// 4789
// 4790 {create the arrays}
// 4791 {R1 = Total size }
// 4792 {R2 = @Dope Vector}
// 4793 {R3 = -A(0)+4 }
// 4794
// 4795 %while N > 0 %cycle
L_0453:;
if (N <= 0) goto L_0454;
// 4796 X = X+1
X = X + 1;
// 4797 V == Var(X)
V = (struct VARFM *)/*?*/ &VAR[X];
// 4798 V_Form = VinX
V->FORM = 4;
// 4799 V_Disp = 0
V->DISP = 0;
// 4800 V_Extra = Frame
V->EXTRA = FRAME;
// 4801 V_Flags = V_Flags!Arrayname
V->FLAGS = V->FLAGS | 64;
// 4802 Perm(ASET); Cword(Frame)
PERM(3);
CWORD(FRAME);
// 4803 Frame = Frame+4
FRAME = FRAME + 4;
// 4804 N = N-1
N = N - 1;
// 4805 %repeat
goto L_0453;
L_0454:;
// 4806 Attributes = Attributes!Attr Dynamic
ATTRIBUTES = ATTRIBUTES | 4096;
// 4807 %end
return;
} /* end of DIMENSION */
// 4808
// 4809 %switch C(0:127)
int C_index;
int C_line;
char *C_file;
static const void *C[128] = {
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default,
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_10, &&case_C_default,
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default,
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default,
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default,
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_33, &&case_C_34, &&case_C_35,
&&case_C_36, &&case_C_37, &&case_C_38, &&case_C_39, &&case_C_40, &&case_C_41,
&&case_C_42, &&case_C_43, &&case_C_default, &&case_C_45, &&case_C_46, &&case_C_47,
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default,
&&case_C_default, &&case_C_default, &&case_C_default, &&case_C_default, &&case_C_58, &&case_C_59,
&&case_C_60, &&case_C_61, &&case_C_62, &&case_C_63, &&case_C_64, &&case_C_65,
&&case_C_66, &&case_C_67, &&case_C_68, &&case_C_69, &&case_C_70, &&case_C_71,
&&case_C_72, &&case_C_default, &&case_C_74, &&case_C_75, &&case_C_76, &&case_C_77,
&&case_C_78, &&case_C_79, &&case_C_80, &&case_C_81, &&case_C_82, &&case_C_83,
&&case_C_84, &&case_C_85, &&case_C_86, &&case_C_87, &&case_C_88, &&case_C_default,
&&case_C_90, &&case_C_91, &&case_C_92, &&case_C_93, &&case_C_default, &&case_C_95,
&&case_C_default, &&case_C_97, &&case_C_98, &&case_C_99, &&case_C_100, &&case_C_101,
&&case_C_102, &&case_C_default, &&case_C_default, &&case_C_105, &&case_C_106, &&case_C_107,
&&case_C_108, &&case_C_109, &&case_C_110, &&case_C_111, &&case_C_112, &&case_C_default,
&&case_C_114, &&case_C_default, &&case_C_116, &&case_C_117, &&case_C_118, &&case_C_119,
&&case_C_120, &&case_C_121, &&case_C_122, &&case_C_123, &&case_C_default, &&case_C_125,
&&case_C_126, &&case_C_default};
// 4810
// 4811 Old Frame = Frame
OLDFRAME = FRAME;
// 4812 %if Amode >= -1 %start {procedure definition, format start}
if (AMODE < -1) goto L_0455;
// 4813 Frame = 0
FRAME = 0;
// 4814 %if Amode >= 0 %start {procedure def}
if (AMODE < 0) goto L_0456;
// 4815 Avar_Disp = New Label %if Avar_Disp = 0
if (AVAR->DISP != 0) goto L_0457;
AVAR->DISP = NEWLABEL();
L_0457:;
// 4816 %if Amode = 0 %start {entry to block}
if (AMODE != 0) goto L_0458;
// 4817 Uncond Jump = -1; Forget Everything
UNCONDJUMP = -1;
FORGETEVERYTHING();
// 4818 Dcode(Dir Block); Put(Avar_Disp)
DCODE(6);
PUT(AVAR->DISP);
// 4819 Ocode(Obj Block); Put(Avar_Disp)
OCODE(44);
PUT(AVAR->DISP);
// 4820 Fmark = Fmark+1; Frame Use(Local) = Fmark
FMARK = FMARK + 1;
FRAMEUSE[LOCAL - 128] = FMARK;
// 4821 %finish
L_0458:;
// 4822 %if Ostate = External %start
if (OSTATE != 3) goto L_0459;
// 4823 %if Amode # 0 %start {external spec}
if (AMODE == 0) goto L_045A;
// 4824 Avar_Flags = Avar_Flags!Xproc
AVAR->FLAGS = AVAR->FLAGS | 64;
// 4825 Dump External(Dir Notex, Avar)
DUMPEXTERNAL(10, AVAR);
// 4826 %finish %else %start {external definition}
goto L_045B;
L_045A:;
// 4827 Dump External(Dir Xdef, Avar)
DUMPEXTERNAL(12, AVAR);
// 4828 %finish
L_045B:;
// 4829 %finish
L_0459:;
// 4830 %finish
L_0456:;
// 4831 %finish
L_0455:;
// 4832
// 4833 Frame Extra = Frame&1
FRAMEEXTRA = FRAME & 1;
// 4834 Frame = Frame+Frame Extra
FRAME = FRAME + FRAMEEXTRA;
// 4835 Frame Base = Frame
FRAMEBASE = FRAME;
// 4836 MyMark = Fmark
MYMARK = FMARK;
// 4837 Max Frame = 0
MAXFRAME = 0;
// 4838 Alt Align = 0
ALTALIGN = 0;
// 4839
// 4840 %cycle
L_045C:;
// 4841 Code = Pending; Readch(Pending); ->C(Code)
CODE = PENDING;
READCH(/*?*/ &PENDING);
C_line = __LINE__;
C_file = __FILE__;
C_index = CODE;
goto case_C_dispatch;
// 4842
// 4843 c('!'): Operation(ORx); %continue
case_C_33:;
OPERATION(9);
goto L_044F;
// 4844 c('"'): Compare Double; %continue
case_C_34:;
COMPAREDOUBLE();
goto L_044F;
// 4845 c('#'): Jump Forward(Tag, NE); %continue
case_C_35:;
JUMPFORWARD(TAG(), 6);
goto L_044F;
// 4846 c('$'): Define Var; %continue
case_C_36:;
DEFINEVAR();
goto L_044F;
// 4847 c('%'): Operation(XORx); %continue
case_C_37:;
OPERATION(10);
goto L_044F;
// 4848 c('&'): Operation(ANDx); %continue
case_C_38:;
OPERATION(8);
goto L_044F;
// 4849 c(''''): Input String Value; %continue
case_C_39:;
INPUTSTRINGVALUE();
goto L_044F;
// 4850 c('('): Jump Forward(Tag, LE); %continue
case_C_40:;
JUMPFORWARD(TAG(), 3);
goto L_044F;
// 4851 c(')'): Jump Forward(Tag, GE); %continue
case_C_41:;
JUMPFORWARD(TAG(), 5);
goto L_044F;
// 4852 c('*'): Operation(MULx); %continue
case_C_42:;
OPERATION(5);
goto L_044F;
// 4853 c('+'): Operation(ADDx); %continue
case_C_43:;
OPERATION(3);
goto L_044F;
// 4854 c('-'): Operation(SUBx); %continue
case_C_45:;
OPERATION(4);
goto L_044F;
// 4855 c('.'): Operation(CONCx); %continue
case_C_46:;
OPERATION(15);
goto L_044F;
// 4856 c('/'): Operation(DIVx); %continue
case_C_47:;
OPERATION(6);
goto L_044F;
// 4857 c(':'): Define Compiler Label(Tag); %continue
case_C_58:;
DEFINECOMPILERLABEL(TAG());
goto L_044F;
// 4858 c(';'): End of Block; %exit
case_C_59:;
ENDOFBLOCK();
goto L_045E;
// 4859 c('<'): Jump Forward(Tag, LT); %continue
case_C_60:;
JUMPFORWARD(TAG(), 2);
goto L_044F;
// 4860 c('='): Jump Forward(Tag, EQ); %continue
case_C_61:;
JUMPFORWARD(TAG(), 1);
goto L_044F;
// 4861 c('>'): Jump Forward(Tag, GT); %continue
case_C_62:;
JUMPFORWARD(TAG(), 4);
goto L_044F;
// 4862 c('?'): Compare Values; %continue
case_C_63:;
COMPAREVALUES();
goto L_044F;
// 4863 c('@'): Stack Var(Tag); %continue
case_C_64:;
STACKVAR(TAG());
goto L_044F;
// 4864 c('A'): Init(Tag); %continue
case_C_65:;
INIT(TAG());
goto L_044F;
// 4865 c('B'): Jump Backward(Tag); %continue
case_C_66:;
JUMPBACKWARD(TAG());
goto L_044F;
// 4866 c('C'): Compare Addresses; %continue
case_C_67:;
COMPAREADDRESSES();
goto L_044F;
// 4867 c('D'): Input Real Value; %continue
case_C_68:;
INPUTREALVALUE();
goto L_044F;
// 4868 c('E'): Call; %continue
case_C_69:;
CALL();
goto L_044F;
// 4869 c('F'): Jump Forward(Tag, Always); %continue
case_C_70:;
JUMPFORWARD(TAG(), 7);
goto L_044F;
// 4870 c('G'): Get String(Alias); %continue
case_C_71:;
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &ALIAS);
goto L_044F;
// 4871 c('H'): Compile Begin; %continue
case_C_72:;
COMPILEBEGIN();
goto L_044F;
// 4872
// 4873 c('J'): User Jump(Tag); %continue
case_C_74:;
USERJUMP(TAG());
goto L_044F;
// 4874 c('K'): Return(False); %continue
case_C_75:;
RETURN(2);
goto L_044F;
// 4875 c('L'): Define User Label(Tag); %continue
case_C_76:;
DEFINEUSERLABEL(TAG());
goto L_044F;
// 4876 c('M'): Return(Map); %continue
case_C_77:;
RETURN(4);
goto L_044F;
// 4877 c('N'): Input Integer Value; %continue
case_C_78:;
INPUTINTEGERVALUE();
goto L_044F;
// 4878 c('O'): Update Line(Tag); %continue
case_C_79:;
UPDATELINE(TAG());
goto L_044F;
// 4879 c('P'): Cword(Popped Value); %continue
case_C_80:;
CWORD(POPPEDVALUE());
goto L_044F;
// 4880 c('Q'): Operation(RDIVx); %continue
case_C_81:;
OPERATION(20);
goto L_044F;
// 4881 c('R'): Return(Routine); %continue
case_C_82:;
RETURN(0);
goto L_044F;
// 4882 c('S'): Assign(Equals); %continue
case_C_83:;
ASSIGN(0);
goto L_044F;
// 4883 c('T'): Return(True); %continue
case_C_84:;
RETURN(1);
goto L_044F;
// 4884 c('U'): Operate(NEGx, Stack, Null); %continue
case_C_85:;
OPERATE(2, STACK, NULL);
goto L_044F;
// 4885 c('V'): Return(Fn); %continue
case_C_86:;
RETURN(3);
goto L_044F;
// 4886 c('W'): Switch Jump(Tag); %continue
case_C_87:;
SWITCHJUMP(TAG());
goto L_044F;
// 4887 c('X'): Operation(EXPx); %continue
case_C_88:;
OPERATION(7);
goto L_044F;
// 4888 c('Z'): Assign(EqualsEquals); %continue
case_C_90:;
ASSIGN(1);
goto L_044F;
// 4889 c('['): Operation(LSHx); %continue
case_C_91:;
OPERATION(12);
goto L_044F;
// 4890 c('\'): Operate(NOTx, Stack, Null); %continue
case_C_92:;
OPERATE(1, STACK, NULL);
goto L_044F;
// 4891 c(']'): Operation(RSHx); %continue
case_C_93:;
OPERATION(13);
goto L_044F;
// 4892 c('_'): Switch Label(Tag); %continue
case_C_95:;
SWITCHLABEL(TAG());
goto L_044F;
// 4893 c('a'): Array Access; %continue
case_C_97:;
ARRAYACCESS();
goto L_044F;
// 4894 c('b'): Constant Bounds; %continue
case_C_98:;
CONSTANTBOUNDS();
goto L_044F;
// 4895 c('c'): Section = 1; Get String(Section Id); %exit
case_C_99:;
SECTION = 1;
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &SECTIONID);
goto L_045E;
// 4896 c('d'): D = Tag; N = Tag; Dimension(D, N); %continue
case_C_100:;
D = TAG();
N = TAG();
DIMENSION(D, N);
goto L_044F;
// 4897 c('e'): Signal Event(Tag); %continue
case_C_101:;
SIGNALEVENT(TAG());
goto L_044F;
// 4898 c('f'): Compile For(Tag); %continue
case_C_102:;
COMPILEFOR(TAG());
goto L_044F;
// 4899
// 4900
// 4901 c('i'): Array Index; %continue
case_C_105:;
ARRAYINDEX();
goto L_044F;
// 4902 c('j'): Assign(Jam); %continue
case_C_106:;
ASSIGN(-1);
goto L_044F;
// 4903 c('k'): Jump Forward(Tag, FF); %continue
case_C_107:;
JUMPFORWARD(TAG(), 9);
goto L_044F;
// 4904 c('l'): Language Flags = Tag; %continue
case_C_108:;
LANGUAGEFLAGS = TAG();
goto L_044F;
// 4905 c('m'): Call Monitor; %continue
case_C_109:;
CALLMONITOR();
goto L_044F;
// 4906 c('n'): Select(Tag); %continue
case_C_110:;
SELECT(TAG());
goto L_044F;
// 4907 c('o'): Event Trap(Tag); %continue
case_C_111:;
EVENTTRAP(TAG());
goto L_044F;
// 4908 c('p'): AssignParameter; %continue
case_C_112:;
ASSIGNPARAMETER();
goto L_044F;
// 4909
// 4910 c('r'): Resolve(Tag); %continue
case_C_114:;
RESOLVE(TAG());
goto L_044F;
// 4911
// 4912 c('t'): Jump Forward(Tag, TT); %continue
case_C_116:;
JUMPFORWARD(TAG(), 8);
goto L_044F;
// 4913 c('u'): Aop; %continue
case_C_117:;
AOP();
goto L_044F;
// 4914 c('v'): Modulus; %continue
case_C_118:;
MODULUS();
goto L_044F;
// 4915 c('w'): Machine Code; Forget Everything; %continue
case_C_119:;
MACHINECODE();
FORGETEVERYTHING();
goto L_044F;
// 4916 c('x'): Operation(REXPx); %continue
case_C_120:;
OPERATION(21);
goto L_044F;
// 4917 c('y'): Set CD(Tag, Diag); %continue
case_C_121:;
SETCD(TAG(), /*?*/ &DIAG);
goto L_044F;
// 4918 c('z'): Set CD(Tag, Control); %continue
case_C_122:;
SETCD(TAG(), /*?*/ &CONTROL);
goto L_044F;
// 4919 c('{'): Assemble(DefV,
case_C_123:;
ASSEMBLE(DEFV, BLOCKTYPE, VARS, LOCAL + 1, PARAMETERMODE);
// 4920+ Blocktype,
// 4921+ Vars,
// 4922+ Local+1,
// 4923+ Parameter Mode); %continue
goto L_044F;
// 4924
// 4925 c('}'): %exit %if Finish Params#0; %continue
case_C_125:;
if (FINISHPARAMS() == 0) goto L_045F;
goto L_045E;
L_045F:;
goto L_044F;
// 4926 c('~'): %exit %if Alternate format#0
case_C_126:;
if (ALTERNATEFORMAT() == 0) goto L_0460;
goto L_045E;
L_0460:;
// 4927 c(10):
case_C_10:;
// 4928 %repeat
L_044F:;
goto L_045C;
L_045E:;
// 4929
// 4930 %if Amode&8 = 0 %start
if (AMODE & 8 != 0) goto L_0461;
// 4931 Attributes = Attributes!Attr Inner Uses %if Frame Use(Local) # MyMark
if (FRAMEUSE[LOCAL - 128] == MYMARK) goto L_0462;
ATTRIBUTES = ATTRIBUTES | 1024;
L_0462:;
// 4932 Dcode(Dir End); Put((Frame+Alignment)&(\Alignment))
DCODE(7);
PUT(FRAME + 1 & (~1));
// 4933 Put(Parameter Frame)
PUT(PARAMETERFRAME);
// 4934 Put(SpSize)
PUT(SPSIZE);
// 4935 Put(Attributes)
PUT(ATTRIBUTES);
// 4936 Put(Code Base)
PUT(CODEBASE);
// 4937 Ocode(Obj End); Put(Event Bits)
OCODE(33);
PUT(EVENTBITS);
// 4938 %if Event Bits # 0 %start
if (EVENTBITS == 0) goto L_0463;
// 4939 Put(Event Label); Put(Event Body)
PUT(EVENTLABEL);
PUT(EVENTBODY);
// 4940 %finish
L_0463:;
// 4941 Forget Everything
FORGETEVERYTHING();
// 4942 Avar_Flags = Avar_Flags!Open
AVAR->FLAGS = AVAR->FLAGS | OPEN;
// 4943 %finish
L_0461:;
// 4944 Terminate Block
TERMINATEBLOCK();
// 4945 %return
return;
// 4946 !#if e(=true)
// 4947 C(*): Fail("Code ".ItoS(code))
case_C_default:;
FAIL(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("Code "), ({
__typeof__(_imp_string255) tmp; /*E*/
tmp = ITOS(CODE);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string63 *)&tmp;
})
);
// 4948 !#else(=false)
// 4949 {C(*): Fail("Code ".ItoS(Code,1))}
// 4950 !#fi
// 4951 %end
return;
case_C_dispatch:
if (C_index < 0 || C_index > 127)
_imp_signalf(6, 3, C_index, "->C(%d) out of bounds at %s line %d", C_index, C_file, C_line);
goto *C[C_index - 0];
} /* end of ASSEMBLE */
// 4952
// 4953
// 4954 Select Input(Icode); Readch(Pending)
_imp_SELECTINPUT(1);
READCH(/*?*/ &PENDING);
// 4955
// 4956 Var(0) = 0
VAR[0] = (struct VARFM){0};
// 4957
// 4958 %for J = R0, 1, AnyF %cycle
// %for J = 1, 1, 14 %cycle
{
J = 0;
L_0464:
if (J == 14) goto L_0465;
J += 1;
// 4959 Stack == RegV(J)
STACK = (struct STACKFM *)/*?*/ ®V[J - 1];
// 4960 Stack = 0
*STACK = (struct STACKFM){0};
// 4961 Stack_Base = J
STACK->BASE = J;
// 4962 Stack_Type = Integers; Stack_Type = Lreals %if J >= F0
STACK->TYPE = 1;
if (J < 10) goto L_0467;
STACK->TYPE = 4;
L_0467:;
// 4963 Stack_Form = VinR
STACK->FORM = 0;
// 4964 Stack_Format = 2
STACK->FORMAT = 2;
// 4965 %repeat
goto L_0464;
}
L_0465:;
// 4966 Stack == Null
STACK = (struct STACKFM *)NULL;
// 4967
// 4968 %for J = 1, 1, Max Stack Items %cycle
// %for J = 1, 1, 40 %cycle
{
J = 0;
L_0468:
if (J == 40) goto L_0469;
J += 1;
// 4969 Dasl == Stack Item(J)
DASL = (struct STACKFM *)/*?*/ &STACKITEM[J];
// 4970 Dasl_Using == Using
DASL->USING = (struct STACKFM *)USING;
// 4971 Using == Dasl
USING = (struct STACKFM *)DASL;
// 4972 %repeat
goto L_0468;
}
L_0469:;
// 4973 Using == Null
USING = (struct STACKFM *)NULL;
// 4974
// 4975 Knowing == Kasl
KNOWING = (struct DATAFM *)/*?*/ &KASL;
// 4976 %for J = 1, 1, Max Knowing %cycle
// %for J = 1, 1, 60 %cycle
{
J = 0;
L_046A:
if (J == 60) goto L_046B;
J += 1;
// 4977 Ktail == Known(J)
KTAIL = (struct DATAFM *)/*?*/ &KNOWN[J];
// 4978 Knowing_Link == Ktail
KNOWING->LINK = (struct DATAFM *)KTAIL;
// 4979 Knowing == Ktail
KNOWING = (struct DATAFM *)KTAIL;
// 4980 %repeat
goto L_046A;
}
L_046B:;
// 4981 Knowing == Null
KNOWING = (struct DATAFM *)NULL;
// 4982 Ktail_Link == Null
KTAIL->LINK = (struct DATAFM *)NULL;
// 4983
// 4984 Cc1_Reg = Cc Lhs; Cc2_Reg = Cc Rhs
CC1.REG = 15;
CC2.REG = 16;
// 4985
// 4986 %cycle
L_046C:;
// 4987 Select Output(Obj)
_imp_SELECTOUTPUT(2);
// 4988 Parms = Max Vars+1
PARMS = 1000 + 1;
// 4989 Perm Used(J) = 0 %for J = Signal&255, 1, ShiftR&255
// %for J = 1 & 255, 1, 2331 & 255 %cycle
{
int _initial = 1 & 255, _final = 2331 & 255;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1 & 255, 1, 2331 & 255");
J = _initial - (1);
L_046D:
if (J == _final) goto L_046E;
J += 1;
PERMUSED[J - 1] = 0;
goto L_046D;
}
L_046E:;
// 4990 Ilabel(J) <- Defined %for J = 1,1,50
// %for J = 1, 1, 50 %cycle
{
J = 0;
L_046F:
if (J == 50) goto L_0470;
J += 1;
ILABEL[J - 1] = (int)(32768);
goto L_046F;
}
L_0470:;
// 4991 Uses Display = 0
USESDISPLAY = 0;
// 4992 External Spec = Own Area
EXTERNALSPEC = 4;
// 4993 Event Count = 0
EVENTCOUNT = 0;
// 4994 Own Base = 0
OWNBASE = 0;
// 4995 Constant Base = 0
CONSTANTBASE = 0;
// 4996 Free Label = 0
FREELABEL = 0;
// 4997 Section = 0
SECTION = 0;
// 4998 Assemble(Var(0), -16, 0, 128, 0) {Var(0) is a dummy}
ASSEMBLE(/*?*/ &VAR[0], -16, 0, 128, 0);
// 4999 Select Output(Dir)
_imp_SELECTOUTPUT(3);
// 5000 Put(Own Base); Put(Constant Base); Put(Event Count)
PUT(OWNBASE);
PUT(CONSTANTBASE);
PUT(EVENTCOUNT);
// 5001 %exit %if Section = 0
if (SECTION != 0) goto L_0471;
goto L_0472;
L_0471:;
// 5002 Printch(Dir Section); Put Text(Section Id); Section Id = ""
PRINTCH(15);
PUTTEXT((_imp_string255 *)/*p*/ /*?*/ &SECTIONID);
_imp_strncpy(/*?*/ &SECTIONID, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 15);
// 5003 %repeat
goto L_046C;
L_0472:;
// 5004 Newline
_imp_NEWLINE();
// 5005 Ocode(Nl)
OCODE(10);
// 5006 ! *lm_4,15,16(10)
// 5007 ! *bcr_15,15
// 5008 %endofprogram
_imp_stop(0);
return 0;
end_0:;
}