C     MODEL PROGRAM - WRITTEN BY FRED S. PARMENTER AND DOVID KASHNOW  5/8/79
C
C     IF YOU HAVE ANY QUESTIONS CONTACT FRED S. PARMENTER AT:
C     MASSACHUSETTS COLLEGE OF PHARMACY
C     179 LONGWOOD AVE
C     BOSTON MASS 02115
C     617-732-2926
C


HERE IS SOME MORE INFORMATION WHICH MIGHT PROVE HELPFUL:


MODEL IS A PROGRAM WHICH IS USED TO EMULATE AN 8080 MICRO PROCESSOR
THIS PROGRAM EMULATES A MICRO WITH 2K OF ROM AND 1K OF RAM
WITH ADDRESS LOCATIONS AS FOLLOWS: ROM 0000 - 03FF  /  RAM 3C00 - 3FFF

ALSO, THE ROM LOCATIONS HAVE BEEN LOADED WITH THE STANDARD INTEL 8080
MONITOR WHICH ACCEPTS COMMANDS OF D,X,I,S,M ETC.  THIS MONITOR USES
RAM LOCATIONS 3C00 - 3C3F, SO IT IS ADVISED THAT USERS PROGRAMS CONFINE
THEIR RAM REQUIREMENTS TO THOS LOCATIONS ABOVE 3C40.

THE WAY YOU GET CHARACTERS INTO THE MICRO IS BY EXECUTING THE STANDARD
'IN' INSTRUCTION : IN TTY.  THE MODEL PROGRAM WILL GIVE THE MICRO
THEN A CHARACTER FROM ONE OF THREE PLACES:  (IN ORDER)

  1.  FROM AN OPENED FILE IF THAT FILE HAS BEEN DECLARED IN THE COMMAND
      LINE AND UP TO THE END OF THAT FILE, NEXT
  2.  FROM THE NEXT CHARACTERS IN A COMMAND FILE IF THAT OPTION HAS BEEN
      DECLARED IN THE COMMAND LINE (UP TO A 'Q' FOUND IN THAT FILE), AND
  3.  LASTLY FROM THE TERMINAL UP UNITL THE POINT A USER TYPES 'Q'
      WHICH WILL CANCEL THE PROGRAM.

THE FORM OF THE COMMAND LINE IS: OK, MODEL [FILNAM] [-CMFILE]
IF FILNAM IS SPECIFIED IT IS OPENED AND 'TERMINAL' INPUT COMES FROM THERE.
IF -CMFILE (LITERALLY TYPED THAT WAY) IS GIVEN THEN THE MODEL PROGRAM KNOWS
THAT YOU ARE RUNNING INSIDE OF A COMMAND FILE, SO THAT AT THE END OF READING
FILNAM (IF READING IT AT ALL), ALL DATA WILL BE TAKEN FROM THE COMMAND FILE.
ONCE A 'Q' IS FOUND IN THE COMMAND FILE, INPUT SWITHES TO THE
TERMINAL PERMENANTELY.

THE MICRO HAS THE ABILITY TO SENSE IF A CHARACTER IS ON THE INPUT BUFFER
BY DOING AN 'IN' OF THE TRANSMITTER STATUS PORT.  THE MODEL PROGRAM ALWAYS
FORCES A READY STATUS WHEN INPUT IS COMING FROM THE FILE OR A COMMAND
FILE, BUT NOT THE TERMINAL. A PMA ROUTINE IS USED TO SEE IF THERE IS A CHARACTER
AT THE TERMINAL WITHOUT ACTUALLY READING IT IN.

WHAT FOLLOWS IS SOME DOCUMENTATION ABOUT THE PROGRAM'S COMPILATION
ACCOMPANIED WITH SOME PRACTICE RUNS.

IF YOU EVER WANT TO GET OUT OF A HUNG UP PROGRAM, JUST CONTROL P, AND THEN
TYPE S 1000 AND THE MODEL PROGRAM WILL BEGIN AGAIN , BUT WITHOUT DESTROYING
WHAT YOU HAVE PUT IN MEMORY.  THIS TECHNIQUE CAN BE HANDY TO TURN ON THE
TRACE SWITCH WHEN IT WAS OFF ORIGINALLY.

IF YOU ANSWER YES TO THE TRACE QUESTION THE VALUES OF ALL THE REGISTERS
PRIOR TO THE LISTED PC WILL BE DISPLAYED.  YPOU WILL BE ASKED BETWEEN WHAT
TWO LIMITS OF PC VALUES YOU WISH TO SEE THE TRACE.   SOME EXAMPLES FOLLOW.
NOW MODEL4 WILL BE COMPILED

OK, LFTN MODEL4
GO
0000 ERRORS [<.MAIN.>FTN-REV15.3]
0000 ERRORS [<OP    >FTN-REV15.3]
0000 ERRORS [<IOK   >FTN-REV15.3]
0000 ERRORS [<MINUS1>FTN-REV15.3]
0000 ERRORS [<PLUS1 >FTN-REV15.3]
0000 ERRORS [<IO    >FTN-REV15.3]
0000 ERRORS [<TESTS >FTN-REV15.3]
0000 ERRORS [<ADD   >FTN-REV15.3]
0000 ERRORS [<INTASC>FTN-REV15.3]
0000 ERRORS [<CONVRT>FTN-REV15.3]
0000 ERRORS [<ASCINT>FTN-REV15.3]
0000 ERRORS [<DUMP  >FTN-REV15.3]
0000 ERRORS [<.DATA.>FTN-REV15.3]
0000 ERRORS [<INIT  >FTN-REV15.3]
0000 ERRORS [<MESS  >FTN-REV15.3]

NOW MODEL4 WILL BE LOADED

OK, CO C_MOD
OK, FILMEM ALL
GO

OK, LOAD
GO
$ COMMON 34000
$ LO B_MODEL
$ LO B_STAT
$ AT SRC15 1
$ AT MCPLIB 0 2
$ LO B_RDTKS
$ LO B_OF1
$ LO B_RDIN
$ LO B_CL$
$ LIB
LOAD COMPLETE
$ MA 3


$ MA 1
*START  001000    *LOW    000074    *HIGH   033777    *PBRK   025522
*CMLOW  025725    *CMHGH  033777    *SYM    000163    *UII    000005

$ SAVE *MODEL
$ QUIT

OK, SAVE *MODEL 200 34000 1000 0 0 0 4000

AND NOW COPIED TO OUR UFDS

OK, FUTIL
GO
> T CMDNC0
> C *MODEL *MODEL
> T *PRGMS 1
> C *MODEL
> DELETE *MODEL
> Q

OK, CO TTY

NOW LET'S TRY A TEST OF IT

OK, MODEL
GO
TRACE? N
THE MICRO HAS BEEN INITALIZED AS FOLLOWS:
MEMORY LOCATIONS 0000 - 07FF HAVE BEEN FILLED WITH THE ROM VALUES
MEMORY LOCATIONS 3C00 - 3FFF HAVE BEEN FILLED WITH ZEROS EXCEPT THAT [ 3C3D ] = CF AND [ 3C3E ] = C9
THE OTHER REGISTERS HAVE BEEN SET TO:
OUT TO  PORT ED: CFOUT TO  PORT ED: 25
SBC 80P MONITOR
.XS 3C02-3D00
.X
A=00 B=00 C=00 D=00 E=00 F=02 H=00 L=00 M=0000 P=0000 S=3D00 
.I3E00
3E4FD3ECC3003E
.D3E00,3E0F

