%EXTERNALROUTINE ASSEMBLE(%STRING(63) PAR)
%ROUTINESPEC RLINE
%INTEGERFNSPEC COMPARE(%INTEGER PSP)
%ROUTINESPEC SS1
%ROUTINESPEC SS2
%ROUTINESPEC FAULT(%STRING(63) MESS)
%ROUTINESPEC PHEX(%INTEGER VAL)
%ROUTINESPEC PLINE
%ROUTINESPEC QSORT(%INTEGER A,B)
%STRING(63)%FNSPEC STRSP(%INTEGER N)
%SHORTINTEGERARRAY A(1:100)
%BYTEINTEGERARRAY T(1:100)
%RECORDFORMAT SYMFORM(%STRING(6) CH,%BYTEINTEGER FLAG,%SHORTINTEGER VAL)
%RECORDARRAY SYM(0:511)(SYMFORM)
%SHORTINTEGERARRAYFORMAT RAMF(0:2047)
%SHORTINTEGERARRAYNAME RAM
%SHORTINTEGERARRAYFORMAT DRAMF(0:255)
%SHORTINTEGERARRAYNAME DRAM
%INTEGER AP,TP,TPMAX,I,J,SYMP,FAULTS,RAMADDR,FLAG
%SHORTINTEGER CA
%EXTERNALROUTINESPEC DEFINE(%STRING(63) S)
%EXTERNALROUTINESPEC CLOSE STREAM(%INTEGER I)
%SYSTEMROUTINESPEC OUTFILE(%STRING(15) S,%INTEGER LENGTH,MAX,PROT, %C
 %INTEGERNAME CONAD,FLAG)
%STRING(63) SOURCE,LISTING,OBJECT
%CONSTSHORTINTEGERARRAY PS(-1000:-255)= %C
-997,   3,-973,-993,   1,   3,-959,   0,-988,   3,-926,-259,
-983,   1,   3,-913,-259,   0,-978,   1,-269,-259,-974,  48,
-265,-259,   0,-971,-949,-964,  79,  82,  71,   3,-669,-259,
-960,  69,  78,  68,   0,-957,-949,-950,  69,  81,  85,   3,
-669,-259,   0,-946,  68,  32,-943,  67,  32,-940,  84,  32,
-937,  66,  32,-934,  76,  32,-931,-446,  32,-927,  68,  67,
  32,   0,-924,-904,-918,  79,  82,  71,   3,-669,-914,  69,
  78,  68,   0,-911,-904,-905,  69,  81,  85,   3,-669,   0,
-899,  68,   3,-867,-817,-894,  67,   3,-811,-757,-889,  84,
   3,-751,-700,-883,  66,   3,-694,  44,-669,-879,  76,   3,
-654,-873,-446,   3,-435,  44,-275,-868,  68,  67,   3,-669,
   0,-864,  77,  82,-861,  77,  87,-858,  80,  87,-854,  73,
  78,  67,-850,  74,  65,  77,-847,  80,  67,-843,  67,  76,
  82,-839,  83,  87,  65,-835,  67,  87,  65,-830,  65,  76,
  82,  77,-826,  80,  79,  87,-822,  80,  50,  74,-818,  80,
  50,  78,   0,-813,  43,-867,-817,-812,   0,-808,  77,  82,
-805,  77,  87,-802,  80,  87,-798,  77,  80,  89,-794,  68,
  73,  86,-790,  82,  80,  84,-786,  83,  82,  49,-782,  83,
  76,  49,-779,  67,  73,-776,  67,  79,-772,  83,  85,  84,
-768,  67,  85,  84,-764,  84,  85,  84,-761,  83,  66,-758,
  67,  66,   0,-753,  43,-811,-757,-752,   0,-746,  70,  65,
  83,  84,-742,  65,  84,  78,-737,  65,  82,  83,  84,-732,
  67,  65,  84,  78,-727,  83,  78,  71,  76,-724,  85,  84,
