(FILECREATED " 3-Nov-86 17:50:08" {ERIS}<TAMARIN>WORK>SIMULATE>MICROASSEMBLER.;2
        

      changes to:  (FNS SetAddrField PutLabel AssembleUCode ParseLine2 NoteOpcode AssembleOps.1)

      previous date: " 3-Nov-86 14:50:03" {ERIS}<TAMARIN>CMOS1>EMULATOR>MICROASSEMBLER.;17)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT MICROASSEMBLERCOMS)

(RPAQQ MICROASSEMBLERCOMS
 ((FNS AUCode AssembleUCode SetAddrField SwapAB CheckLabel 
				  CheckUndefinedLabels CollectLine FixEltLst NoteOpcode ParseElt 
				  ParseLine ParseLine2 PutLabel MakeOpList ReformatOpPla ShowFields 
				  PutAssocHash GetAssocHash ShowUCodeAlloc FindFreeSide)
	(* * Special Opcode Assembler)
	(FNS AssembleOps AssembleOps.1 AddAtom ReadAtom AddItem AddList AddMemFrame AddCode LoadFnHdr 
	     LinkCode AddFnHeader AddVmTable AddUfns NextFnAddr EvalBytes ClearMemoryArray)
	(* * Misc)
	(UGLYVARS lineReadTable)
	(VARS PreCondList)))
