(FILECREATED "18-Jun-86 11:17:21" {ERIS}<TAMARIN>WORK>SIMULATE>TOPEDIT.;16 15709
changes to: (VARS TOPEDITCOMS)
(FNS TOP.SAVEFN)
previous date: " 8-May-86 16:14:01" {ERIS}<TAMARIN>WORK>SIMULATE>TOPEDIT.;15)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TOPEDITCOMS)
(RPAQQ TOPEDITCOMS ((RECORDS TOPCODE)
(P (SETQ TOP.SORTNAMES NIL))
(FNS TOP.GETYN TOP.MAKEATOMS TOP.PUTOPCODE TOP.PUTVALUE TOP.RUN TOP.SELECTED TOP.SHOWMENU
TOP.UPDATE TOP.MAKERANGE TOP.SEARCHOPS TOP.SEARCHNAMES TOP.NEWLIST TOP.SAVEFN
TOP.MAXOPCODE TOP.SETPROPS MAKETAMOPCODEARRAY)))
[DECLARE: EVAL@COMPILE
(RECORD TOPCODE (OP# OPCODENAME OPNARGS OPPRINT LEVADJ UFNFN UNIMPL NOPUSH TEFN))
]
(SETQ TOP.SORTNAMES NIL)
(DEFINEQ
(TOP.GETYN
[LAMBDA (PW YNPROMPT NAME ENTERPROMPT) (* rtk "25-Mar-86 11:48")
(PROG ((CH NIL))
(TTYDISPLAYSTREAM PW)
(CONTROL T)
(while (READP NIL T) do (READC))
(if YNPROMPT
then (PRIN3 YNPROMPT)
(if NAME
then (PRIN3 NAME))
(PRIN3 " ?")
(SETQ CH (READC))
else (PRIN3 "N"))
(CONTROL NIL)
(if (OR (EQ CH (QUOTE Y))
(EQ CH (QUOTE y)))
then (PRIN3 "es")
(TERPRI)
(RETURN (if NAME
then NAME
else T))
else (PRIN3 "o")
(TERPRI)
(if ENTERPROMPT
then (PRIN3 ENTERPROMPT)
(RETURN (READ))
else (RETURN NIL])
(TOP.MAKEATOMS
[LAMBDA (OPCODELIST) (* jmh " 8-May-86 16:12")
(if TOP.SORTNAMES
then (SORT (for OPREC in OPCODELIST collect (fetch (TOPCODE OPCODENAME)
of OPREC)))
else (for OPREC in [SORT (COPY OPCODELIST)
(FUNCTION (LAMBDA (A B)
(LET ((NA (fetch (TOPCODE OP#) of A))
(NB (fetch (TOPCODE OP#) of B)))
(ILESSP (if (LISTP NA)
then (CAR NA)
else NA)
(if (LISTP NB)
then (CAR NB)
else NB]
collect (fetch (TOPCODE OPCODENAME) of OPREC])
(TOP.PUTOPCODE
[LAMBDA (OPCODELIST NEWREC) (* edited: "11-Mar-86 12:47")
(PROG ([NEWLO (CAR (TOP.MAKERANGE (fetch (TOPCODE OP#) of NEWREC]
WORKLIST)
(SETQ WORKLIST (for W in OPCODELIST while (LESSP (CADR (TOP.MAKERANGE
(fetch (TOPCODE OP#)
of W)))
NEWLO)
collect W))
(SETQ WORKLIST (APPEND WORKLIST (CONS NEWREC NIL)
(LDIFFERENCE OPCODELIST WORKLIST)))
(RETURN WORKLIST])
(TOP.PUTVALUE
[LAMBDA (INSPECTWINDOW) (* rtk "25-Mar-86 11:31")
(PROG (OLDREC NEWREC MAINWINDOW ATOMLIST OPRANGE MATCHOPS OPLIST OPCODEPROP PROMPTW MODE TEMPLIST)
[SETQ MODE (MENU (create MENU
ITEMS ←(QUOTE (Update Delete Ignore]
(SETQ MAINWINDOW (WINDOWPROP INSPECTWINDOW (QUOTE MAINWINDOW)))
(SETQ ATOMLIST (WINDOWPROP MAINWINDOW (QUOTE ATOMLIST)))
(SETQ OPLIST (WINDOWPROP MAINWINDOW (QUOTE OPCODELIST)))
(SETQ OPCODEPROP (WINDOWPROP MAINWINDOW (QUOTE OPPROP)))
(SETQ PROMPTW (WINDOWPROP MAINWINDOW (QUOTE PROMPTW)))
(SETQ OLDREC (WINDOWPROP INSPECTWINDOW (QUOTE OLDREC)))
(SETQ NEWREC (WINDOWPROP INSPECTWINDOW (QUOTE NEWREC)))
(if (NULL (fetch (TOPCODE OP#) of NEWREC))
then (replace (TOPCODE OP#) of NEWREC with (TOP.MAXOPCODE OPLIST)))
(SETQ OPRANGE (TOP.MAKERANGE (fetch (TOPCODE OP#) of NEWREC)))
(if (OR (EQUAL MODE (QUOTE Update))
(EQUAL MODE (QUOTE Delete)))
then (SETQ MATCHOPS (TOP.SEARCHOPS OPLIST OPRANGE))
(SETQ TEMPLIST (TOP.SEARCHNAMES OPLIST (fetch (OPCODE OPCODENAME)
of NEWREC)))
(SETQ MATCHOPS (APPEND MATCHOPS (for W in TEMPLIST
when (NULL (MEMBER W MATCHOPS))
collect W)))
[if (OR (EQUAL (LENGTH MATCHOPS)
0)
(AND (EQUAL (LENGTH MATCHOPS)
1)
(EQUAL (CAR MATCHOPS)
OLDREC)))
then (WINDOWPROP MAINWINDOW (QUOTE OPCODELIST)
(TOP.UPDATE OPLIST MATCHOPS NEWREC OPCODEPROP MODE))
else (PRINTOUT PROMPTW "WARNING!! " (LENGTH MATCHOPS)
" Opcodes Must be Removed")
(TERPRI PROMPTW)
(PRINTOUT PROMPTW MATCHOPS)
(if (EQ [MENU (create MENU
ITEMS ←(QUOTE (Update Abort]
(QUOTE Update))
then (WINDOWPROP MAINWINDOW (QUOTE OPCODELIST)
(TOP.UPDATE OPLIST MATCHOPS NEWREC OPCODEPROP
MODE))
else (SETQ NEWREC OLDREC)
(SETQ MATCHOPS (LIST OLDREC]
(if (AND (EQ (LENGTH MATCHOPS)
1)
(EQ MODE (QUOTE Update)))
then (if [OR [NULL (EQUAL OPRANGE (TOP.MAKERANGE (fetch
(OPCODE OP#)
of (CAR MATCHOPS]
(NULL (EQUAL (fetch (TOPCODE OPCODENAME) of NEWREC)
(fetch (TOPCODE OPCODENAME)
of (CAR MATCHOPS]
then (TOP.NEWLIST MAINWINDOW))
else (TOP.NEWLIST MAINWINDOW)))
(if (FMEMB PROMPTW (OPENWINDOWS))
then (PRINTOUT PROMPTW " ")
(TERPRI PROMPTW)
(TERPRI PROMPTW))
(if (FMEMB MODE (QUOTE (Update Delete)))
then (WINDOWPROP MAINWINDOW (QUOTE CHANGED)
T))
(if (FMEMB MODE (QUOTE (Update Delete Ignore)))
then (CLOSEW INSPECTWINDOW])
(TOP.RUN
[LAMBDA (OPLIST THEPROP) (* rtk "31-Mar-86 16:18")
(PROG (F (OPCODELIST NIL)
MENULIST THEPROPERTY SAVENAME)
(if OPLIST
then (SETQ OPCODELIST (COPYALL (EVAL OPLIST)))
(SETQ SAVENAME OPLIST)
(SETQ THEPROPERTY THEPROP)
else (SETQ MENULIST (QUOTE (Variable File)))
(if (NULL (BOUNDP (QUOTE \TAMOPCODES)))
then (SETQ \TAMOPCODES (COPYALL \OPCODES)))
[if (BOUNDP (QUOTE \TAMOPCODES))
then (SETQ MENULIST (QUOTE (\TAMOPCODES Variable File]
(if (BOUNDP (QUOTE \OPCODES))
then (SETQ MENULIST (CONS (QUOTE \OPCODES)
MENULIST)))
(SELECTQ (MENU (create MENU
ITEMS ← MENULIST
TITLE ← "Select Opcode List"))
((QUOTE Variable)
(PRINTOUT T "Enter Variable Name: ")
(SETQ SAVENAME (READ))
(SETQ OPCODELIST (COPYALL (EVAL SAVENAME)))
(PRINTOUT T "Enter Property Value: ")
(SETQ THEPROPERTY (READ)))
((QUOTE File)
(PRINTOUT T "File Name : ")
(SETQ SAVENAME (READ))
(SETQ F (OPENSTREAM SAVENAME (QUOTE INPUT)))
(PRINTOUT T (CONCAT "Reading File " SAVENAME))
(SETQ THEPROPERTY (READ F))
(SETQ OPCODELIST (HREAD F))
(CLOSEF F)
(PRINTOUT T "Done Reading"))
((QUOTE \TAMOPCODES)
(SETQ OPCODELIST \TAMOPCODES)
(SETQ THEPROPERTY (QUOTE TOPCODE))
(SETQ SAVENAME (QUOTE \TAMOPCODES)))
((QUOTE \OPCODES)
(SETQ OPCODELIST \OPCODES)
(SETQ THEPROPERTY (QUOTE DOPCODE))
(SETQ SAVENAME (QUOTE \OPCODES)))
(NIL)))
(if OPCODELIST
then (PRINTOUT T "Making Opcode Menu")
[PROG ((FULLREC (create TOPCODE)))
(for W in OPCODELIST do (while (LESSP (LENGTH W)
(LENGTH FULLREC))
do (NCONC1 W NIL]
(TOP.SETPROPS OPCODELIST THEPROPERTY)
(TOP.SHOWMENU NIL OPCODELIST THEPROPERTY SAVENAME])
(TOP.SELECTED
[LAMBDA (SELECTEDITEM THEMENU THEMOUSE) (* edited: "11-Mar-86 12:51")
(if (EQ THEMOUSE (QUOTE LEFT))
then (PROG (NEWREC OLDREC INSPECTWINDOW)
[SETQ OLDREC (COPYALL (for OPREC in (WINDOWPROP (WFROMMENU THEMENU)
(QUOTE OPCODELIST))
thereis (EQ (fetch (TOPCODE OPCODENAME)
of OPREC)
SELECTEDITEM]
(if (NULL OLDREC)
then (SETQ OLDREC (create TOPCODE)))
(SETQ NEWREC (COPYALL OLDREC))
(SETQ INSPECTWINDOW (INSPECT NEWREC (QUOTE TOPCODE)))
(WINDOWPROP INSPECTWINDOW (QUOTE MAINWINDOW)
(WFROMMENU THEMENU))
(WINDOWPROP INSPECTWINDOW (QUOTE OLDREC)
OLDREC)
(WINDOWPROP INSPECTWINDOW (QUOTE NEWREC)
NEWREC)
(WINDOWPROP INSPECTWINDOW (QUOTE RIGHTBUTTONFN)
(QUOTE TOP.PUTVALUE])
(TOP.SHOWMENU
[LAMBDA (MAINWINDOW OPCODELIST OPPROP SAVENAME) (* edited: "11-Feb-86 13:53")
(PROG (MYMENU NEWMENU (ATOMLIST (TOP.MAKEATOMS OPCODELIST)))
[if MAINWINDOW
then (DELETEMENU (WINDOWPROP MAINWINDOW (QUOTE MAINMENU)))
(SETQ SAVENAME (WINDOWPROP MAINWINDOW (QUOTE SAVENAME]
(SETQ MYMENU (create MENU
ITEMS ← ATOMLIST
WHENSELECTEDFN ←(QUOTE TOP.SELECTED)
TITLE ←(CONCAT "Edition Opcode Definitions of: " SAVENAME
" Property: "
OPPROP)
MENUCOLUMNS ← 4
MENUROWS ← 64))
(if MAINWINDOW
then (ADDMENU MYMENU MAINWINDOW)
else (SETQ MAINWINDOW (ADDMENU MYMENU MAINWINDOW
(create POSITION
XCOORD ← 300
YCOORD ← 0)))
(WINDOWPROP MAINWINDOW (QUOTE PROMPTW)
(GETPROMPTWINDOW MAINWINDOW 3))
(WINDOWPROP MAINWINDOW (QUOTE SAVENAME)
SAVENAME))
(WINDOWPROP MAINWINDOW (QUOTE RIGHTBUTTONFN)
(QUOTE TOP.SAVEFN))
(WINDOWPROP MAINWINDOW (QUOTE MAINMENU)
MYMENU)
(WINDOWPROP MAINWINDOW (QUOTE ATOMLIST)
ATOMLIST)
(WINDOWPROP MAINWINDOW (QUOTE OPCODELIST)
OPCODELIST)
(WINDOWPROP MAINWINDOW (QUOTE OPPROP)
OPPROP])
(TOP.UPDATE
[LAMBDA (OPCODELIST REMOVELIST NEWREC OPCODEPROP MODE) (* edited: "11-Mar-86 12:42")
(for W in REMOVELIST do (SETQ OPCODELIST (for X in OPCODELIST
when (NULL (EQUAL W X)) collect X)))
(if (EQUAL MODE (QUOTE Update))
then (TOP.PUTOPCODE OPCODELIST NEWREC)
else OPCODELIST])
(TOP.MAKERANGE
[LAMBDA (OPCODE) (* rtk "10-Feb-86 15:29")
(if (LISTP OPCODE)
then OPCODE
else (LIST OPCODE OPCODE])
(TOP.SEARCHOPS
[LAMBDA (OPLIST OPRANGE) (* rtk "10-Feb-86 15:22")
(PROG (VAL (RESULTOPS NIL))
[for W in OPLIST
do (SETQ VAL (TOP.MAKERANGE (fetch (OPCODE OP#) of W)))
(if [OR (AND (GEQ (CAR VAL)
(CAR OPRANGE))
(LEQ (CAR VAL)
(CADR OPRANGE)))
(AND (GEQ (CADR VAL)
(CAR OPRANGE))
(LEQ (CADR VAL)
(CADR OPRANGE]
then (SETQ RESULTOPS (CONS W RESULTOPS]
(RETURN RESULTOPS])
(TOP.SEARCHNAMES
[LAMBDA (OPLIST OPNAME) (* rtk "10-Feb-86 11:36")
(for W in OPLIST when (EQUAL OPNAME (fetch (OPCODE OPCODENAME) of W)) collect W])
(TOP.NEWLIST
[LAMBDA (MAINW) (* edited: "10-Feb-86 17:21")
(TOP.SHOWMENU MAINW (WINDOWPROP MAINW (QUOTE OPCODELIST))
(WINDOWPROP MAINW (QUOTE OPPROP])
(TOP.SAVEFN
[LAMBDA (MAINWINDOW) (* rtk "18-Jun-86 11:16")
(PROG (F MENULIST SAVENAME OPCODELIST THEPROPERTY PW)
(SETQ SAVENAME (WINDOWPROP MAINWINDOW (QUOTE SAVENAME)))
(SETQ THEPROPERTY (WINDOWPROP MAINWINDOW (QUOTE OPPROP)))
(SETQ OPCODELIST (WINDOWPROP MAINWINDOW (QUOTE OPCODELIST)))
(SETQ PW (WINDOWPROP MAINWINDOW (QUOTE PROMPTW)))
(TTYDISPLAYSTREAM PW)
(SELECTQ (MENU (create MENU
ITEMS ←(QUOTE (Save Close Bury Move Alpha Numeric))
TITLE ← "Opcode Window"))
(Alpha (SETQ TOP.SORTNAMES T)
(TOP.NEWLIST MAINWINDOW))
(Numeric (SETQ TOP.SORTNAMES NIL)
(TOP.NEWLIST MAINWINDOW))
(Save (SETQ MENULIST (QUOTE (Variable File)))
[if (BOUNDP (QUOTE \TAMOPCODES))
then (SETQ MENULIST (QUOTE (\TAMOPCODES Variable File]
(if (BOUNDP (QUOTE \OPCODES))
then (SETQ MENULIST (CONS (QUOTE \OPCODES)
MENULIST)))
(SELECTQ (MENU (create MENU
ITEMS ← MENULIST
TITLE ← "Save Opcodes As:"))
(Variable (SETQ SAVENAME (TOP.GETYN PW "Use Variable "
SAVENAME
"Variable Name: "))
(SET SAVENAME (COPYALL OPCODELIST))
(TOP.SETPROPS OPCODELIST THEPROPERTY))
(File (SETQ SAVENAME (TOP.GETYN PW "Use File " SAVENAME
"Output File: "))
(SETQ F (OPENSTREAM SAVENAME (QUOTE OUTPUT)))
(PRIN3 "Saving on file: ")
(PRINT SAVENAME)
(PRINT THEPROPERTY F)
(HPRINT OPCODELIST F)
(CLOSEF F)
(PRINT "Save Completed")
(TOP.SETPROPS OPCODELIST THEPROPERTY))
(\TAMOPCODES (SETQ \TAMOPCODES OPCODELIST)
(TOP.SETPROPS OPCODELIST THEPROPERTY)
(MAKETAMOPCODEARRAY))
(\OPCODES (SETQ \OPCODES OPCODELIST)
(TOP.SETPROPS OPCODELIST THEPROPERTY))
(TERPRI))
(WINDOWPROP MAINWINDOW (QUOTE CHANGED)
NIL))
(Close (if (OR (NULL (WINDOWPROP MAINWINDOW (QUOTE CHANGED)))
(TOP.GETYN PW "Not Saved, Do you really Want to Exit"))
then (CLOSEW PW)
(CLOSEW MAINWINDOW)))
(Bury (BURYW MAINWINDOW)
(RETURN NIL))
(Move (MOVEW MAINWINDOW))
(TERPRI)
(TERPRI)
(TERPRI))
(if (MEMBER PW (OPENWINDOWS))
then (TERPRI)
(TERPRI)
(TERPRI)
(TTYDISPLAYSTREAM])
(TOP.MAXOPCODE
[LAMBDA (OPLIST) (* rtk "24-Mar-86 15:56")
(LET ((MAXOP 0))
[FOR I IN OPLIST DO (SETQ MAXOP (MAX MAXOP (CADR (TOP.MAKERANGE (FETCH
(TOPCODE OP#)
OF I]
(IPLUS MAXOP 1])
(TOP.SETPROPS
[LAMBDA (OPCODELIST THEPROP) (* edited: "11-Mar-86 12:50")
(for W in OPCODELIST do (PUTPROP (fetch (TOPCODE OPCODENAME) of W)
THEPROP W])
(MAKETAMOPCODEARRAY
[LAMBDA NIL (* rtk "18-Mar-86 07:48")
(LET (OPNUM LOCARR)
(SETQ LOCARR (ARRAY 256 (QUOTE POINTER)
NIL 0))
(PRINT "MAKEING \TAMOPCODEARRAY")
(for I in \TAMOPCODES
do (PUTPROP (fetch (TOPCODE OPCODENAME) of I)
(QUOTE TOPCODE)
I)
(SETQ OPNUM (fetch (TOPCODE OP#) of I))
(if (LISTP OPNUM)
then (for J from (CAR OPNUM) to (CADR OPNUM)
do (SETA LOCARR J I))
else (SETA LOCARR OPNUM I)))
(SETQ \TAMOPCODEARRAY LOCARR])
)
(PUTPROPS TOPEDIT COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (780 15631 (TOP.GETYN 790 . 1562) (TOP.MAKEATOMS 1564 . 2290) (TOP.PUTOPCODE 2292 . 2826
) (TOP.PUTVALUE 2828 . 5806) (TOP.RUN 5808 . 7883) (TOP.SELECTED 7885 . 8766) (TOP.SHOWMENU 8768 .
10076) (TOP.UPDATE 10078 . 10447) (TOP.MAKERANGE 10449 . 10639) (TOP.SEARCHOPS 10641 . 11184) (
TOP.SEARCHNAMES 11186 . 11407) (TOP.NEWLIST 11409 . 11642) (TOP.SAVEFN 11644 . 14403) (TOP.MAXOPCODE
14405 . 14712) (TOP.SETPROPS 14714 . 14937) (MAKETAMOPCODEARRAY 14939 . 15629)))))
STOP