-719,  77,  65,  76,  70,-715,  80,  80,  70,-712,  68,  67,
-708,  68,  82,  68,-704,  77,  83,  75,-701,  79,  80,   0,
-696,  43,-751,-700,-695,   0,-692,   2,-688,  67,  84,  82,
-683,-682,-673,-673,-673,   0,-680,  67,-678,  86,-676,  71,
-674,  76,   0,-671,-682,-670,   0,-664,  76,  40,   1,  41,
-659,  72,  40,   1,  41,-657,   2,-655,   1,   0,-649,-644,
  44,-571,-508,-645,-435,  44,-669,   0,-640,  82,  65,  72,
-636,  77,  82,  48,-632,  82,  65,  76,-628,  77,  82,  49,
-624,  80,  83,  87,-620,  77,  82,  50,-616,  76,  79,  67,
-612,  70,  76,  82,-608,  77,  65,  82,-604,  83,  82,  72,
-600,  83,  82,  76,-597,  65,  82,-594,  73,  82,-590,  77,
  68,  82,-587,  73,  79,-583,  67,  84,  82,-580,  89,  83,
-575,  89,  68,  80,  49,-572,  89,  68,   0,-567,  77,  82,
  48,-563,  77,  82,  49,-559,  77,  82,  50,-555,  76,  79,
  67,-551,  80,  83,  87,-547,  77,  65,  82,-543,  83,  82,
  72,-539,  83,  82,  76,-534,  78,  85,  76,  76,-530,  73,
  82,  52,-526,  77,  68,  82,-523,  73,  79,-520,  73,  82,
-517,  89,  83,-512,  89,  68,  80,  49,-509,  89,  68,   0,
-504,  44,-502,-452,-503,   0,-499,  83,  76,-496,  83,  82,
-493,  67,  83,-490,  78,  67,-487,  67,  73,-484,  67,  79,
-480,  67,  77,  68,-475,  68,  67,  65,  75,-470,  65,  68,
  82,  83,-467,  68,  65,-465,  67,-461,  65,  67,  75,-458,
  68,  82,-453,  83,  84,  65,  84,   0,-448,  43,-502,-452,
-447,   0,-444,  79,-442,  78,-440,  88,-438,  65,-436,  83,
   0,-431,  82,  65,  72,-427,  77,  82,  48,-423,  82,  65,
  76,-419,  77,  82,  49,-415,  80,  83,  87,-411,  77,  82,
  50,-407,  76,  79,  67,-403,  70,  76,  82,-399,  77,  65,
  82,-395,  83,  82,  72,-391,  83,  82,  76,-388,  65,  82,
-385,  73,  82,-381,  77,  68,  82,-377,  67,  84,  82,-374,
  89,  83,-369,  89,  68,  80,  49,-366,  89,  68,   0,-361,
  77,  82,  48,-357,  77,  82,  49,-353,  77,  82,  50,-349,
  76,  79,  67,-345,  80,  83,  87,-341,  77,  65,  82,-337,
  83,  82,  72,-333,  83,  82,  76,-328,  78,  85,  76,  76,
-324,  73,  82,  52,-320,  77,  68,  82,-317,  73,  82,-314,
  89,  83,-309,  89,  68,  80,  49,-306,  89,  68,   0,-301,
  44,-299,-281,-300,   0,-296,  78,  67,-293,  67,  73,-290,
  67,  79,-288,  67,-285,  78,  70,-282,  78,  65,   0,-277,
  43,-299,-281,-276,   0,-272,-365,-305,-270,-669,   0,-267,
  42,-266,   0,-261,  40,   2,  41,-260,   0,-257,  32,-255,
  10,   0
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%UNLESS PAR->SOURCE.(',').PAR %THEN SOURCE=PAR %AND OBJECT='' %AND %C
  LISTING='' %ELSE %START
 %UNLESS PAR->OBJECT.(',').LISTING %THEN OBJECT=PAR %AND LISTING=''
%FINISH
%IF SOURCE='' %THEN SOURCE='.TT'
%IF OBJECT='' %THEN OBJECT='SS#RAM'
%IF LISTING='' %THEN LISTING='SS#LIST'
DEFINE('STREAM01,'.SOURCE)
SELECT INPUT(1)
DEFINE('STREAM02,'.LISTING)
SELECT OUTPUT(2)
SET MARGINS(2,1,132)
SYMP=1
FAULTS=0
%CYCLE I=0,1,511
 SYM(I)_CH=''
 SYM(I)_VAL=0
 SYM(I)_FLAG=0