3E00 3E 4F D3 EC C3 00 3E 00 00 00 00 00 00 00 00 00
.G3E00
OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO

THE PROGRAM STARTED OUTPUTTING AN ENDLESS STREAM OF ZEROS AS A RESULT OF
THE PROGRAM I MANUALLY LOADED STARTING AT 3D00:
  3D00  SET A EQUAL TO '0'      (3E 4F)
        OUTPUT TO THE TERMINAL  (D3 EC)
        JUMP BACK TO START      (C3 00 3E)

I CONTROL P ED TO GET TO THE EXECUTIVE LEVEL FOR A RESTART

OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
QUIT,
S 1000
GO
TRACE? N
RESTART IN PROGRESS: PC COUNTER IS CURRENTLY 3E00
ENTER NEW PC VALUE: 0000
OUT TO  PORT ED: CFOUT TO  PORT ED: 25
SBC 80P MONITOR
.X
A=00 B=00 C=00 D=00 E=00 F=02 H=00 L=00 M=0000 P=3E00 S=3C02 
.XS 3C02-3D00
.D3E00,3E0F

3E00 3E 4F D3 EC C3 00 3E 00 00 00 00 00 00 00 00 00
.

NOTICE MY PROGRAM HAS NOT BEEN LOST, AND NO INITIALIZATION OF RAM TOOK PLACE

NOW AN ILLUSTRATION OF HOW TO LOAD A PREVIOUSLY COMPILED FILE INTO THE
RAM OF THE MODEL PROGRAM:

HERE IS THE PROGRAM WHICH NEEDS TO BE COMPILED:


OK, SLIST INIT
GO
         ORG      H3C40
         LXI H    LEND
BEGIN    MVI A    H0
         MOV M,A
         MOV A,H
         CPI      H40
         JNC      LINIT
         INX H
         JMP      LBEGIN
INIT     MVI A    HFF
         STA      H3FFF
*
* PORTS E4, E5 AND E6 ARE INITIALIZED BY SENDING 8B TO PORT E7
*       THIS SETS E4 - OUTPUT - PANEL DIGITS 1 AND 2
*                 E5 - INPUT  - SWITCHES 9 - 16
*                 E6 - INPUT  - SWITCHES 1 - 8
*
* PORTS E8, E9 AND EA ARE INITIALIZED BY SENDING 80 TO PORT EB
*       THIS SETS E8 - OUTPUT - PANEL DIGITS 3 AND 4
*                 E9 - OUTPUT - LEDS 9 - 16
*                 EA - OUTPUT - LEDS 1 - 8
*
         MVI A    H8B
         OUT      HE7
         MVI A    H80
         OUT      HEB
         EI
END      NOP
         END

NOW I WILL COMPILE IT

OK, A8080 INIT
GO
0000
   0 ERRORS
ASSEMBLY COMPLETED (DCK ** REV 9)

DO YOU WANT A LISTING FILE?
DO YOU WANT THE SYMBOL TABLE PRINTED?
WITH THE 43 INTEL ROUTINES?

OK, SLIST L_INIT
GO
           1                          ORG      H3C40
3C40       2     215E3C               LXI H    LEND
3C43       3     3E00        BEGIN    MVI A    H0
3C45       4     77                   MOV M,A
3C46       5     7C                   MOV A,H
3C47       6     FE40                 CPI      H40
3C49       7     D2503C               JNC      LINIT
3C4C       8     23                   INX H
3C4D       9     C3433C               JMP      LBEGIN
3C50      10     3EFF        INIT     MVI A    HFF
3C52      11     323FFF               STA      H3FFF
          12                 *
          13                 * PORTS E4, E5 AND E6 ARE INITIALIZED BY SENDING 8B TO PORT E7
          14                 *       THIS SETS E4 - OUTPUT - PANEL DIGITS 1 AND 2
          15                 *                 E5 - INPUT  - SWITCHES 9 - 16
          16                 *                 E6 - INPUT  - SWITCHES 1 - 8
          17                 *
          18                 * PORTS E8, E9 AND EA ARE INITIALIZED BY SENDING 80 TO PORT EB
          19                 *       THIS SETS E8 - OUTPUT - PANEL DIGITS 3 AND 4
          20                 *                 E9 - OUTPUT - LEDS 9 - 16
          21                 *                 EA - OUTPUT - LEDS 1 - 8
          22                 *
3C55      23     3E8B                 MVI A    H8B
3C57      24     D3E7                 OUT      HE7
3C59      25     3E80                 MVI A    H80
3C5B      26     D3EB                 OUT      HEB
3C5D      27     FB                   EI
3C5E      28     00          END      NOP
          29                          END
   0 ERRORS
ASSEMBLY COMPLETED (DCK ** REV 9)




SYMBOL TABLE

A LABEL INCLUDING ** MEANS IT IS AN INTEL' ROUTINE IN ROM

ORDERED AS IN PROGRAM      ORDERED BY LABEL           ORDERED BY HEX VALUE

BEGIN        3C43          BEGIN        3C43          BEGIN        3C43
INIT         3C50          END          3C5E          INIT         3C50
END          3C5E          INIT         3C50          END          3C5E

OK,  MODEL *_INIT
GO
TRACE? N
THE MICRO HAS BEEN INITALIZED AS FOLLOWS:
MEMORY LOCATIONS 0000 - 07FF HAVE BEEN FILLED WITH THE ROM VALUES
MEMORY LOCATIONS 3C00 - 3FFF HAVE BEEN FILLED WITH ZEROS EXCEPT THAT [ 3C3D ] = CF AND [ 3C3E ] = C9
THE OTHER REGISTERS HAVE BEEN SET TO:
OUT TO  PORT ED: CFOUT TO  PORT ED: 25
SBC 80P MONITOR
.
READING FROM FILE *_INIT
I3C40215E3C3E00777CFE40D2503C23C3433C3EFF32FF3F3E8BD3E73E80D3EBFB00
.
END OF READING *_INIT
XS 3C02-3D00
.


HERE I CONTROL P ED SO THAT I COULD GO BACK AND TURN THE TRACE SWITCH ON


QUIT,
S 1000
GO
TRACE? Y
PC START:3C40
PC STOP :3C6F
DO YOU WISH TO SAVE THE TRACE? N
RESTART IN PROGRESS: PC COUNTER IS CURRENTLY 0100
ENTER NEW PC VALUE: 0000
OUT TO  PORT ED: CFOUT TO  PORT ED: 25
SBC 80P MONITOR
.D3C40,3C5E

SEE - THE LITTLE PROGRAM *_INIT HAS NOT BEEN LOST:

3C40 21 5E 3C 3E 00 77 7C FE 40 D2 50 3C 23 C3 43 3C
3C50 3E FF 32 FF 3F 3E 8B D3 E7 3E 80 D3 EB FB 00
.G3C40

NOW SEE THE TRACE IN PROGRESS