(DEFINEQ

(AUCode

  [LAMBDA (local)                                            (* edited: "29-Oct-86 11:39")

    (
SETQ
 local (if
 (
EQ
 local T)
		      then
 (
QUOTE
 {DSK}TUCODE)
		    elseif
 local
		      then
 local
		    else
 (
QUOTE
 {eris}<Tamarin>Cmos1>Emulator>TUCode)))
    (
CLOSEF?
 local)
    (AssembleUCode
 local)
    (
CLOSEF?
 local)                                        (* SETQ undefinedlist (for i in labellist when 

							     (NOT (FMEMB i startlist)) collect i))

                                                             (* SETQ LCFIL NIL)

                                                             (* SETQ STRF T)

    NIL])

(AssembleUCode

  [LAMBDA (file)                                             (* edited: "29-Oct-86 17:52")

    (
PROG
 (fl mi line fixLst opNbr)
	    (
SETQ
 OpcodeMode NIL)
	    (
SETQ
 defaultlist NIL)
	    (
SETQ
 startlist NIL)
	    (
SETQ
 labellist NIL)
	    (
SETQ
 fl (
INPUT
 (
INFILE
 file)))
	    (
SETQ
 OpCodeList NIL)
	    (
SETQ
 opArray (
ARRAY
 256 (
QUOTE
 POINTER)
				     NIL 0))                 (* SETQ OpPlaArray (ARRAY 256 

							     (QUOTE POINTER) NIL 0))


          (* SETQ OpPlaSpec (LIST (QUOTE ((#Opcode 0 8 0) (*DoReset 8 1 0) (#Interrupt 9 1 0) (#RefillRq 10 1 0) 

	  (#FramesEmpty 11 1 0) (#FramesFull 12 1 0) (#$RefCnt 13 1 0) (#$Refresh 14 1 0) (#$StackRefill 15 1 0))) 

	  (QUOTE ((#OpLength 0 3 0) (#StartAddr 3 8 0) (#ModStartAddr 11 1 0) (#ForceNewOp 17 1 0))) NIL))



	    (
SETQ
 UCodeRomA (
ARRAY
 257 (
QUOTE
 POINTER)
				       NIL 0))
	    (
SETQ
 UCodeRomB (
ARRAY
 257 (
QUOTE
 POINTER)
				       NIL 0))
	    (
SETQ
 LabelList NIL)
	    (PutLabel
 (
QUOTE
 Done)
			512)
	    (PutLabel
 (
QUOTE
 *Done)
			768)
	    (
SETQ
 AtomList NIL)
	    (for
 i in
 PreCondList do
 (
PUTPROP
 i (
QUOTE
 PreCondStart)
						      0))
	    (
SETQ
 EltLst NIL)
	    (
SETQ
 OpPlaList NIL)
	    (
SETQ
 OpPlaTerms NIL)
	    (PRINTOUT T "Scanning uCode" T)
	L1  (
SETQ
 line (CollectLine
 fl))
	    (
SETQ
 mi (ParseLine
 line))
	    (if
 (
EQ
 T mi)
		then
 (PRINTOUT T "Scanning Opcode Entry Points" T)
		       (
GO
 L2))
	    (
SETQ
 AtomList (
LDIFFERENCE
 AtomList AtomList))
	    (
GO
 L1)
	L2  (
SETQ
 line (CollectLine
 fl))
	    (
SETQ
 mi (ParseLine2
 line))
	    (if
 (
EQ
 T mi)
		then
 (
GO
 L4))
	    (
GO
 L2)
	L4  (CheckUndefinedLabels
)
	    (
PROG
 [[AsideLeft (for
 i from
 0 to
 255 count
 (
NOT
 (
ELT
 UCodeRomA i]
		     (BsideLeft (for
 i from
 0 to
 255 count
 (
NOT
 (
ELT
 UCodeRomB i]
		    (PRINTOUT T AsideLeft " Microcode Locations left on A side" T)
		    (PRINTOUT T BsideLeft " Microcode Locations left on B side" T)
		    (PRINTOUT T (
PLUS
 AsideLeft BsideLeft)
			      " Total Microcode Locations Left out of "
			      (
TIMES
 2 (
ARRAYSIZE
 UCodeRomA))
			      T))
	    (
CLOSEF
 fl])

(SetAddrField

  [LAMBDA (mi field addr)                                    (* rtk " 3-Nov-86 17:49")

    (
PROG
 [(Adef (
NUMBERP
 (fetch
 (MI NextInstA) of
 mi)))
	     (Bdef (
NUMBERP
 (fetch
 (MI NextInstB) of
 mi)))
	     (Aok (
EQ
 0 (
LOGAND
 addr 256)))
	     (Bok (
EQ
 256 (
LOGAND
 addr 256)))
	     (Addrok (
AND
 (
EQ
 field (
QUOTE
 Addr))
			    (
OR
 (
AND
 (
NOT
 (fetch
 (MI RomSide) of
 mi))
					 (replace
 (MI RomSide) of
 mi with
 (
RSH
 addr 8)))
				  (
EQ
 (fetch
 (MI RomSide) of
 mi)
					(
RSH
 addr 8]
	    (
SELECTQ
 field
		       [NextInstA (if
 (
NOT
 (
OR
 Aok Bdef))
				      then
 (SwapAB
 mi (fetch
 (MI NextInstB) of
 mi)
						       (
QUOTE
 NextInstA))
					     (
SETQ
 field (
QUOTE
 NextInstB]
		       [NextInstB (if
 (
NOT
 (
OR
 Bok Adef))
				      then
 (SwapAB
 mi (fetch
 (MI NextInstA) of
 mi)
						       (
QUOTE
 NextInstB))
					     (
SETQ
 field (
QUOTE
 NextInstA]
		       (Addr T)
		       (
BREAK1
 NIL T (Illegal field type)))
	    (if
 (
SELECTQ
 field
			     (NextInstA Aok)
			     (NextInstB Bok)
			     (Addr Addrok)
			     NIL)
		then
 (
SETQ
 addr (
LOGOR
 (
LOGAND
 addr 255)
					     (
RSH
 (
LOGAND
 addr 512)
						    1)))
		       (
RECORDACCESS
 field mi NIL (
QUOTE
 REPLACE)
				       addr)
		       (if
 (
EQ
 field (
QUOTE
 Addr))
			   then
 (if
 (
EQ
 (fetch
 (MI RomSide) of
 mi)
					      0)
				      then
 (
SETA
 UCodeRomA addr mi)
				    else
 (
SETA
 UCodeRomB addr mi))
				  (IF
 (
EQ
 (fetch
 (MI Label) of
 mi)
					      (
QUOTE
 Reset))
				      THEN
 (
SETQ
 ResetAddr addr)))
	      else
 (PRINTOUT T "Illegal address / jump " (fetch
 (MI Ucode) of
 mi)
			       T)
		     (
BREAK1
 NIL T (help])