%REPEAT
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
CA=0
%CYCLE
 RLINE
 %IF T(1)#'*' %THEN %START
  TP=1
  TPMAX=1
  AP=1
  %IF COMPARE(-1000)#0 %THEN %START
   %IF A(1)=1 %AND A(2)=3 %THEN %EXIT %ELSE SS1
  %FINISH
 %FINISH
%REPEAT
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! 
OUTFILE(OBJECT,8192,8192,0,RAMADDR,FLAG)
%IF FLAG#0 %THEN PRINT STRING('
OUTFILE ON '.OBJECT.' FAILS') %AND WRITE(FLAG,1) %AND %STOP
I=RAMADDR+INTEGER(RAMADDR+4)
RAM==ARRAY(I,RAMF)
DRAM==ARRAY(I+4096,DRAMF)
SELECT INPUT(0)
CLOSE STREAM(1)
SELECT INPUT(1)
SELECT INPUT(1)
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
NEWPAGE
CA=0
%CYCLE
 RLINE
 %IF T(1)='*' %THEN SPACES(16) %AND PLINE %ELSE %START
  TP=1
  TPMAX=1
  AP=1
  %IF COMPARE(-992)#0 %THEN %START
   %IF A(1)=1 %AND A(2)=3 %THEN %EXIT %ELSE SS2
  %FINISH %ELSE SPACES(16) %AND PLINE %AND  %C
    FAULT('SYNTAX ?'.STRSP(TPMAX+2).'!')
 %FINISH
%REPEAT
PHEX(CA)
SPACES(12)
PLINE
NEWPAGE
%CYCLE I=0,1,255
 DRAM(I)=0
 PHEX(I)
 SPACES(4)
 RLINE
 TP=1
 TPMAX=1
 AP=1
 %IF COMPARE(-982)=0 %THEN SPACES(8) %AND PLINE %AND %C
   FAULT('SYNTAX ?') %ELSE %START
  %IF A(1)=1 %THEN %START
   %IF SYM(A(2))_FLAG=0 %THEN SPACES(8) %AND PLINE %C
      %AND FAULT(SYM(A(2))_CH.' NOT DEFINED') %ELSE %START
    %IF SYM(A(2))_VAL&X'F800'#0 %THEN SPACES(8) %AND %C
      PLINE %AND FAULT(SYM(A(2))_CH.' VALUE TOO BIG')
    DRAM(I)=SYM(A(2))_VAL&X'7FF'
    %IF A(3)=1 %THEN DRAM(I)=DRAM(I)!X'800'
    PHEX(DRAM(I))
    SPACES(4)
    PLINE
   %FINISH
  %FINISH %ELSE %START
   PHEX(0)
   SPACES(4)
   PLINE
   %IF A(2)=1 %THEN %START
    %IF A(3)<=0 %OR A(3)+I>256%THEN FAULT('REPETITION VALUE INVALID')%C
      %ELSE %START
     %WHILE A(3)>1 %THEN I=I+1 %AND PHEX(I) %AND SPACES(4) %AND %C
      PHEX(0) %AND NEWLINE %AND A(3)=A(3)-1
    %FINISH
   %FINISH
  %FINISH
 %FINISH
%REPEAT
SYMP=0
%CYCLE I=0,1,511
 %IF SYM(I)_CH#'' %THEN SYM(SYMP)=SYM(I) %AND SYMP=SYMP+1
%REPEAT
%IF SYMP>0 %THEN %START
 QSORT(0,SYMP-1)
 NEWPAGE
 J=0
 %CYCLE I=0,1,SYMP-1
  PRINT STRING(SYM(I)_CH.STRSP(8-LENGTH(SYM(I)_CH)))
  %IF SYM(I)_FLAG=0 %THEN PRINT STRING('****') %ELSE PHEX(SYM(I)_VAL)
  J=J+1
  %IF J=6 %THEN NEWLINE %AND J=0 %ELSE SPACES(6)
 %REPEAT