A=00 B=00 C=00 D=00 E=00 F=02 H=00 L=00 M=0000 PC=3C40 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=02 H=3C L=5E M=3C5E PC=3C43 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=02 H=3C L=5E M=3C5E PC=3C45 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=02 H=3C L=5E M=3C5E PC=3C46 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=02 H=3C L=5E M=3C5E PC=3C47 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=5E M=3C5E PC=3C49 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=5E M=3C5E PC=3C4C SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=5F M=3C5F PC=3C4D SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=5F M=3C5F PC=3C43 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=5F M=3C5F PC=3C45 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=5F M=3C5F PC=3C46 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=5F M=3C5F PC=3C47 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=5F M=3C5F PC=3C49 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=5F M=3C5F PC=3C4C SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=60 M=3C60 PC=3C4D SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=60 M=3C60 PC=3C43 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=60 M=3C60 PC=3C45 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=60 M=3C60 PC=3C46 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=60 M=3C60 PC=3C47 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=60 M=3C60 PC=3C49 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=60 M=3C60 PC=3C4C SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=61 M=3C61 PC=3C4D SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=61 M=3C61 PC=3C43 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=61 M=3C61 PC=3C45 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=61 M=3C61 PC=3C46 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=61 M=3C61 PC=3C47 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=61 M=3C61 PC=3C49 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=61 M=3C61 PC=3C4C SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=62 M=3C62 PC=3C4D SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=62 M=3C62 PC=3C43 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=62 M=3C62 PC=3C45 SP=3C02

A=00 B=00 C=00 D=00 E=00 F=97 H=3C L=62 M=3C62 PC=3C46 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=62 M=3C62 PC=3C47 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=62 M=3C62 PC=3C49 SP=3C02

A=3C B=00 C=00 D=00 E=00 F=97 H=3C L=62 M=3C62 PC=3C4C SP=3C02


QUIT,
S 1000
GO
TRACE? N
RESTART IN PROGRESS: PC COUNTER IS CURRENTLY 3CB0
ENTER NEW PC VALUE: 0000
OUT TO  PORT ED: CFOUT TO  PORT ED: 25
SBC 80P MONITOR
.D3C40,3C5F