%FINISH
NEWPAGE
WRITE(FAULTS,1)
PRINT STRING(' FAULTS IN MICRO-PROGRAM
')
%STOP
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE RLINE
 %CYCLE TP=1,1,100
  READ SYMBOL(T(TP))
  %IF T(TP)=NL %THEN %EXIT
 %REPEAT
%IF TP=1 %THEN RLINE
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN COMPARE(%INTEGER PSP)
! ANALYSE PHRASE
%INTEGERFNSPEC NAME              ;! BUILT-IN PHRASE <NAME>
%INTEGERFNSPEC CNST              ;! BUILT-IN PHRASE <CNST>
%INTEGER APP,TPP,AE,N
TPP=TP                           ;! PRESERVE INITIAL TEXT POINTER
APP=AP                           ;! PRESERVE INITIAL ANAL REC PTR
A(AP)=1                          ;! ALTERNATIVE NO
%CYCLE                           ;! FOR EACH ALTERNATIVE
 AE=PS(PSP)
 PSP=PSP+1
 %CYCLE                          ;! FOR EACH ITEM
  %IF PSP=AE %THEN %RESULT=1  ;! SUCCESS
  N=PS(PSP)
  PSP=PSP+1
  %IF N<0 %THEN %START             ;! SUB-PHRASE
   AP=AP+1
   %IF AP>100 %THEN FAULT('ANALYSIS RECORD FULL') %AND %STOP
   %IF COMPARE(N)=0 %THEN %EXIT
  %FINISH %ELSE %START
   %IF N=1 %THEN %START
    %IF NAME=0 %THEN %EXIT
   %FINISH %ELSE %START
    %IF N=2 %THEN %START
     %IF CNST=0 %THEN %EXIT
    %FINISH %ELSE %START
     %IF N=3 %THEN %START    ;! <SPS>
      %IF T(TP)#' ' %THEN %EXIT
      TP=TP+1 %WHILE T(TP)=' '
     %FINISH %ELSE %START
      %IF N=T(TP) %THEN TP=TP+1 %ELSE %EXIT
     %FINISH
    %FINISH
   %FINISH
  %FINISH
 %REPEAT
 %IF TP>TPMAX %THEN TPMAX=TP
 %IF PS(AE)=0 %THEN %RESULT=0     ;! FAILURE
 PSP=AE
 TP=TPP                           ;! BACKTRACK
 AP=APP
 A(AP)=A(AP)+1
%REPEAT
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN NAME
! RECOGNISE NAME
%INTEGER CH,I,NAM0,HASH
%STRING(6) NAM
%UNLESS 'A'<=T(TP)<='Z' %THEN %RESULT=0    ;! FAILURE
NAM0=ADDR(NAM)
INTEGER(NAM0)=0
BYTE INTEGER(NAM0+1)=T(TP)
TP=TP+1
%CYCLE I=2,1,6
 CH=T(TP)
 %UNLESS 'A'<=CH<='Z' %OR '0'<=CH<='9' %THEN I=I-1 %AND %EXIT
 BYTE INTEGER(NAM0+I)=CH
 TP=TP+1
%REPEAT
BYTE INTEGER(NAM0)=I
HASH=INTEGER(NAM0)-INTEGER(NAM0)//509*509
I=HASH
%CYCLE
 %IF SYM(I)_CH='' %THEN SYM(I)_CH=NAM %AND %EXIT
 %IF SYM(I)_CH=NAM %THEN %EXIT
 I=(I+1)&X'1FF'
 %IF I=HASH %THEN FAULT('SYMBOL DICTIONARY FULL') %AND %STOP
%REPEAT
AP=AP+1
%IF AP>100 %THEN FAULT('ANALYSIS RECORD FULL') %AND %STOP
A(AP)=I
%RESULT=1                        ;! SUCCESS
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN CNST
! RECOGNISE AND EVALUATE CONSTANT
%INTEGER I,VAL,CH
%IF T(TP)='X' %AND T(TP+1)='''' %THEN %START
 TP=TP+2
 VAL=0
 %CYCLE I=0,1,9
  CH=T(TP)
  TP=TP+1
  %IF CH='''' %THEN %EXIT
  %IF '0'<=CH<='9' %THEN VAL=VAL<<4!(CH-'0') %ELSE %START
   %UNLESS 'A'<=CH<='F' %THEN %RESULT=0
   VAL=VAL<<4!(CH-'A'+10)
  %FINISH
 %REPEAT
 %IF I=0 %OR I>4 %THEN %RESULT=0
%FINISH %ELSE %START
 %UNLESS '0'<=T(TP)<='9' %THEN %RESULT=0 ;! NOT A CONSTANT
 VAL=T(TP)-'0'
 TP=TP+1
 %CYCLE I=2,1,9
  CH=T(TP)
  %UNLESS '0'<=CH<='9' %THEN %EXIT
  VAL=VAL*10+CH-'0'
  TP=TP+1
 %REPEAT
 %IF VAL>65535 %THEN %RESULT=0
%FINISH
AP=AP+1
%IF AP>100 %THEN FAULT('ANALYSIS RECORD FULL') %AND %STOP
A(AP)<-VAL                          ;! FILL IN VALUE OF CONSTANT
%RESULT=1                           ;! SUCCESS
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE SS1
%INTEGERFNSPEC VAL(%INTEGER AP,%SHORTINTEGERNAME DEST)
%INTEGER FLAG
%IF A(1)=1 %THEN %START
 %IF A(2)=1 %THEN CA=CA+1 %ELSE FLAG=VAL(3,CA)
%FINISH %ELSE %START
 %IF SYM(A(2))_FLAG=1 %THEN FAULT(SYM(A(2))_CH.' DEFINED TWICE')
 %IF A(3)=1 %THEN SYM(A(2))_VAL=CA %AND %C
    CA=CA+1 %AND SYM(A(2))_FLAG=1 %ELSE %START
  %IF VAL(4,SYM(A(2))_VAL)#0 %THEN SYM(A(2))_FLAG=1
 %FINISH
%FINISH
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN VAL(%INTEGER AP,%SHORTINTEGERNAME DEST)
%INTEGER NAM
%IF A(AP)=3 %THEN DEST=A(AP+1) %AND %RESULT=1
NAM=A(AP+1)
%IF SYM(NAM)_FLAG=0 %THEN FAULT(SYM(NAM)_CH.' USED BEFORE DEFINED') %C
  %AND %RESULT=0
%IF A(AP)=1 %THEN DEST=SYM(NAM)_VAL&X'FF' %AND %RESULT=1
%IF A(AP)=2 %THEN DEST=SYM(NAM)_VAL>>8 %AND %RESULT=1
DEST=SYM(NAM)_VAL
%RESULT=1
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE SS2
%INTEGER I,J,INSTR,COND,CH
%SHORTINTEGER V
%ROUTINESPEC DUMP(%INTEGER INSTR)
%INTEGERFNSPEC VAL(%INTEGER AP,%SHORTINTEGERNAME DEST)
%SWITCH MOP(1:7)
%CONSTSHORTINTEGERARRAY DF(1:13)=X'802',X'402',X'C02',X'202',X'102',
  X'082',X'042',X'022',X'012',X'00A',X'003',X'BC2',X'AC2'
%CONSTSHORTINTEGERARRAY CF(1:15)=X'800',X'400',X'C00',X'303',X'281',
  X'240',X'100',X'080',X'002',X'001',X'020',X'010',X'030',X'008',X'004'
%CONSTSHORTINTEGERARRAY TF(1:12)=X'800',X'400',X'200',X'100',X'080',
  X'040',X'020',X'010',X'008',X'004',X'002',X'001'
%CONSTSHORTINTEGERARRAY CC(1:4)=X'800',X'400',X'200',X'100'
%CONSTSHORTINTEGERARRAY LD(1:19)=X'000',X'000',X'100',X'100',X'200',
  X'200',X'300',X'400',X'500',X'600',X'700',X'800',X'900',X'A00',
  X'B00',X'C00',X'D00',X'F00',X'E00'
%CONSTBYTEINTEGERARRAY LS(1:16)=X'00',X'10',X'20',X'30',X'40',
  X'50',X'60',X'70',X'80',X'C0',X'A0',X'B0',X'90',X'D0',X'F0',X'E0'
%CONSTBYTEINTEGERARRAY LX(1:14)=8,4,12,0,2,1,3,0,1,2,3,1,2,3
%CONSTSHORTINTEGERARRAY ID(1:18)=X'000',X'000',X'100',X'100',X'200',
  X'200',X'300',X'400',X'500',X'600',X'700',X'800',X'900',X'A00',
  X'C00',X'D00',X'F00',X'E00'
%CONSTBYTEINTEGERARRAY IS(1:15)=X'00',X'10',X'20',X'30',X'40',X'50',
  X'60',X'70',X'80',X'C0',X'A0',X'90',X'D0',X'F0',X'E0'
%CONSTBYTEINTEGERARRAY IX(1:6)=0,2,1,3,0,8
%IF A(1)=2 %AND A(3)=2 %THEN SPACES(16) %AND PLINE %AND %RETURN  ;! EQU
%IF A(1)=1 %AND A(2)=2 %THEN %START    ;! ORG
 NEWPAGE
 SPACES(16)
 PLINE
 I=CA
 %IF VAL(3,CA)=0 %THEN FAULT('ORG VALUE UNKNOWN') %ELSE %START
  %IF CA<I %THEN FAULT('ORG VALUE TOO LOW') %ELSE %START
   %WHILE I<CA %THEN RAM(I)=0 %AND I=I+1
  %FINISH
 %FINISH
 %RETURN
%FINISH
%IF A(1)=1 %THEN AP=3 %ELSE AP=4    ;! ON <MOP>
->MOP(A(AP))
MOP(1):! DO
INSTR=0
INSTR=INSTR!DF(A(AP+1)) %AND AP=AP+2 %UNTIL A(AP)=2
DUMP(INSTR)
%RETURN
MOP(2):! COMMAND
INSTR=X'1000'
INSTR=INSTR!CF(A(AP+1)) %AND AP=AP+2 %UNTIL A(AP)=2
DUMP(INSTR)
%RETURN
MOP(3):! TEST
INSTR=X'2000'
INSTR=INSTR!TF(A(AP+1)) %AND AP=AP+2 %UNTIL A(AP)=2
DUMP(INSTR)
%RETURN
MOP(4):! BRANCH
I=A(AP+1)
%IF I=1 %THEN %START
 COND=A(AP+2)
 %IF COND&X'FFFFFF00'#0 %THEN DUMP(X'3000') %AND  %C
   FAULT('INVALID CONDITION CODE') %AND %RETURN
 COND=COND<<8
 AP=AP+3
%FINISH %ELSE %START
 %IF I=2 %THEN COND=0 %AND AP=AP+2 %ELSE %START
  COND=CC(A(AP+2))
  AP=AP+3
  %CYCLE I=3,-1,1
   %IF A(AP)=2 %THEN AP=AP+I %AND %EXIT
   COND=COND!CC(A(AP+1))
   AP=AP+2
  %REPEAT
 %FINISH
%FINISH
%IF VAL(AP,V)=0 %THEN DUMP(X'3000'!COND) %AND %C
  FAULT('DESTINATION UNKNOWN') %ELSE %START
 DUMP(X'3000'!COND!V&X'FF')
 %IF A(AP)=4 %AND V>>8#CA>>8 %THEN FAULT('BRANCH OUT OF CODE BLOCK ?')
%FINISH
%RETURN
MOP(5):! LOAD
%IF A(AP+1)=1 %THEN %START
 INSTR=X'4000'!LD(A(AP+2))!LS(A(AP+3))
 AP=AP+4
 %IF A(AP)=2 %THEN %START
  %UNLESS INSTR&X'F00'=X'B00' %OR INSTR&X'F0'=X'B0' %THEN INSTR=INSTR!3
 %FINISH %ELSE %START
  INSTR=INSTR!LX(A(AP+1)) %AND AP=AP+2 %UNTIL A(AP)=2
 %FINISH
 DUMP(INSTR)
%FINISH %ELSE %START
 INSTR=X'5000'!ID(A(AP+2))
 %IF VAL(AP+3,V)=0 %THEN DUMP(INSTR) %AND FAULT('LOAD VALUE UNKNOWN') %C
   %ELSE %START
  DUMP(INSTR!V&X'FF')
  %IF V&X'FFFFFF00'#0 %THEN FAULT('LOAD VALUE TOO BIG')
 %FINISH
%FINISH
%RETURN
MOP(6):! ARITHMETICS
INSTR=(A(AP+1)+2)<<13!ID(A(AP+2))
%IF A(AP+3)=1 %THEN %START
 INSTR=INSTR!IS(A(AP+4))
 AP=AP+5
 %IF A(AP)=2 %THEN INSTR=INSTR!7 %ELSE %START
  INSTR=INSTR!IX(A(AP+1)) %AND AP=AP+2 %UNTIL A(AP)=2
 %FINISH
 DUMP(INSTR)
%FINISH %ELSE %START
 INSTR=INSTR!X'1000'
 %IF VAL(AP+4,V)=0 %THEN DUMP(INSTR) %AND %C
   FAULT('IMMEDIATE VALUE UNKNOWN') %ELSE %START
  DUMP(INSTR!V&X'FF')
  %IF V&X'FFFFFF00'#0 %THEN FAULT('IMMEDIATE VALUE TOO BIG')
 %FINISH
%FINISH
%RETURN
MOP(7):! DC
%IF VAL(AP+1,V)=0 %THEN DUMP(0) %AND FAULT('VALUE UNKNOWN') %C
  %ELSE DUMP(V&X'FF')
%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE DUMP(%INTEGER INSTR)
RAM(CA)<-INSTR
PHEX(CA)
CA=CA+1
SPACES(4)
PHEX(INSTR)
SPACES(4)
PLINE
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN VAL(%INTEGER AP,%SHORTINTEGERNAME DEST)
%INTEGER NAM
%IF A(AP)=3 %THEN DEST=A(AP+1) %AND %RESULT=1
NAM=A(AP+1)
%IF SYM(NAM)_FLAG=0 %THEN %RESULT=0
%IF A(AP)=1 %THEN DEST=SYM(NAM)_VAL&X'FF' %AND %RESULT=1
%IF A(AP)=2 %THEN DEST=SYM(NAM)_VAL>>8 %AND %RESULT=1
DEST=SYM(NAM)_VAL
%RESULT=1
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE FAULT(%STRING(63) MESS)
PRINT STRING('**** '.MESS.'
')
FAULTS=FAULTS+1
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE PHEX(%INTEGER VAL)
%OWNBYTEINTEGERARRAY H(0:15)='0','1','2','3','4','5','6','7','8',
  '9','A','B','C','D','E','F'
%INTEGER I
%CYCLE I=12,-4,0
 PRINT SYMBOL(H(VAL>>I&X'F'))
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE PLINE
TP=0
TP=TP+1 %AND PRINT SYMBOL(T(TP)) %UNTIL T(TP)=NL
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE QSORT(%INTEGER A,B)
%INTEGER L,U
%RECORD T(SYMFORM)
%IF A>=B %THEN %RETURN
L=A-1
U=B
T=SYM(U)
%CYCLE
UP:L=L+1
 %IF L=U %THEN %EXIT
 %IF SYM(L)_CH<=T_CH %THEN ->UP
 SYM(U)=SYM(L)
DOWN:U=U-1
 %IF U=L %THEN %EXIT
 %IF SYM(U)_CH>=T_CH %THEN ->DOWN
 SYM(L)=SYM(U)
%REPEAT
SYM(U)=T
QSORT(A,L-1)
QSORT(U+1,B)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%STRING(63)%FN STRSP(%INTEGER N)
%STRING(63) S
S=''
%WHILE N>0 %THEN S=S.' ' %AND N=N-1
%RESULT=S
%END
%END
%ENDOFFILE