3C40 21 5E 3C 3E 00 77 7C FE 40 D2 50 3C 23 C3 43 3C
3C50 3E FF 32 FF 3F 3E 8B D3 E7 3E 80 D3 EB FB 00 00
.Q
C     JULY 13, 1979  VERSION #4
C
C     SINCE THIS PROGRAM USES BLOCK DATA YOU MUST BE SURE TO SAVE MORE
C     OF YOUR USER SPACE THEN THE LOADER USUALLY DOES.
C     I USED : FTN MODEL
C              LOAD
C              COMMON 34000
C              LO B_MODEL
C              LO B_STAT
C              LO B_RDTKS   /* MCP SUBROUTINES
C              LO B_OF1     /* "
C              LO B_RDINFO  /* "
C              LO B_CL$     /* "
C              LIB
C              SAVE *MODEL
C              QUIT
C        OK,   SAVE *MODEL 200 34000 1000 0 0 0 4000
C
C
C           LOGICAL FILE,TERM,CMFILE,OK
C           INTEGER MEMORY(3072),TRNAME(16),TRLEN
C           COMMON /MEMCOM/MEMORY,TRNAME,TRLEN,CMFILE,OK
C     C
C     C     THIS IS THE MICRO CODE COMMON
C     C
C           INTEGER DB,REG(20)
C           INTEGER B,C,D,E,H,L,JUNK,A,FLAG,
C          *SP(2),PC(2),INSTRC,TDB,ADDR(2),TFB,
C          *TB1,TB2
C           COMMON /MICOMM/DB,REG,FILE,TERM
C           EQUIVALENCE (B,REG(1)),(C,REG(2)),(D,REG(3)),(E,REG(4)),
C          *      (H,REG(5)),(L,REG(6)),(JUNK,REG(7)),(A,REG(8)),
C          *(FLAG,REG(9)),(SP,REG(10)),(PC,REG(12)),(INSTRC,REG(14)),
C          *(TDB,REG(15)),(ADDR,REG(16)),(TFB,REG(18)),
C          *(TB1,REG(19)),(TB2,REG(20))
      INTEGER FILNAM(16)
$INSERT MICCOM
      LOGICAL FOUND
      DATA I/0/
      IF(I.NE.0)GO TO 3
      CALL RDTK2(2,TRNAME,TRLEN,OK)
      CALL RDTK1('-CMFILE',7,CMFILE,JUNK,0)
      CALL RDTK1('-INFO',5,FOUND,JUNK,0)
      IF(.NOT.FOUND)GO TO 3
      CALL RDINFO('MODEL',5)
      CALL EXIT
3     I=I+1
      FILE=.FALSE.
      TERM=.FALSE.
      CALL ATCH$$(0,0,0,0,0,ICODE)
      CALL TNOUA('TRACE? ',7)
      READ(1,1)IANS
1     FORMAT(A1)
      IF(IANS.EQ.'Y')GO TO 2
      IBEGIN=:77777
      IEND=0
      GO TO 4
2     CALL TNOUA('PC START:',9)
      CALL TIHEX(IBEGIN)
      CALL TNOUA('PC STOP :',9)
      CALL TIHEX(IEND)
      TERM=.TRUE.
      CALL TNOUA('DO YOU WISH TO SAVE THE TRACE? ',31)
      READ(1,1)IANS
      IF(IANS.EQ.'N')GO TO 4
      CALL TNOUA('FILE NAME: ',11)
      READ(1,7)FILNAM
7     FORMAT(16A2)
      CALL CL$
      CALL OF1(2,FILNAM,16,2,0)
      FILE=.TRUE.
      CALL TNOUA('DO YOU ALSO WANT TO SEE THE TRACE ON YOUR TERMINAL? '
     *,52)
      READ(1,1)IANS
      IF(IANS.EQ.'N')TERM=.FALSE.
4     IF(I.EQ.1)GO TO 5
      I1=INTASC(PC(1))
      I2=INTASC(I2)
      WRITE(1,6)I1,I2
6     FORMAT('RESTART IN PROGRESS: PC COUNTER IS CURRENTLY ',2A2)
      CALL TNOUA('ENTER NEW PC VALUE: ',20)
      CALL TIHEX(IRSTRT)
      PC(1)=SHFT(IRSTRT,8)
      PC(2)=SHFT(IRSTRT,-8,8)
      GO TO 10
5     CALL INIT
10    CONTINUE
      INSTRC=MEMORY(IOK(12,1))
      CALL OP(INSTRC)
      I1=SHFT(PC(1),-8)+PC(2)
      IF((I1.GE.IBEGIN.AND.I1.LE.IEND))CALL DUMP
      GOTO 10
      END
C
C
C
      SUBROUTINE OP (OPCODE)
$INSERT MICCOM
      INTEGER OPCODE,CONVRT
      CALL PLUS1(12)
      ITEST=OPCODE+1
      GOTO (140,120,440,150,5,10,20,160,780,170,350,460,5,10,20,
     . 180,780,120,440,150,5,10,20,450,780,170,350,460,5,10,20,
     . 190,780,120,470,150,5,10,20,660,780,170,360,460,5,10,20,
     . 230,780,120,480,150,7,12,22,400,780,170,340,460,5,10,20,
     . 240,110,110,110,110,110,110,110,110,110,110,110,110,110,110,
     . 110,110,110,110,110,110,110,110,110,110,110,110,110,110,
     . 110,110,110,110,110,110,110,110,110,110,110,110,110,110,
     . 110,110,110,110,110,110,110,110,110,110,110,110,670,110,
     . 110,110,110,110,110,110,110,110,30,30,30,30,30,30,30,30,
     . 40,40,40,40,40,40,40,40,50,50,50,50,50,50,50,50,
     . 60,60,60,60,60,60,60,60,70,70,70,70,70,70,70,70,
     . 80,80,80,80,80,80,80,80,90,90,90,90,90,90,90,90,
     . 100,100,100,100,100,100,100,100,570,680,300,255,485,690,
     . 210,700,580,590,330,780,490,500,200,700,600,680,280,760,
     . 510,690,410,700,610,780,250,770,520,780,720,700,620,680,
     . 320,710,530,690,220,700,630,380,310,420,540,780,430,700,
     . 640,680,290,740,560,690,370,700,650,390,260,750,550,
     . 780,730,700),ITEST
C*** OPCODE IS INR
5     I=CONVRT(OPCODE,5,3)
      DB=REG(I)
      CALL ADD (4,:326)
      REG(I)=DB
      RETURN
C*** OPCODE IS  INR M
7     DB=MEMORY(IOK(5,1))
      CALL ADD (4,:326)
      MEMORY(IOK(5,2))=DB
      RETURN
C*** OPCODE IS DCR
10    I=CONVRT(OPCODE,5,3)
      TDB=:377
      DB=REG(I)
      CALL ADD (3,:326)
      REG(I)=DB
      FLAG=XOR(FLAG,1)
      RETURN
C*** OPCODE IS DCR M
12    TDB=:377
      DB=MEMORY(IOK(5,1))
      CALL ADD (3,:326)
      FLAG=XOR(FLAG,1)
      MEMORY(IOK(5,2))=DB
      RETURN
C*** OPCODE IS MVI
20    I=CONVRT(OPCODE,5,3)
      REG(I)=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS MVI M
22    MEMORY(IOK(5,2))=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS ADD
30    I=CONVRT(OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=REG(I)
      DB=A
      CALL ADD (3,:327)
      A=DB
      RETURN
C*** OPCODE IS ADC
40    I=CONVRT(OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=REG(I)
      DB=A
      CALL ADD (5,:327)
      A=DB
      RETURN
C*** OPCODE IS SUB
50    I=CONVRT(OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=XOR(REG(I),:377)
      DB=A
      CALL ADD (2,:327)
      A=DB
      FLAG=XOR(FLAG,1)
      RETURN
C*** OPCODE IS SBB
60    I=CONVRT(OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=XOR(AND(REG(I)+AND(FLAG,1),:377),:377)
      DB=A
      CALL ADD (2,:327)
      A=DB
      FLAG=XOR(FLAG,1)
      RETURN
C*** OPCODE IS ANA
70    I=CONVRT(OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=REG(I)
      DB=A
      DB=AND(DB,TDB)   /* AND
      TFB=:2
      CALL TESTS(DB,TFB)
      FLAG=TFB+AND(:20,FLAG)
      A=DB
      RETURN
C*** OPCODE IS XRA
80    I=CONVRT(OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=REG(I)
      DB=A
      DB=XOR(DB,TDB)   /* XOR
      FLAG=:2   /* TURN OFF AUX CARRY AND CARRY
      CALL TESTS(DB,FLAG)
      A=DB
      RETURN
C*** OPCODE IS ORA
90    I=CONVRT(OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=REG(I)
      DB=A
      DB=OR(DB,TDB)   /* OR
      FLAG=:2   /* TURN OFF AUX CARRY AND CARRY
      CALL TESTS(DB,FLAG)
      A=DB
      RETURN
C*** OPCODE IS CMP
100   I=CONVRT (OPCODE,2,0)
      IF(I.EQ.7)REG(I)=MEMORY(IOK(5,1))
      TDB=XOR(REG(I),:377)
      DB=A
      CALL ADD (2,:327)
      FLAG=XOR(FLAG,1)
      RETURN
C*** OPCODE IS MOV
110   ID=CONVRT(OPCODE,5,3)
      IS=CONVRT(OPCODE,2,0)
      IF(IS.EQ.7)REG(IS)=MEMORY(IOK(5,1))
      REG(ID)=REG(IS)
      IF(ID.EQ.7)MEMORY(IOK(5,2))=REG(ID)
      RETURN
C*** OPCODE IS LXI
120   I=CONVRT (OPCODE,5,4)
      IF (I .EQ. 4) I=10
      IF (I .EQ. 3) I=5
      IF (I .EQ. 2) I=3
      REG(I+1)=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      REG(I)=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS NOP
140   RETURN
C*** OPCODE IS INX
150   I=CONVRT (OPCODE,5,4)
      IF (I .EQ. 4) I=10
      IF (I .EQ. 3) I=5
      IF (I .EQ. 2) I=3
      CALL PLUS1(I)
      RETURN
C*** OPCODE IS RLC
160   DB=A
      TFB=SHFT(TFB,1,-1)+SHFT(DB,7)     /*RLC
      DB=AND(:377,SHFT(DB,-1)) + AND(TFB,1)
      FLAG=OR(AND(:3,TFB),AND(:374,FLAG))
      A=DB
      RETURN
C*** OPCODE IS DAD
170   I=CONVRT (OPCODE,5,4)
      IF (I .EQ. 4) I=10
      IF (I .EQ. 3) I=5
      IF (I .EQ. 2) I=3
      TDB=L
      DB=REG(I+1)
      CALL ADD (3,:3)
      L=DB
      TDB=H
      DB=REG(I)
      CALL ADD (5,:3)
      H=DB
      RETURN
C*** OPCODE IS RRC
180   DB=A
      TFB=SHFT(TFB,1,-1)+AND(DB,1)   /* RRC
      DB=SHFT(DB,1)+SHFT(AND(DB,1),-7)
      A=DB
      FLAG=OR(AND(:3,TFB),AND(:374,FLAG))
      RETURN
C*** OPCODE IS RAR
190   DB=A
      TFB=AND(TFB,:376)+AND(DB,1)  /* RAR
      DB=SHFT(DB,1)+SHFT(AND(FLAG,1),-7)
      FLAG=OR(AND(:3,TFB),AND(:374,FLAG))
      A=DB
      RETURN
C*** OPCODE IS ACI
200   TDB=A
      DB=MEMORY(IOK(12,1))
      CALL ADD (5,:327)
      A=DB
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS ADI
210   TDB=A
      DB=MEMORY(IOK(12,1))
      CALL ADD (3,:327)
      A=DB
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS ANI
220   TDB=MEMORY(IOK(12,1))
      DB=A
      DB=AND(DB,TDB)   /* AND
      TFB=:2
      CALL TESTS(DB,TFB)
      FLAG=TFB+AND(:20,FLAG)
      A=DB
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS CMA
230   A=XOR(A,:377)     /* COMPLEMENT
      RETURN
C*** OPCODE IS CMC
240   FLAG=XOR(FLAG,1)
      RETURN
C*** OPCODE IS JC
250   IF (SHFT(FLAG,-15,15).EQ.1) GOTO 255
252   CALL PLUS1(12)
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS JMP
255   ADDR(1)=PC(1)
      ADDR(2)=PC(2)
      PC(2)=MEMORY(IOK(16,1))
      CALL PLUS1(16)
      PC(1)=MEMORY(IOK(16,1))
      RETURN
C*** OPCODE IS JM
260   IF (SHFT(FLAG,-8,15).EQ.1) GOTO 255
      GOTO 252
C*** OPCODE IS JNC
280   IF ( SHFT(FLAG,-15,15).NE.1) GOTO 255
      GOTO 252
C*** OPCODE IS JP
290   IF ( SHFT(FLAG,-8,15).NE.1) GOTO 255
      GOTO 252
C*** OPCODE IS JNZ
300   IF (SHFT(FLAG,-9,15).NE.1) GOTO 255
      GOTO 252
C*** OPCODE IS JPE
310   IF (SHFT(FLAG,-13,15).EQ.1) GOTO 255
      GOTO 252
C*** OPCODE IS JPO
320   IF ( SHFT(FLAG,-13,15).NE.1) GOTO 255
      GOTO 252
C*** OPCODE IS JZ
330   IF (SHFT(FLAG,-9,15).EQ.1) GOTO 255
      GOTO 252
C*** OPCODE IS LDA
340   ADDR(2)=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      ADDR(1)=MEMORY(IOK(12,1))
      A=MEMORY(IOK(16,1))
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS LDAX
350   I=CONVRT (OPCODE,4,4)
      IF (I .EQ. 2) I =3
      A=MEMORY(IOK(I,1))
      RETURN
C*** OPCODE IS LHLD
360   ADDR(2)=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      ADDR(1)=MEMORY(IOK(12,1))
      L=MEMORY(IOK(16,1))
      CALL PLUS1(16)
      H=MEMORY(IOK(16,1))
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS ORI
370   TDB=A
      DB=MEMORY(IOK(12,1))
      DB=OR(DB,TDB)   /* OR
      FLAG=:2   /* TURN OFF AUX CARRY AND CARRY
      CALL TESTS(DB,FLAG)
      A=DB
      CALL PLUS1(12)
      RETURN
C*** OPCODE  IS PCHL
380   PC(1)=H
      PC(2)=L
      RETURN
C*** OPCODE IS SPHL
390   SP(1)=H
      SP(2)=L
      RETURN
C*** OPCODE IS STC
400   FLAG=OR(FLAG,1)
      RETURN
C*** OPCODE IS SUI
410   TDB=MEMORY(IOK(12,1))
      TDB=XOR(TDB,:377)
      CALL PLUS1(12)
      DB=A
      CALL ADD (2,:327)
      A=DB
      FLAG=XOR(FLAG,1)
      RETURN
C*** OPCODE IS XCHG
420   DO 425 I=3,4
      K=REG(I)
      REG(I)=REG(I+2)
425   REG(I+2)=K
      RETURN
C*** OPCODE IS XRI
430   TDB=MEMORY(IOK(12,1))
      DB=A
      DB=XOR(DB,TDB)   /* XOR
      FLAG=:2   /* TURN OFF AUX CARRY AND CARRY
      CALL TESTS(DB,FLAG)
      A=DB
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS STAX
440   I=CONVRT(OPCODE,4,4)
      IF (I .EQ. 2) I=3
      MEMORY(IOK(I,2))=A
      RETURN
C*** OPCODE IS RAL
450   DB=A
      TFB=AND(TFB,:376)+SHFT(DB,7)   /* RAL
      DB=AND(:377,SHFT(DB,-1))+AND(FLAG,1)
      FLAG=OR(AND(:3,TFB),AND(:374,FLAG))
      A=DB
      RETURN
C*** OPCODE IS DCX
460   I=CONVRT(OPCODE,5,4)
      IF (I .EQ. 4 ) I=10
      IF (I .EQ. 3)  I=5
      IF (I .EQ. 2 ) I=3
      CALL MINUS1 (I)
      RETURN
C*** OPCODE IS SHLD
470   ADDR(2)=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      ADDR(1)=MEMORY(IOK(12,1))
      MEMORY(IOK(16,2))=L
      CALL PLUS1 (16)
      MEMORY(IOK(16,2))=H
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS STA
480   ADDR(2)=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      ADDR(1)=MEMORY(IOK(12,1))
      MEMORY(IOK(16,2))=A
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS CNZ
485   IF (SHFT(FLAG,-9,15).NE.1) GOTO 495
      GOTO 493
C*** OPCODE IS CZ
490   IF (SHFT(FLAG,-9,15).EQ.1) GOTO 495
493   CALL PLUS1(12)
      CALL PLUS1(12)
      RETURN
495   TB1=MEMORY(IOK(12,1))
      CALL PLUS1(12)
      TB2=MEMORY(IOK(12,1))
      CALL MINUS1(10)
      CALL PLUS1(12)
      MEMORY(IOK(10,2))=PC(1)
      CALL MINUS1 (10)
      MEMORY(IOK(10,2))=PC(2)
      PC(1)=TB2
      PC(2)=TB1
      RETURN
C*** OPCODE IS CALL
500   GOTO 495
C*** OPCODE IS CNC
510   IF ( SHFT(FLAG,-15,15).NE.1) GOTO 495
      GOTO 493
C*** OPCODE IS CC
520   IF (SHFT(FLAG,-15,15).EQ.1) GOTO 495
      GOTO 493
C*** OPCODE IS CPO
530   IF ( SHFT(FLAG,-13,15).NE.1) GOTO 495
      GOTO 493
C*** OPCODE IS CPE
540   IF (SHFT(FLAG,-13,15).EQ.1) GOTO 495
      GOTO 493
C*** OPCODE IS CM
550   IF (SHFT(FLAG,-8,15).EQ.1) GOTO 495
      GOTO 493
C*** OPCODE IS CP
560   IF ( SHFT(FLAG,-8,15).NE.1) GOTO 495
      GOTO 493
C*** OPCODE IS RNZ
570   IF (SHFT(FLAG,-9,15).NE.1) GOTO 575
572   RETURN
575   PC(2)=MEMORY(IOK(10,1))
      CALL PLUS1(10)
      PC(1)=MEMORY(IOK(10,1))
      CALL PLUS1(10)
      RETURN
C*** OPCODE IS RZ
580   IF (SHFT(FLAG,-9,15).EQ.1) GOTO 575
      GOTO 572
C*** OPCODE IS RET
590   GOTO 575
C*** OPCODE IS RNC
600   IF ( SHFT(FLAG,-15,15).NE.1) GOTO 575
      GOTO 572
C*** OPCODE IS RC
610   IF (SHFT(FLAG,-15,15).EQ.1) GOTO 575
      GOTO 572
C*** RPO
620   IF ( SHFT(FLAG,-13,15).NE.1) GOTO 575
      GOTO 572
630   IF (SHFT(FLAG,-13,15).EQ.1) GOTO 575
      GOTO 572
C*** OPCODE IS RP
640   IF ( SHFT(FLAG,-8,15).NE.1) GOTO 575
      GOTO 572
C*** OPCODE IS RM
650   IF (SHFT(FLAG,-8,15).EQ.1) GOTO 575
      GOTO 572
C*** OPCODE IS DAA
660   DB=A
      TDB=6     /* DAA
      I=AND(SHFT(FLAG,4),1)
      IF(I.EQ.1.OR.CONVRT(DB,3,0)-1.GT.9)CALL ADD (1,:22)
      TDB=:140
      I=AND(FLAG,1)
      IF(I.EQ.1.OR.CONVRT(DB,7,4)-1.GT.9)CALL ADD (1,:327)
      A=DB
      RETURN
C*** OPCODE IS HLT
670   PAUSE
C*** OPCODE IS POP
680   I=CONVRT(OPCODE,5,4)
      IF (I .EQ. 4) I=8
      IF (I .EQ. 3) I=5
      IF (I .EQ. 2) I=3
      REG(I+1)=MEMORY(IOK(10,1))
      CALL PLUS1(10)
      REG(I)=MEMORY(IOK(10,1))
      CALL PLUS1(10)
      RETURN
C*** OPCODE IS PUSH
690   CALL MINUS1(10)
      I=CONVRT(OPCODE,5,4)
      IF (I .EQ. 4) I=8
      IF (I .EQ. 3) I=5
      IF (I .EQ. 2) I=3
      MEMORY(IOK(10,2))=REG(I)
      CALL MINUS1(10)
      MEMORY(IOK(10,2))=REG(I+1)
      RETURN
C*** OPCODE IS RST
700   CALL MINUS1(10)
      MEMORY(IOK(10,2))=PC(1)
      CALL MINUS1(10)
      MEMORY(IOK(10,2))=PC(2)
      I=CONVRT(OPCODE,5,3)
      PC(1)=0
      PC(2)=SHFT(I-1,-3)
      RETURN
C*** OPCODE IS XTHL
710   TDB=MEMORY(IOK(10,1))
      MEMORY(IOK(10,2))=L
      L=TDB
      CALL PLUS1(10)
      TDB=MEMORY(IOK(10,1))
      MEMORY(IOK(10,2))=H
      H=TDB
      CALL MINUS1 (10)
      RETURN
C*** OPCODE IS SBI
720   TDB=MEMORY(IOK(12,1))
      TDB=XOR(TDB+AND(FLAG,1),:377)
      CALL PLUS1(12)
      DB=A
      CALL ADD (2,:327)
      A=DB
      FLAG=XOR(FLAG,1)
      RETURN
C*** OPCODE IS CPI
730   TDB=MEMORY(IOK(12,1))
      TDB=XOR(TDB,:377)
      DB=A
      CALL ADD (2,:327)
      FLAG=XOR(FLAG,1)
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS DI
740   CALL BREAK$(.TRUE.)
      RETURN
C*** OPCODE IS EI
750   CALL BREAK$ (.FALSE.)
      RETURN
C*** OPCODE IS OUT
760   TDB=MEMORY(IOK(12,1))
      DB=A
      CALL IO(2)
      CALL PLUS1(12)
      RETURN
C*** OPCODE IS IN
770   TDB=MEMORY(IOK(12,1))
      CALL IO(1)
      A=DB
      CALL PLUS1(12)
      RETURN
780   WRITE (1,790)OPCODE
790   FORMAT ('ERROR !!!!!!!',I4,' IS AN INCORRECT OPCODE')
      RETURN
      END
C
C
C
      INTEGER FUNCTION IOK(J,K)
$INSERT MICCOM
      IOK=SHFT(REG(J),-8)+REG(J+1)+1
      IF(IOK.GT.:36000)IOK=IOK-:32000
      IF(IOK.LT.0.OR.IOK.GT.3072)GO TO 60
      IF(IOK.LE.2048.AND.K.EQ.2)GO TO 80
      RETURN
60    CONTINUE
C
C     ILLEGAL MEMORY REFERENCE
C
      WRITE(1,70)
70    FORMAT('ILLEGAL MEMORY REFERENCE')
      CALL MESS(REG(J))
      CALL DUMP
      PAUSE 201
80    CONTINUE
C
C     TRYING TO WRITE INTO ROM
C
      WRITE(1,85)
85    FORMAT('YOU CANNOT WRITE INTO ROM LOCATIONS 0000 - 07FF')
      CALL MESS(REG(J))
      CALL DUMP
      PAUSE 202
90    CONTINUE
      END
C
C
C
      SUBROUTINE MINUS1 (NREG1)
$INSERT MICCOM
      NREG2=NREG1+1
      IF(REG(NREG2).EQ.0)GO TO 10
      REG(NREG2)=REG(NREG2)-1
      RETURN
10    REG(NREG2)=:377
      IF(REG(NREG1).EQ.0)GO TO 20
      REG(NREG1)=REG(NREG1)-1
      RETURN
20    REG(NREG1)=:377
      RETURN
      END
C
C
C
      SUBROUTINE PLUS1(NREG1)
$INSERT MICCOM
      NREG2=NREG1+1
      REG(NREG2)=REG(NREG2)+1
      IF(REG(NREG2).NE.256)RETURN
      REG(NREG2)=0
      REG(NREG1)=AND(:377,REG(NREG1)+1)
      RETURN
      END
C
C     THE FOLLOWING SUBROUTINE IS INCLUDED FOR COMPLETENESS
C     IT SETS A = 0 IF THERE IS NO CHARACTER AT THE TERMINAL DEVICE TO
C                  BE RECEIVED,
C     AND SET A = 2 IF THERE IS ONE TO BE RECEIVED
C
C          SUBR STATUS
C          REL
C          C64R
C     STAT DAC **
C          CALL F$AT
C          DEC 1
C     I    DAC **
C          CRA
C          STA*  I
C          SKS   '704
C          JMP*  STAT
C          A2A
C          STA*  I
C          JMP*  STAT
C          END
C
C     THIS SUBROUTINE PROCESSES I/O
C
      SUBROUTINE IO(AW)
      INTEGER AW,IWHERE,LEFT,FILDAT(440),XERR(2)
$INSERT MICCOM
      DATA IWHERE/-2/,LEFT/0/,ICNT/0/,IPOINT/0/
C
C     IWHERE TELLS THE SUBROUTINE WHERE THE TERMINAL INPUT IS TO COME FROM
C     IN A SENSE IT MAPS PORT EC IN THE INTEL TO EITHER A FILE (IWHERE = -1),
C     OR A COMMAND FILE (0) OR THE TERMINAL (+1).
C
C     A 'Q' FROM ANY OF THE ABOVE SOURCES ENDS INPUT FROM THAT DEVICE
C
      IF(AW.NE.1.AND.AW.NE.2)PAUSE 401
C
C     LET'S GET THE PORT NUMBER AS AN ASCII CODE
C
      IF(    ('00'.LE.IPORT.AND.IPORT.LE.'02').OR.
     *       ('E4'.LE.IPORT.AND.IPORT.LE.'EB')      ) GO TO 100
      IPORT=INTASC(TDB)
      IF(IPORT.EQ.'EC')GO TO 300
      IF(IPORT.EQ.'ED')GO TO 200
      PAUSE 501

100   GO TO (110,150),AW
110   CALL TNOUA('IN FROM PORT ',13)
      CALL TNOUA(IPORT,2)
      CALL TNOUA(' :',2)
120   CALL TIHEX(DB)
      DB=AND(DB,:377)
      RETURN
150   CALL TNOUA('OUT TO  PORT ',13)
      CALL TNOUA(IPORT,2)
      CALL TNOUA( ':',2)
      CALL TNOUA(INTASC(DB),2)
      RETURN

200   GO TO (210,150),AW
210   CALL STATUS(DB)
      DB=OR(DB,1) /* ALWAYS SET TRANSMITTER READY TO SEND TO TERMINAL
      IF(IWHERE.LE.0)DB=3  /* SET READY TO RECEIVE IF FROM FILE OR COMMAND FILE
      RETURN

300   GO TO (310,350),AW
310   IF(IWHERE)320,330,335
320   IF(IWHERE.EQ.-1)GO TO 322
      IWHERE=-1
      IF(.NOT.OK)GO TO 329
      CALL OF1(1,TRNAME,TRLEN,1,0)
      CALL TONL
      CALL TNOUA('READING FROM FILE ',18)
      CALL TNOU(TRNAME,16)
322   IF(ICNT.NE.0)GO TO 324
      IPOINT=0
      CALL PRWF$$(1,1,LOC(FILDAT),440,000000,ICNT,ICODE)
      IF(ICNT.EQ.0)GO TO 327
324   LEFT=1-LEFT
      IF(LEFT.EQ.0)GO TO 325
      IPOINT=IPOINT+1
      ICHAR=FILDAT(IPOINT)
      DB=SHFT(ICHAR,8)
      IF(DB.EQ.0)GO TO 320
      GO TO 340
325   DB=AND(ICHAR,:377)
      ICNT=ICNT-1
      IF(DB.EQ.0)GO TO 320
      GO TO 340
327   CALL SRCH$$(4,0,0,1,IT,IC)
      CALL TONL
      CALL TNOUA('END OF READING ',15)
      CALL TNOU(TRNAME,16)
329   IWHERE=0
      IF(CMFILE)GO TO 330
      IWHERE=1
      GO TO 335
330   CALL C1IN(DB)
      IF(DB.NE.:321)GO TO 340
      IWHERE=1
      CALL TONL
      CALL TNOU('END OF COMMAND FILE - NOW FROM TERMINAL',39)
335   CALL T1IN(DB)
340   IF(DB.EQ.:212)DB=:215
      IF(IWHERE.LT.0)GO TO 350    /* TELL USER THE CHARACTER IF FROM FILE
      IF(DB.NE.:321)RETURN
      CALL SRCH$$(4,0,0,2,IT,IC)
      CALL EXIT
      RETURN
350   CALL TNOUA(SHFT(DB,-8),1)
      RETURN
      END
C
C     THIS SUBROUTINE SETS SIGN)= ZERO AND PARITY IN TFB
C
      SUBROUTINE TESTS(I,J)
      IF(I.GE.128)J=J+:200
      IF(I.EQ.0)J=J+:100
C
C     NOW CALCULATE PARITY
C
      K=0
      DO 10 ICOUNT=1,8
10    IF(AND(SHFT(I,ICOUNT-1),1).EQ.1)K=K+1
      IF(AND(K,1).EQ.0)J=J+:4
      RETURN
      END
C
C     THIS SUBROUTINE MIMICS THE ADDER
C
      SUBROUTINE ADD(AW,CW)
$INSERT MICCOM
      INTEGER AW,CW
      GO TO(3,2,3,4,5),AW
2     ICARRY=1
      GO TO 6
3     ICARRY=0
      GO TO 6
4     ICARRY=1
      TDB=0
      GO TO 6
5     ICARRY=AND(FLAG,1)
6     TFB=:2
      IF(AND(DB,:17)+AND(TDB,:17)+ICARRY.GE.16)TFB=:22
      DB=DB+TDB+ICARRY
      TFB=OR(TFB,SHFT(DB,8))    /* CARRY
      DB=AND(DB,:377)      /* KILL POTENTIAL BIT 9 ON
      IF(DB.EQ.0)TFB=OR(TFB,:100)    /* ZERO
      TFB=OR(TFB,AND(DB,:200))    /* SIGN
      K=0
      DO 10 ICOUNT=1,8
10    IF(AND(SHFT(DB,ICOUNT-1),1).EQ.1)K=K+1
      K=1-AND(K,1)   /* PARITY BIT
      TFB=OR(TFB,SHFT(K,-2))
      FLAG=OR(AND(CW,TFB),AND(XOR(CW,:377),FLAG))
      RETURN
      END
C
C     THIS FUNCTION TAKES THE RIGHT BYTE OF AN INTEGER VALUE
C     AND CONVERTS IT TO TWO ASCII HEX CHARACTERS
C     FOR EXAMPLE IASC=INTASC(27) WOULD SET IASC EQUAL TO '1B'
C     BECAUSE 27 IS 0001 1011
C
      INTEGER FUNCTION INTASC(IVALUE)
      JVALUE=AND(IVALUE,:377)   /* KILL LEFT BYTE
      IL=SHFT(JVALUE,4)
      IR=AND(JVALUE,15)
      IF(IL.GT.9)IL=IL+7
      IF(IR.GT.9)IR=IR+7
      IL=IL+:260
      IR=IR+:260
      INTASC=SHFT(IL,-8)+IR
      RETURN
      END
C
C     THIS FUNCTION TAKES THE M THRU N BITS OF I, ANALYSES THEM AS
C     AN INTEGER AND ADDS ONE.  THUS IS I,M,N ARE 001110000, 5 AND 4
C     THE CONVRT WILL BE SET TO 4.  THE BITS ARE NUMBERED FROM LEFT TO RIGHT
C     AS 7,6,5,4,3,2,1,0.
C
      INTEGER FUNCTION CONVRT(I,M,N)
      J=AND(I,:377)
      J=SHFT(J,M-7)
      J=AND(J,:377)
      CONVRT=SHFT(J,N+7-M)+1
      RETURN
      END
C
C     THIS FUNCTION PERFORMS THE INVERSE OF THE PREVIOUS FUNCTION
C     ITS ARGUMENT IS EXPECTED TO BE A 2 CHARACTER HEX ASCII CODE
C     AND THE RESULT IS THE INTEGER VALUE FOR WHICH IT STANDS
C     FOR EXAMPLE IVALUE=ASCINT('1B') WOULD SET IVALUE TO 27
C     BECAUSE '1B' IS 0001 1011 WHICH IS 11011 BASE 2 =27 BASE 10
C
      INTEGER FUNCTION ASCINT(IASC)
      IL=SHFT(IASC,8)
      IR=SHFT(IASC,-8,8)
      IL=IL-:260
      IR=IR-:260
      IF(IL.GT.9)IL=IL-7
      IF(IR.GT.9)IR=IR-7
      ASCINT=SHFT(IL,-4)+IR
      RETURN
      END
C
C     THIS SUBROUTINE READS FROM OR WRITES TO THE DATA BUS DB
C     THE REGISTER INVOLVED IS NUMBERED CW
C     CW CANNOT BE 7
C
C
C
C     THIS SUBROUTINE PRINTS THE INTERNAL REGISTERS
C
      SUBROUTINE DUMP
      INTEGER X(21),ASC(21)
$INSERT MICCOM
      DATA X/8,1,2,3,4,9,5,6,5,6,12,13,10,11,14,15,16,17,18,19,20/
      DO 10 I=1,21
      J=X(I)
10    ASC(I)=INTASC(REG(J))
      J=INTASC(DB)
C     WRITE(1,20)ASC,J
20    FORMAT('A=',A2,' B=',A2,' C=',A2,' D=',A2,' E=',A2,' F=',A2,
     *' H=',A2,' L=',A2,' M=',2A2,' PC=',2A2,' SP=',2A2,
     */'OPCODE=',A2,' TDB=',A2,' ADDR=',2A2,' TFB=',A2,' TB1=',A2,
     *'TB2=',A2,' DB=',A2)
      IF(TERM)WRITE(1,30)(ASC(I),I=1,14)
      IF(FILE)WRITE(6,30)(ASC(I),I=1,14)
30    FORMAT('A=',A2,' B=',A2,' C=',A2,' D=',A2,' E=',A2,' F=',A2,
     *' H=',A2,' L=',A2,' M=',2A2,' PC=',2A2,' SP=',2A2//)
      RETURN
      END
C
C     THIS SUBROUTINE INITIALIZES MICOMM AND MEMCOM
C
      BLOCK DATA
$INSERT MICCOM
      DATA MEMORY/
     * '3ECFD3EDC3B2020022343CE122363CF52102003922383CF131343CC3B1012195
     Q0306134ECDE8012305C22300312E3C0E2ECDF901C33C0000C33D3C00CD200200',
     Q '00007901080021BA03BECA5500230DC24900C3120221A80309097E23666FE90E
     *02CD5B02D1E1CDF301CDA8010E20CDF9017ECDC202CDC201DA1702CDA002DA17',
     * '02237DE60FC26C00C36600CD2702D2A0007AFE0DC2120221363C712370C3A600
     Q7AFE0DC21202C327030E01CD5B023EFF323A3CD1CD200200000079FE1BCAE900',
     * 'CD8203DAB400CD6703D2E300CDDF014FCD48033A3A3CB7C2DB0013EEFF323A3C
     *C3B400CD3D03C31202CD3D03C317020E03CD5B02C1E1D1E5626B7E6069770378',
     * 'B1CA2C0013E1CDA002D22C00C3F700CD2702C5E17AFE20CA1F01FE2CC22C007E
     QCDC2020E2DCDF901CD2702D22F017123C31401CD200200000079FE0DC24501CD',
     * 'DF02C32C004FCD1003C5E10E20CDF90179323A3C3A3A3CFE20CA6101FE2CC22C
     *007EB7CA1702E55E163C2346D5D5E1C57ECDC202F1F5B7CA7F012B7ECDC2020E',
     * '2DCDF901CD2702D29F017A323A3CF1E1B7CA9601702B71110300E119C354017A
     *323A3CD1D1C397017CCDC2027DCDC202C9F5C5D50E23CDF9012A363CCDA801C3',
     * '1702DBEDE602CA1D02DBECE67FFE1BCA3B03C31D02DBEDE602CAD501DBECC979
     *D630FE0AF8D607C9DBEDE601CAE80179D3ECC90E0DCDF901C9413E1BB8C20202',
     * '0E24CDE8013E0DB8C210020E0ACDE80148C90E23CDF901CDF301C32C00373FC9
     QCDD501E67F4FC9E52100001E00CD2002000000CD8203D2450251E5C1E17BB7C2',
     * '3B03CA1D02CD6703D21202CDDF011EFF2929292906004F09C32D022E0379E603
     *C867CD2702D21202C52D25CA77027AFE0DCA1202C362027AFE0DC2120201FFFF',
     * '7DB7CA8A02C52DC28502C1D1E1CDA002D29502545DE3D5C5E53DF8E1E3C39902
     *C547237CB52B37CAAF027D937C9A3F78C1C93E25D3ED21023C22383C312E3CC3',
     * '1E00F50F0F0F0FCDD502CDF901F1CDD502CDF901C9E60FC69027CE40274FC921
     *C2034E79B7C2EC02CDF301C9CDF9010E3DCDF901235E163C231ACDC2027EB7CA',
     * '07031B1ACDC2020E20CDF90123C3E20221C2031103007EB7CA1202B9CA230319
     *C3160323444DC9F3312E3CD1C1F12A383CF92A363CE52A343CFBC937C93A3A3C',
     * 'B7C00E00CD4803C9D5E179E60F4F3A3A3CB7C25B037EE6F0B177C97EE60F4779
     *0F0F0F0FB077C979FE30FA1D02FE39FA3B03CA3B03FE41FA1D02FE47F21D02C3',
     * '3B0379FE2CCA3B03FE0DCA3B03FE20CA3B03C31D020D0A53424320383050204D
     *4F4E49544F520D0A000033010F01EF00A9008B005F000604410457524447494D',
     * '5358413300423100433000442F00452E004632004835004C34004D3501503701
     *5339010000284329203139373620494E54454C20434F52500000C3E801C3D501',
     * 'C32205C31505CD2002CDF90179FE0DC21202CD1905FE3AC21204AF57CD9604CA
     *2C005FCD960467CD96046FCD96044BCD960477231DC22F04CD9604C21202C312',
     * '040E02CD5B02CDC004D1E17DC6104F7CCE00477B914F7A98DA60043E10C36304
     *79C611B7CA9004D55F16000E3ACD15057BCDD504CDCC04AFCDD5047ECDD50423',
     * '1DC27B04AF92CDD504D1CD0A05C34B04CDEC04C31702C5CD19054FCDDF010707
     *070747CD19054FCDDF01B04F825779C1C9C50E07068805C2B6040DC2B404C1C9',
     * '063C0E00CD150505C2C204C97CCDD5047DCDD504C9F50F0F0F0FCDD502CD1505
     *F1F5CDD502CD1505F18257C90E3ACD1505AF57CDD504210000CDCC043E01CDD5',
     * '04AF92CDD504CDC004C90E0DCD15050E0ACD1505C9CDE801C9CD2205DA1202E6
     *7FC9C53E92D3C0003E0CD3C1CDB1040000000000000630DBC2E601CA4905CDB1',
     * '0405C23705AF37C1C9DBC3B7C1C9284329203139373620494E54454C20434F52
     *5000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     * '0000000000000000000000000000000000000000000000000000000000000000
     *0000000000000000000000000000000000000000000000000000000000000000',
     *1023*'00','FF'/
      DATA TRNAME/16*'  '/,TRLEN/16/,CMFILE,OK/2*.FALSE./
      DATA DB,REG,FILE,TERM/0,20*0,.FALSE.,.TRUE./
      END
      SUBROUTINE INIT
      INTEGER ASCINT
$INSERT MICCOM
      DO 20 I=1,3072
20    MEMORY(I)=ASCINT(MEMORY(I))
      I=SHFT(ASCINT('3C'),-8)+ASCINT('3D')+1-:32000
      MEMORY(I)=ASCINT('CF')
      MEMORY(I+1)=ASCINT('C9')
      MEMORY(I-4)=ASCINT('3D')  /* SET USER'S STACK POINTER TO 3D00
      MEMORY(I-5)=ASCINT('00')
      MEMORY(I-11)=ASCINT('02')   /* SET USER'S FLAG TO 02
      TFB=FLAG
      WRITE(1,30)
30    FORMAT('THE MICRO HAS BEEN INITALIZED AS FOLLOWS:'/
     *'MEMORY LOCATIONS 0000 - 07FF HAVE BEEN FILLED WITH THE ROM',
     *' VALUES'/'MEMORY LOCATIONS 3C00 - 3FFF HAVE BEEN FILLED',
     *' WITH ZEROS EXCEPT THAT [ 3C3D ] = CF AND [ 3C3E ] = C9 '/
     *'THE OTHER REGISTERS HAVE BEEN SET TO:')
      CALL DUMP
      RETURN
      END
C
C     THIS SUBROUTINE PRINTS THE CONTENTS OF ARRAY AND ARRAY+1
C
      SUBROUTINE MESS(ARRAY)
      INTEGER ARRAY(2)
      CALL TNOU('ARRAY ADDRESS IS',16)
      CALL TOHEX(ARRAY)
      CALL TOHEX(ARRAY(2))
      CALL TONL
      CALL DUMP
      RETURN
      END
C
C THIS IS THE SUBROUTINE STATUS WHICH MUST BE COMPILED USING PMA
C
C          SUBR STATUS
C          REL
C          C64R
C     STAT DAC **
C          CALL F$AT
C          DEC 1
C     I    DAC **
C          CRA
C          STA*  I
C          SKS   '704
C          JMP*  STAT
C          A2A
C          STA*  I
C          JMP*  STAT
C          END
