github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-05 16:14:50 +00:00
Code Issues Releases Wiki Activity

Builds all LISP; * FASL files that are on autoload properties when

Browse Source 
the lisp interpreter is first booted.

Redumps lisp compiler with updated FASL files built from source.
This commit is contained in:
Eric Swenson
2018-10-01 12:25:58 -07:00
parent 8f3e7b507c
commit cc8e6c1964
33 changed files with 16469 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1262
src/l/allfil.132 Executable file
View File

File diff suppressed because it is too large Load Diff

467
src/l/bltarr.3 Executable file
View File

@@ -0,0 +1,467 @@
;;; BLTARR -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** BLTARRAY ********************************
;;; **************************************************************
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
.SYMTAB 16001. ;1863.rd prime
TITLE ***** MACLISP ****** BLTARRAY ********************************
;; To assemble on one kind of Operating system, for use on another,
;; you should use the "T" command line switch in order to insert one
;; of the redefinitions:
;; D10==1
;; D20==1
;; ITS==1
;; SAIL==1
.FASL
IF1,[
IFNDEF TOPS10, TOPS10==0
IFNDEF TOPS20, TOPS20==0
IFNDEF TENEX, TENEX==0
IFNDEF CMU, CMU==0
IFN TOPS10\CMU, D10==1
IFN TOPS20\TENEX, D20==1
IFE .OSMIDAS-<SIXBIT \ITS\>,[
IFNDEF D20, D20==0
IFNDEF D10, D10==0
IFNDEF SAIL SAIL==0
IFNDEF ITS,[
IFE D10+D20+SAIL, ITS==1
.ELSE ITS==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$% >
PRINTX \ ==> INSERTED: \
$FNAME .IFNM1
PRINTX \ \
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \ITS\>,
IFE .OSMIDAS-<SIXBIT \DEC\>,[
IFNDEF ITS, ITS==0
IFNDEF D20, D20==0
IFNDEF SAIL SAIL==0
IFNDEF D10,[
IFE ITS+D20+SAIL, D10==1
.ELSE D10==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$%!.MID
PRINTX \INSERTED: \
$FNAME .IFNM1
PRINTX \.\
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \DEC\>,
IFE .OSMIDAS-<SIXBIT \TWENEX\>,[
IFNDEF ITS, ITS==0
IFNDEF D10, D10==0
IFNDEF SAIL SAIL==0
IFNDEF D20,[
IFE ITS+D10+SAIL, D20==1
.ELSE D20==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$%!.MID
PRINTX \INSERTED: \
$FNAME .IFNM1
PRINTX \.\
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \TWENEX\>,
IFE .OSMIDAS-<SIXBIT \SAIL\>,[
IFNDEF ITS, ITS==0
IFNDEF D10, D10==0
IFNDEF D20, D20==0
IFNDEF SAIL,[
IFE ITS+D10+D20, SAIL==1
.ELSE SAIL==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$%!.MID
PRINTX \INSERTED: \
$FNAME .IFNM1
PRINTX \.\
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \SAIL\>,
IFNDEF $INSRT, .FATAL SO WHAT KIND OF OPERATING SYSTEM IS THIS ANYWAY???
DEFINE $FNAME FOO ;PRINTX A FILE NAME GIVEN NUMERIC SIXBIT
ZZX==<FOO>
REPEAT 6,[
IRPNC ZZX_-36,1,1,Q,,[ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ(\)^_]
IFSN [Q][ ] PRINTX |Q|
TERMIN
ZZX==ZZX_6
]
TERMIN
IFN ITS+D10+D20+SAIL-1,[
INFORM [
ITS=]\ITS,[ D10=]\D10,[ D20=]\D20,[ SAIL=]\SAIL
.FATAL ITS, D10, D20, and SAIL switches are not consistent
] ;END OF IFN ITS+D10+D20+SAIL-1
D10==:TOPS10\CMU ;SWITCH FOR DEC-10-LIKE SYSTEMS
D20==:TOPS20\TENEX ;SWITCH FOR DEC-20-LIKE SYSTEMS
IFN D10,[
PRINTX \ASSEMBLING DEC-10 BLTARRAY
\
]
IFN D20,[
PRINTX \ASSEMBLING DEC-20 BLTARRAY
\
]
IFN ITS,[
PRINTX \ASSEMBLING ITS BLTARRAY
\
]
IFN SAIL, D10==1
$INSRT FASDFS
;;; MAKE SURE THE SYMBOLS WE WILL NEED ARE DEFINED.
;;; THEY MAY NOT BE IF ASSEMBLING FOR A DIFFERENT OPERATING SYSTEM
DEFINE FLUSHER DEF/
IRPS SYM,,[DEF]
EXPUNGE SYM
.ISTOP
TERMIN
TERMIN
DEFINE SYMFLS TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
IFE <.OSMIDAS-SIXBIT\OS\>,[
IFE TARGETSYS,[
PRINTX \FLUSHING OS SYMBOL DEFINITIONS
\
$INSRT .DEFS.
DEFFER FLUSHER
IFSN .BITS.,,[
PRINTX \FLUSHING OS BIT DEFINITIONS
\
EQUALS DEFSYM,FLUSHER
$INSRT .BITS.
EXPUNGE DEFSYM
] ;END OF IFSN .BITS.
] ;END OF IFE TARGETSYS
] ;END OF IFE <.OSMIDAS-SIXBIT\OS\>
TERMIN
DEFINE SYMDEF TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
IFN TARGETSYS,[
IFN <.OSMIDAS-SIXBIT\OS\>,[
PRINTX \MAKING OS SYMBOL DEFINITIONS
\
$INSRT .DEFS.
DEFFER
IFSN .BITS.,,[
PRINTX \MAKING OS BIT DEFINITIONS
\
$INSRT .BITS.
] ;END OF IFSN .BITS.,,
] ;END OF IFN <.OSMIDAS-SIXBIT\OS\>
.ELSE,[
IFNDEF CHKSYM,[
PRINTX \FUNNY - RUNNING ON OS, BUT CHKSYM UNDEFINED; MAKING OS SYMBOL DEFINITIONS
\
$INSRT .DEFS.
DEFFER
] ;END OF IFNDEF CHKSYM
IFSN .BITS.,,[
IFNDEF CHKBIT,[
PRINTX \FUNNY - RUNNING ON OS, BUT CHKBIT UNDEFINED; MAKING OS BIT DEFINITIONS
\
$INSRT .BITS.
] ;END OF IFNDEF CHKBIT
] ;END OF IFSN .BITS.,,
] ;END OF .ELSE
] ;END OF IFN TARGETSYS
TERMIN
IRP HACK,,[SYMFLS,SYMDEF]
HACK ITS,ITS,ITSDFS,.ITSDF,.IOT,ITSBTS,%PIC.Z
HACK TOPS10,DEC,DECDFS,.DECDF,LOOKUP,DECBTS,.GTSTS
HACK TOPS20,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
HACK TENEX,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
HACK SAIL,SAIL,SAIDFS,.DECDF,SPCWAR,DECBTS,.GTSTS
TERMIN
] ;END OF IF1
VERPRT BLTARRAY
.ENTRY BLTARRAY SUBR 3 ;2 ARGS
EXCH A,B ;GRUMBLE! CALLED BY FILLARRAY
SOVE B C AR1 AR2A
PUSHJ P,AREGET
MOVEI AR1,(A)
HRRZ A,-3(P)
BLTAR1: PUSHJ P,AREGET
MOVEI AR2A,(A)
MOVE T,ASAR(AR1)
MOVE TT,ASAR(AR2A)
;; NEXT FEW LINES SHOULD BE CONDITIONAL ON HAVING JOBQIO
TLNE T,AS.JOB
JRST BLTALS
TLNE TT,AS.JOB
JRST BLTALZ
TLNE T,AS.FIL
JRST BLTI1
TLNE TT,AS.FIL
JRST BLTO1
LOCKI
PUSHJ P,.REA3
JRST BLTALZ ;ARRAY TYPES DON'T MATCH - LOSE LOSE
BLTXIT: RSTR AR2A AR1 C
UNLOCKI
JRST POPAJ
BLTALZ: UNLOCKI
MOVEI A,(AR2A)
WTA [BAD TARGET ARRAY TYPE - BLTARRAY!]
MOVEI AR2A,(A)
JRST BLTAR1
BLTALS: UNLOCKI
MOVEI A,(AR1)
WTA [BAD SOURCE ARRAY TYPE - BLTARRAY!]
MOVEI AR1,(A)
JRST BLTAR1
;FILL OUTPUT FILE IN AR2A FROM ARRAY IN AR1.
BLTO1: TLNE T,AS.FIL+AS.RDT+AS.OBA+AS.GCP ;FILES, READTABLES, OBARRAYS, S-EXPS BAD
JRST BLTALS
EXCH AR1,AR2A
PUSHJ P,XOFLOK ;MAKE SURE TARGET ARRAY IS BINARY OUTPUT
IFN ITS,[
PUSHJ P,IFORCE ;FORCE OUT CURRENT BUFFER, IF ANY
MOVEI A,(AR2A)
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
MOVE D,TT ;MOVE INTO D
HRRZ T,TTSAR(AR2A)
HRLI T,444400 ;SET UP BYTE POINTER (BYTE = 36. BITS)
MOVE TT,TTSAR(AR1)
ADDM D,F.FPOS(TT)
.CALL BSIOT ;TRANSFER DATA TO FILE
.LOSE 1400
JSP D,BFORC6 ;UPDATE FILE OBJECT VARIABLES
] ;END OF IFN ITS
IFN D20,[
PUSHJ P,IFORCE ;FORCE OUT CURRENT BUFFER, IF ANY
MOVEI A,(AR2A)
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
HRRZ 2,TTSAR(AR2A)
HRLI 2,444400 ;SET UP BYTE POINTER (BYTE = 36. BITS)
MOVN 3,TT ;NEGATIVE OF NUMBER OF BYTES
MOVE D,TT
MOVE TT,TTSAR(AR1)
HRRZ 1,F.JFN(TT) ;GET JFN FOR FILE
ADDM D,F.FPOS(TT)
SOUT ;TRANSFER DATA TO FILE
SETZB 2,3 ;FLUSH CRUD FROM AC'S
JSP D,BFORC6 ;UPDATE FILE OBJECT VARIABLES
] ;END OF IFN D20
IFN D10,[
MOVEI A,(AR2A)
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
MOVE T,TTSAR(AR2A)
MOVE F,TTSAR(AR1)
MOVE B,F.CHAN(F) ;GET CHANNEL NUMBER FOR I/O FILE
LSH B,27
TLO B,(OUT 0,) ;CONSTRUCT AN OUT INSTRUCTION
MOVE A,FB.HED(F) ;GET ADDRESS OF BUFFER HEADER BLOCK
BLTO3: MOVE D,1(A) ;GET BYTE POINTER INTO BUFFER
ADDI D,1 ;ADDRESS OF FIRST FREE WORD IN BUFFER
HRLI D,(T) ;ADDRESS OF NEXT DATA WORD TO TRANSFER
SKIPN R,2(A) ;GET COUNT OF FREE BUFFER WORDS IN R
JRST BLTO4 ;OOPS, NONE - GO OUTPUT THIS BUFFER
CAILE R,(TT) ;IF REST OF DATA FITS IN BUFFER,
MOVEI R,(TT) ; TRANSFER NO MORE THAN NECESSARY
SUB TT,2(A) ;SUBTRACT FREE WORDS IN BUFFER FROM COUNT OF REMAINING DATA
MOVNS R
ADDM R,2(A) ;ADJUST BUFFER FREE COUNT FOR WORDS TRANSFERRED
MOVNS R
ADDB R,1(A) ;ADJUST BYTE POINTER, GET FINAL ADDRESS
BLT D,(R)
JUMPL TT,BLTXIT ;DIDN'T COMPLETELY FILL THIS LAST BUFFER, SO EXIT
BLTO4: XCT B ;OUTPUT THIS BUFFER
CAIA
HALT ;? THE OUTPUT LOST SOMEHOW
MOVE D,FB.BFL(F)
ADDM D,F.FPOS(F) ;UPDATE FILEPOS
JUMPG TT,BLTO3 ;GO AROUND AGAIN IF MORE DATA LEFT
] ;END OF IFN D10
JRST BLTXIT
IFN ITS+D20,[
BFORC6: MOVE T,FB.BFL(TT) ;ROUTINE TO INITIALIZE BYTE POINTER AND COUNT
MOVEM T,FB.CNT(TT)
MOVE T,FB.IBP(TT)
MOVEM T,FB.BP(TT)
JRST (D)
];END IFN ITS+D20
;FILL ARRAY IN AR2A FROM FILE IN AR1.
BLTI1: TLNE TT,AS.FIL+AS.RDT+AS.OBA+AS.GCP ;FILES, READTABLES, OBARRAYS, S-EXPS BAD
JRST BLTALZ
PUSHJ P,XIFLOK ;MAKE SURE SOURCE IS AN INPUT BINARY FILE
IFN ITS+D20,[
MOVEI A,(AR2A)
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
MOVE T,TTSAR(AR2A)
MOVE F,TTSAR(AR1)
SKIPN R,FB.CNT(F) ;GET NUMBER OF DATA WORDS IN INPUT BUFFER
JRST BLTI4 ;NONE, GO DO DIRECT INPUT
CAILE R,(TT) ;TRANSFER NO MORE WORDS THAN
MOVEI R,(TT) ; THE TARGET ARRAY WILL HOLD
SUBI TT,(R) ;ADJUST COUNT FOR NUMBER OF WORDS TRANSFERRED
MOVN D,R
ADDM D,FB.CNT(F) ;ADJUST BYTE COUNT IN FILE OBJECT
IBP FB.BP(F) ;BYTE POINTER TO POINT TO FIRST BYTE WE WANT
MOVE D,FB.BP(F)
HRLI D,(D) ;ADDRESS OF FIRST WORD OF INPUT DATA
HRRI D,(T)
ADDI T,(R) ;UPDATE POINTER INTO TARGET ARRAY
SUBI R,1 ;FOR CORRECT UPDATING, R IS 1 TOO BIG
ADDM R,FB.BP(F) ;UPDATE FILE BYTE POINTER
BLT D,-1(T) ;TRANSFER DATA
JUMPLE TT,BLTXIT ;EXIT IF WE GOT ENOUGH DATA
MOVE D,FB.BVC(F)
ADDM D,F.FPOS(F)
SETZM FB.BVC(F)
BLTI4:
IFN ITS,[
MOVE R,TT
MOVE D,TT ;GET COUNT OF BYTES
MOVE TT,F
HRLI T,444400 ;MAKE BYTE POINTER (BYTE = 36. BITS)
.CALL BSIOT ;INPUT MORE DATA
.LOSE 1400
SUB R,D
ADDM R,F.FPOS(TT) ;UPDATE THE FILE POSITION
JUMPE D,BLTXIT ;JUMP IF WE GOT ALL THE DATA
] ;END OF IFN ITS
IFN D20,[
HRRZ 1,F.JFN(F) ;GET JFN FOR FILE
MOVEI 2,(T)
HRLI 2,444400 ;MAKE BYTE POINTER (BYTE = 36. BITS)
MOVN 3,TT
SIN ;INPUT MORE DATA
ADD TT,3 ;NOT ADDI!!!
ADDM TT,F.FPOS(F) ;UPDATE THE FILE POSITION
MOVE D,3
SETZB 2,3 ;FLUSH JUNK FROM AC'S
JUMPE D,BLTXIT ;JUMP IF WE GOT ALL THE DATA
] ;END OF IFN D20
] ;END OF IFN ITS+D20
IFN D10,[
MOVEI A,(AR2A)
JSP T,ARYSIZ ;GET NUMBER OF DATA WORDS IN TT
MOVE T,TTSAR(AR2A)
MOVE F,TTSAR(AR1)
MOVE B,F.CHAN(F) ;GET CHANNEL NUMBER FOR FILE
LSH B,27
TLO B,(IN 0,) ;CONSTRUCT AN IN INSTRUCTION
MOVE A,FB.HED(F) ;GET ADDRESS OF BUFFER HEADER BLOCK
BLTI3: SKIPN R,2(A) ;CHECK NUMBER OF WORDS IN THIS BUFFER
JRST BLTI5 ;NONE - GO READ SOME MORE
CAILE R,(TT) ;DON'T TRANSFER MORE WORDS
MOVEI R,(TT) ; THAN THE TARGET ARRAY NEEDS
SUBI TT,(R) ;ADJUST COUNT OF WORDS NEEDED
MOVN D,R
ADDM D,2(A) ;ADJUST COUNT IN BUFFER HEADER
MOVE D,1(A) ;GET BYTE POINTER TO INPUT BUFFER
HRLI D,1(D)
HRRI D,(T) ;FORM BLT POINTER
ADDI T,(R) ;UPDATE POINTER INTO TARGET ARRAY
ADDM R,1(A) ;UPDATE INPUT BUFFER BYTE POINTER
BLT D,-1(T) ;TRANSFER DATA TO TARGET ARRAY
JUMPLE TT,BLTXIT ;EXIT IF WE GOT ENOUGH DATA
BLTI5: XCT B ;GET MORE DATA
JRST BLTI6 ;JUMP IF AN ERROR OCCURRED
MOVE D,FB.BFL(F)
ADDM D,F.FPOS(F) ;UPDATE FILE POSITION
JRST BLTI3
BLTI6: MOVE D,B ;CONSTRUCT A TEST FOR END OF FILE
XOR D,[<STATO 0,IO.EOF>#<IN 0,>]
XCT D
HALT ;LOSE TOTALLY IF NOT END OF FILE
] ;END OF IFN D10
HRRZ C,FI.EOF(TT) ;GET EOF FUNCTION FOR FILE
UNLOCKI
JUMPE C,BLTI8
MOVEI A,(AR1)
JCALLF 1,(C) ;CALL USER EOF FUNCTION
BLTI8: MOVEI A,(AR2A)
CALL 1,.FUNCTION NCONS
MOVEI B,(AR1)
CALL 2,.FUNCTION XCONS
MOVEI B,.ATOM FILLARRAY
CALL 2,.FUNCTION XCONS
IOL [EOF - FILLARRAY!] ;ELSE GIVE IO-LOSSAGE ERROR
IFN ITS,[
BSIOT: SETZ
SIXBIT \SIOT\ ;STRING I/O TRANSFER
,,F.CHAN(TT) ;CHANNEL #
,,T ;BYTE POINTER
400000,,D ;BYTE COUNT
]
FASEND

707
src/l/getmid.18 Executable file
View File

@@ -0,0 +1,707 @@
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** MIDAS OP-DECODER (GETMIDASOP) ***********
;;; **************************************************************
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
TITLE ***** MACLISP ****** MIDAS OP-DECODER (GETMIDASOP) ***********
;; To assemble on one kind of Operating system, for use on another,
;; you should use the "T" command line switch in order to insert one
;; of the redefinitions:
;; D10==1
;; D20==1
;; ITS==1
;; SAIL==1
.FASL
IF1,[
IFNDEF TOPS10, TOPS10==0
IFNDEF TOPS20, TOPS20==0
IFNDEF TENEX, TENEX==0
IFNDEF CMU, CMU==0
IFN TOPS10\CMU, D10==1
IFN TOPS20\TENEX, D20==1
IFE .OSMIDAS-<SIXBIT \ITS\>,[
IFNDEF D10, D10==0
IFNDEF D20, D20==0
IFNDEF SAIL SAIL==0
IFNDEF ITS,[
IFE D10+D20+SAIL, ITS==1
.ELSE ITS==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$% >
PRINTX \ ==> INSERTED: \
$FNAME .IFNM1
PRINTX \ \
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \ITS\>,
IFE .OSMIDAS-<SIXBIT \DEC\>,[
IFNDEF ITS, ITS==0
IFNDEF D20, D20==0
IFNDEF SAIL SAIL==0
IFNDEF D10,[
IFE ITS+D20+SAIL, D10==1
.ELSE D10==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$%!.MID
PRINTX \INSERTED: \
$FNAME .IFNM1
PRINTX \.\
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \DEC\>,
IFE .OSMIDAS-<SIXBIT \TWENEX\>,[
IFNDEF ITS, ITS==0
IFNDEF D10, D10==0
IFNDEF SAIL SAIL==0
IFNDEF D20,[
IFE ITS+D10+SAIL, D20==1
.ELSE D20==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$%!.MID
PRINTX \INSERTED: \
$FNAME .IFNM1
PRINTX \.\
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \TWENEX\>,
IFE .OSMIDAS-<SIXBIT \SAIL\>,[
IFNDEF ITS, ITS==0
IFNDEF D10, D10==0
IFNDEF D20, D20==0
IFNDEF SAIL,[
IFE ITS+D10+D20, SAIL==1
.ELSE SAIL==0
]
DEFINE $INSRT $%$%$%
.INSRT $%$%$%!.MID
PRINTX \INSERTED: \
$FNAME .IFNM1
PRINTX \.\
$FNAME .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \SAIL\>,
IFNDEF $INSRT, .FATAL SO WHAT KIND OF OPERATING SYSTEM IS THIS ANYWAY???
DEFINE $FNAME FOO ;PRINTX A FILE NAME GIVEN NUMERIC SIXBIT
ZZX==<FOO>
REPEAT 6,[
IRPNC ZZX_-36,1,1,Q,,[ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ(\)^_]
IFSN [Q][ ] PRINTX |Q|
TERMIN
ZZX==ZZX_6
]
TERMIN
IFN ITS+D10+D20+SAIL-1,[
INFORM [
ITS=]\ITS,[ D10=]\D10,[ D20=]\D20,[ SAIL=]\SAIL
.FATAL ITS, D10, D20, and SAIL switches are not consistent
] ;END OF IFN ITS+D10+D20+SAIL-1
D10==:TOPS10\CMU ;SWITCH FOR DEC-10-LIKE SYSTEMS
D20==:TOPS20\TENEX ;SWITCH FOR DEC-20-LIKE SYSTEMS
IFN D10,[
PRINTX \ASSEMBLING OP-DECODER FOR DEC-10 STYLE SYSTEM
\
]
IFN D20,[
PRINTX \ASSEMBLING OP-DECODER FOR DEC-20 STYLE SYSTEM
\
]
IFN SAIL,[
PRINTX \ASSEMBLING OP-DECODER FOR SAIL SYSTEM
\
]
IFN ITS,[
PRINTX \ASSEMBLING OP-DECODER FOR ITS SYSTEM
\
]
IFN SAIL, D10==1
$INSRT FASDFS
] ;END OF IF1
VERPRT GETMIDASOP
.ENTRY GETMIDASOP SUBR 2 ;THIS SAYS "1 ARG"
GETMIDASOP:
PUSH FXP,[0] ;SIXBIT IN R, SQUOZE ON 0(FXP)
PUSH P,A ;THIS PUSH PURELY FOR GC PROTECTION DURING SQOZ|
HRLZS A ;A PSEUDO NCONS ON THE ARG
PUSH P,A
MOVEI A,(P)
NCALL 1, .FUNCTION SQOZ|
MOVEM TT,(FXP)
SUB P,[2,,2]
SETZB A,D ;NOTE THAT A HAS NIL UNTIL FURTHER NOTICE
LSHC D,6 ;D GETS FIRST CHARACTER
IT$ CAIN D,'. ;IS FIRST CHAR OF SYMBOL A .?
IT$ JRST GTMOP1 ;IF NOT, TRY SEARCHING MOBY OPCODE TABLE FOR IT
SETZB TT,AR2A ;TT HOLDS BINARY OPCODE, AR2A HOLDS TABLE INDEX
CAIL D,'L ;IF IT'S L OR HIGHER, LET'S SAVE TIME
MOVEI AR2A,OPTBLL-OPTABL ; BY STARTING HALFWAY DOWN THE FIRST LIST
GTMOP2: LDB T,[271400,,OPTABL(AR2A)] ;GET CHAR(S) FROM TABLE ENTRY
CAIN D,(T) ;COMPARE TO CHAR(S) FROM SIXBIT SYMBOL
JRST GTMOP3 ;A MATCH!
SKIPL OPTABL(AR2A) ;SKIP IF LAST ENTRY IN TABLE
AOJA AR2A,GTMOP2 ;ELSE TRY NEXT ENTRY
GMXIT: SUB FXP,[1,,1]
POPJ P, ;LOSE - A STILL HAS NIL
GTMOP3: ADD TT,OPTABL(AR2A) ;ADD OPCODE MODIFIER TO RUNNING SUM (EXTRA BITS DON'T HURT)
LDB T,[220400,,OPTABL(AR2A)] ;HOW MANY CHARS SHALL WE CHECK NEXT?
JUMPE T,GTMOP4 ;NONE - END OF THE TREE BRANCH
SETZ D,
LSHC D,(T) ;1 OR 2 CHARS - PUT THEM IN D
LDB AR2A,[111100,,OPTABL(AR2A)] ;PUT POINTER TO NEXT LIST IN AR2A
JRST GTMOP2 ;CONTINUE MOBY SEARCH
GTMOP4: JUMPN R,GMXIT ;REST OF SIXBIT SHOULD BE ZERO - ELSE LOSE (A STILL HAS NIL)
LSH TT,33 ;SHIFT 9 BIT OPCODE TO TOP OF WORD
GMXT1: JSP T,FIX1A" ;RETURN AS NUMERIC VALUE (HOORAY!)
JRST GMXIT
IFN ITS,[
GTMOP1: .EVAL TT, ;TRY GETTING SYM VAL FROM ITS SYSTEM
JRST GMXIT ;LOSE - A HAS NIL
JRST GMXT1 ;WIN - VALUE IS IN TT
] ;END OF IFN ITS
;;; THE FOLLOWING TABLE IS FOR USE BY THE GETMIDASOP ROUTINE IN DECODING PDP-10
;;; OPCODES. IT CONTAINS REPRESENTATIONS FOR ALL STANDARD PDP-10 OPCODE
;;; SYMBOLS, AS WELL AS THE LISP UUO'S LERR, LER2, LER3, LER4, ERINT, AND STRT.
;;; THE TABLE IS IN THE FORM OF A SET OF LISTS WHICH ARE LINKED TO ONE ANOTHER
;;; TO FORM A TREE. EACH LIST ENTRY IS ONE WORD IN THE FOLLOWING FORMAT:
;;; BIT 4.9 IF 1, INDICATES THE LAST ENTRY OF THE LIST
;;; BITS 4.3-4.8 FIRST OF TWO SIXBIT CHARS TO COMPARE
;;; BITS 3.6-4.2 SECOND OR ONLY SIXBIT CHAR TO COMPARE
;;; BIT 3.5 UNUSED
;;; BITS 3.1-3.4 6*<NUMBER OF CHARS IN ENTRIES IN NEXT LIST>
;;; ZERO IF THERE IS NO NEXT LIST - IMPLIES REST OF
;;; SYMBOL MUST BE BLANK
;;; BITS 2.1-2.9 OFFSET FROM BEGINNING OF TABLE POINTING TO NEXT
;;; LIST TO USE TO CONTINUE THE COMPARISON
;;; BITS 1.1-1.9 VALUE TO BE ADDED TO A RUNNING SUM TO PRODUCE
;;; THE BINARY OPCODE
;;; THE TREE IS TRACED BY BEGINNING WITH THE LIST STARTING AT LOCATION
;;; OPTABL. AT EACH STEP ONE THEN SCANS THE CURRENT LIST, COMPARING THE
;;; NEXT ONE OR TWO CHARACTERS OF THE SYMBOL TO THOSE IN THE TABLE.
;;; IF NO MATCH IS FOUND, THE SYMBOL IS NOT IN THE TBALE. IF A MATCH IS
;;; FOUND, BITS 1.1-1.9 ARE ADDED TO A RUNNING SUM, BITS 2.1-2.9 POINT
;;; TO THE NEXT LIST TO SCAN, AND BITS 3.1-3.4 INDICATE HOW MANY CHARACTERS
;;; OF THE SYMBOL TO COMPARE TO THAT TABLE. IF BITS 3.1-3.4 ARE ZERO,
;;; THEN IF THERE REMAIN NON-BLANK CHARACTERS IN THE SYMBOL, THE SYMBOL
;;; IS NOT IN THE TABLE; IF THE REST OF THE SYMBOL IS BLANK, THEN THE
;;; RUNNING SUM IS THE FINAL 9 BIT BINARY OPCODE.
DEFINE OP CHARS,OFFSET,OPVAL,LASTP ;CREATE LIST ENTRY FOR OPCODE TABLE
ZZZ==0
IRPC X,,[CHARS]
IFSE X,-, ZZZ==ZZZ_6
IFSN X,-, ZZZ==ZZZ_6+'X
TERMIN
IFSN LASTP,, ZZZ==ZZZ+11_14
<OFFSET>+<OPVAL>+ZZZ_27
TERMIN
DEFINE OPTB NAME,N ;CREATE SYMBOL TO USE AS SECOND ARG TO OP MACRO
IRPS Q,,[NAME]
Q==<.-OPTABL>_11(6*N)
TERMIN
TERMIN
.XCREF OP OPTB
;;; FOR THE DECSYSTEM-10 VERSION, THE FOLLOWING UUO'S ARE
;;; DEFINED IN ADDITION TO LISP UUO'S AND PDP-10 OPCODES.
;;; WARNING! THE VALUE SUPPLIED FOR THE SYMBOL "CALL" IS
;;; THAT FOR THE LISP UUO, NOT FOR THE DECSYSTEM-10 UUO!
;;; CALLI 47 MTAPE 72 STATO 61
;;; CLOSE 70 OPEN 50 STATZ 63
;;; ENTER 77 OUT 57 TTCALL 51
;;; GETSTS 62 OUTBUF 65 UGETF 73
;;; IN 56 OUTPUT 67 USETI 74
;;; INBUF 64 RELEASE 71 USETO 75
;;; INPUT 66 RENAME 55
;;; LOOKUP 76 SETSTS 60
;;; FOR THE SAIL VERSION THE FOLLOWING OPCODES ARE DEFINED
;;; CLKINT 717 DPYCLR 701 MAIL 710
;;; PGIOT 715 PPIOT 702 PTYUUO 711
;;; TTYUUO 051 UPGIOT 703 UPGMVE 713
;;; UPGMVM 714
OPTABL: OP A,OP.A ;INITIAL LETTERS FOR
OP B,OP.B ; ALL INSTRUCTIONS
OP C,OP.C
OP D,OP.D
OP E,OP.E
OP F,OP.F
10$ OP G,OP.G
OP H,OP.H
OP I,OP.I
OP J,OP.J,,*
OPTBLL: OP L,OP.L ;THIS LIST IS IN TWO
OP M,OP.M ; HALVES FOR SPEED
OP N,OP.N
OP O,OP.O ; IN SEARCHING
OP P,OP.P
OP R,OP.R
OP S,OP.S
OP T,OP.T
OP U,OP.U
OP X,OP.X,,*
OPTB OP.A:,2
OP DD,OP.IMB,270 ;ADD--
OP ND,OP.AND,404 ;AND--
OP OB,OP.AOB,252 ;AOBJP, AOBJN
OP OJ,OP.CND,340 ;AOJ--
OP OS,OP.CND,350 ;AOS--
OP SH,OP.SHF,240 ;ASH, ASHC
OP CA,OP.%LL,002 ;CALL, CALLF
OP JC,OP.AJC,003,* ;AJCALL
OPTB OP.B:,2
OP LT,,251,* ;BLT
OPTB OP.C:,2
OP AI,OP.CND,300 ;CAI--
OP AM,OP.CND,310 ;CAM--
SA$ OP HN,OP.STS,716 ;CHNSTS (SAIL)
10% OP IR,OP.CIR,243 ;CIRC (AI-ITS ONLY)
SA$ OP LK,OP.%NT,717 ;CLKINT (SAIL)
10$ OP LO,OP.%SE,070 ;CLOSE (D10 ONLY)
OP AL,OP.CAL,,* ;CALL, CALLF; CALLI
OPTB OP.D:,2
SA$ OP PY,OP.DPY,701 ;DPYCLR (SAIL)
OP IV,OP.IMB,234 ;DIV--
OP PB,,137 ;DPB
OP FN,,131,* ;DFN
OPTB OP.E:,2
OP QV,OP.IMB,444 ;EQV--
OP XC,OP.%%H,250 ;EXCH
10$ OP NT,OP.%ER,077 ;ENTER (D10 ONLY)
OP RI,OP.%NT,005,* ;ERINT
OPTB OP.F:,2
OP AD,OP.FLT,140 ;FAD--
OP SB,OP.FLT,150 ;FSB--
OP MP,OP.FLT,160 ;FMP--
OP DV,OP.FLT,170 ;FDV--
OP SC,,132,* ;FSC
IFN D10,[
OPTB OP.G:,2
OP ET,OP.STS,62,* ;GETSTS (D10 ONLY)
] ;END OF IFN D10
OPTB OP.H:,2
OP LL,OP.ZOE,500 ;HLL--
OP RL,OP.ZOE,504 ;HRL--
OP RR,OP.ZOE,540 ;HRR--
OP LR,OP.ZOE,544,* ;HLR--
OPTB OP.I:,2
OP OJ,OP.RS,012 ;IOJ---
OP OR,OP.IMB,434 ;IOR--
OP MU,OP.IMU,220 ;IMUL--
OP DI,OP.IDI,230 ;IDIV--
OP LD,OP.%%B,134 ;ILDB
OP DP,OP.%%B,136 ;IDPB
SA$ OP OP,OP.IOP,724 ;IOPDL,IOPOP,IOPUSH (SAIL ONLY)
10$ OP NB,OP.%UF,064 ;INBUF (D10 ONLY)
10$ OP NP,OP.%UT,066 ;INPUT (D10 ONLY)
10$ OP N-,,056 ;IN (D10 ONLY)
OP BP,,133,* ;IBP
OPTB OP.J:,2
OP UM,OP.JSK,320 ;JUMP--
OP RS,OP.%%T,254 ;JRST
OP SR,,264 ;JSR
OP SP,,265 ;JSP
OP CA,OP.N%J,015 ;JCALL, JCALLF
OP FC,OP.%%L,255 ;JFCL
OP SA,,266 ;JSA
OP RA,,267 ;JRA
20$ OP SY,OP.%%S,104 ;JSYS (TWENEX ONLY)
OP FF,OP.%%O,243,* ;JFFO
OPTB OP.L:,2
OP SH,OP.SHF,242 ;LSH, LSHC
OP DB,,135 ;LDB
10$ OP OO,OP.KUP,076 ;LOOKUP (D10 ONLY)
OP ER,OP.LER,,* ;LER--
OPTB OP.M:,2
SA$ OP AI,OP.MAI ;MAIL (SAIL)
OP OV,OP.MOV,200 ;MOV--
10$ OP TA,OP.%PE,072 ;MTAPE (D10 ONLY)
OP UL,OP.IMB,224,* ;MUL--
OPTB OP.N:,2
OP CA,OP.N%J,20 ;NCA---
OP JC,OP.NJC,21,* ;NJC---
OPTB OP.O:,2
10$ OP PE,OP.%%N,050 ;OPEN (D10 ONLY)
10$ OP UT,OP.OUT ;OUTPUT, OUTBUF (D10 ONLY)
OP RC,OP.ORC,,* ;ORC--
OPTB OP.P:,2
SA$ OP TY,OP.UUO,711 ;PTYUUO (SAIL)
SA$ OP PI,OP.OT,702 ;PPIOT (SAIL)
SA$ OP GI,OP.OT,715 ;PGIOT (SAIL)
OP US,OP.PUS,260 ;PUSHJ, PUSH
OP OP,OP.POP,262,* ;POP, POPJ
OPTB OP.R:,2
10$ OP EL,OP.REL,071 ;RELEAS (D10 ONLY)
10$ OP EN,OP.REN,055 ;RENAME (D10 ONLY)
OP OT,OP.SHF,241,* ;ROT, ROTC
OPTB OP.S:,2
OP KI,OP.JSK,330 ;SKIP--
OP UB,OP.IMB,274 ;SUB--
OP OJ,OP.CND,360 ;SOJ--
OP OS,OP.CND,370 ;SOS--
OP ET,OP.SET,400 ;SET--
OP ER,OP.SER,010 ;SERINT
10$ OP ET,OP.STS,60 ;SETSTS (D10 ONLY)
10$ OP TA,OP.STA ;STATO, STATZ (D10 ONLY)
OP TR,OP.%$T,007,* ;STRT
OPTB OP.T:,1
10$ OP T,OP.TT,051 ;TTYCAL (D10 ONLY)
OP R,OP.ZCO,600 ;TR--
OP L,OP.ZCO,601 ;TL--
OP D,OP.ZCO,610 ;TD--
OP S,OP.ZCO,611,* ;TS--
OPTB OP.U:,2
SA$ OP PG,OP.UPG ;UPG--- (SAIL)
10$ OP GE,OP.UGE ;UGETF (D10 ONLY)
10$ OP SE,OP.USE ;USETI, USETO (D10 ONLY)
OP FA,,130,* ;UFA
OPTB OP.X:,2
OP OR,OP.IMB,430 ;XOR--
OP CT,,256,* ;XCT
OPTB OP.AND:,1
OP C,OP.NDC,4 ;ANDC--
OPTB OP.IMB:,1 ;ADDRESSING MODES
OP -,,0 ; NORMAL
OP I,,1 ; IMMEDIATE
OP M,,2 ; MEMORY
OP B,,3,* ; BOTH
OPTB OP.AOB:,2
OP JP,,0 ;AOBJP
OP JN,,1,* ;AOBJN
OPTB OP.CND:,2 ;CONDITION MODIFIERS
OP L-,,1 ; LESS
OP LE,,3 ; LESS OR EQUAL
OP GE,,5 ; GREATER OR EQUAL
OP G-,,7 ; GREATER
OPTB OP.EAN:,2 ;CONDITIONS FOR TEST INSTRUCTIONS
OP --,,0 ; NEVER
OP E-,,2 ; EQUAL
OP A-,,4 ; ALWAYS
OP N-,,6,* ; NOT EQUAL
OPTB OP.SHF:,1 ;SHIFT MODIFIERS
OP -,,0 ; ASH, ROT, LSH
OPTB OP.CIR:,1
OP C,,4,* ; ASHC, ROTC, LSHC, CIRC
OPTB OP.CAL:,1
OP L,OP.CLX,014,* ;CALL, CALLF
OPTB OP.N%J:,2
OP LL,OP.CLY,,*
OPTB OP.CLX:,1
10$ OP I,,033 ;CALLI (D10 ONLY)
OPTB OP.CLY:,1
OP -,,0 ;CALL, JCALL, NCALL
OP F,,2,* ;CALLF, JCALLF, NCALLF
OPTB OP.NJC:,2
OP AL,OP.NJ1,,*
OPTB OP.NJ1:,1
OP F,,2 ;NJCALF
OPTB OP.%%L:,1
OP L,,0,* ;NJCALL
OPTB OP.%LL:,2
OP LL,,0,* ;ACALL (AND TTCALL IN D10)
OPTB OP.AJC,1
OP A,OP.%LL,,* ;AJCALL
OPTB OP.FLT:,1 ;FLOATING MODIFIERS
OP R,OP.IMB,4 ; ROUNDED
OP -,,0 ; NORMAL
OP L,,1 ; LONG
OP M,,2 ; MEMORY
OP B,,3,* ; BOTH
OPTB OP.ZOE:,1 ;HALFWORD MODIFIERS
OP Z,OP.IMS,10 ; ZEROS
OP O,OP.IMS,20 ; ONES
OP E,OP.IMS,30 ; EXTEND
OPTB OP.IMS:,1 ;ADDRESSING MODES
OP -,,0 ; NORMAL
OP I,,1 ; IMMEDIATE
OP M,,2 ; MEMORY
OP S,,3,* ; SELF
OPTB OP.IMU:,1
OP L,OP.IMB,,* ;IMUL--
OPTB OP.IDI:,1
OP V,OP.IMB,,* ;IDIV--
OPTB OP.JSK:,1
OP P,OP.CND,,* ;JUMP--, SKIP--
OPTB OP.LER:,1 ;LISP ERROR UUO TYPES
OP R,,001 ; LERR
OP 3,,004,* ; LER3
OPTB OP.MOV:,1 ;MOVE MODIFIERS
OP E,OP.IMS,0 ; MOVE--
OP S,OP.IMS,4 ; MOVS--
OP N,OP.IMS,10 ; MOVN--
OP M,OP.IMS,14,* ; MOVM--
OPTB OP.ORC:,1
OP A,OP.IMB,454 ;ORCA--
OP M,OP.IMB,464 ;ORCM--
OP B,OP.IMB,470,* ;ORCB--
OPTB OP.PUS:,2
OP HJ,,0 ;PUSHJ
OP H-,,1,* ;PUSH
OPTB OP.POP:,1
OP -,,0 ;POP
OP J,,1,* ;POPJ
OPTB OP.RS:,2 ;IOJRST
OP RS,OP.RST,0,*
OPTB OP.RST:,1
OP T,,0,*
OPTB OP.SET:,1
OP Z,OP.IMB,0 ;SETZ--
OP O,OP.IMB,74 ;SETO--
OP A,OP.IMB,24 ;SETA--
OP M,OP.IMB,14 ;SETM--
OP C,OP.STC,50,* ;SETC--
OPTB OP.NDC:,1
OP B,OP.IMB,30 ;ANDCB--
OPTB OP.STC:,1
OP A,OP.IMB,0 ;ANDCA--, SETCA--
OP M,OP.IMB,10,* ;ANDCM--, SETCM--
OPTB OP.ZCO:,1 ;TEST MODIFIERS
OP N,OP.EAN,0 ; NO CHANGE
OP Z,OP.EAN,20 ; ZEROS
OP C,OP.EAN,40 ; COMPLEMENT
OP O,OP.EAN,60,* ; ONES
OPTB OP.SER:,1
OP I,OP.%NT,0,* ;SERI--
OPTB OP.%%H:,1
OP H,,0,* ;EXCH
OPTB OP.%NT:,2
OP NT,,0,* ;ERINT, SERINT
OPTB OP.%%B:,1
OP B,,0,* ;ILDB, IDPB
OPTB OP.%%T:,1
OP T,,0,* ;JRST (sail: CLKINT)
OPTB OP.%$T:,2
OP T-,,0 ;STRT
OP T7,,4,* ;STRT7
OPTB OP.%%O:,1
OP O,,0,* ;JFFO
IFN SAIL,[ ;ENTRIES FOR SAIL UUOS
OPTB OP.INT:,2
OP IN,OP.%%T,0,* ;CLKINT
OPTB OP.DPY:,2
OP CL,OP.%%R,,* ;DPYCLR
OPTB OP.%%R:,1
OP R,,0,* ;DPYCLR
OPTB OP.%YC:,2
OP LR,,701,* ;DPYCLR
OPTB OP.IOP:,2
OP DL,,2 ;IOPDL
OP OP,,1 ;IOPOP
OP US,OP.%%H,0,* ;IOPUSH
OPTB OP.MAI:,1
OP L,,710,* ;MAIL
OPTB OP.OT:,2
OP OT,,0,* ;PPIOT, PGIOT
OPTB OP.UUO:,2
OP UU,OP.%%O ;PTYUUO
OPTB OP.%UO:,2
OP UO,,0,* ;TTYUUO
OPTB OP.UPG:,2
OP IO,OP.%%T,703 ;UPGIOT
OP MV,OP.UPM,713,* ;UPGMVE
OPTB OP.UPM:,1
OP E,,0 ;UPGMVE
OP M,,1,* ;UPGMVM
]
IFN D10,[ ;MANY ENTRIES JUST FOR DECSYSTEM-10
OPTB OP.UGE:,2
OP TF,,073,* ;UGETF
OPTB OP.USE:,2
OP TI,,074 ;USETI
OP TO,,075,* ;USETO
OPTB OP.STA:,2
OP TO,,061 ;STATO
OP TZ,,063,* ;STATZ
OPTB OP.OUT:,1
OP -,,057 ;OUT
OP B,OP.%UF,065 ;OUTBUF
OP P,OP.%UT,067,* ;OUTPUT
OPTB OP.REL:,2
OP EA,OP.%%S,,* ;RELEAS
OPTB OP.REN:,2
OP AM,OP.%%E,,* ;RENAME
OPTB OP.STS:,2
OP ST,OP.%%S,,* ;GETSTS, SETSTS (sail: CHNSTS)
OPTB OP.TT:,2
SA$ OP YU,OP.%UO,0 ;TTYUUO (SAIL)
OP CA,OP.%LL,,* ;TTCALL
OPTB OP.%SE:,2
OP SE,,0,* ;CLOSE
OPTB OP.%%N:,1
OP N,,0,* ;OPEN
OPTB OP.%ER:,2
OP ER,,0,* ;ENTER
OPTB OP.%UF:,2
OP UF,,0,* ;INBUF, OUTBUF
OPTB OP.%UT:,2
OP UT,,0,* ;INPUT, OUTPUT
OPTB OP.%%P:,1
OP P,,0,* ;LOOKUP
OPTB OP.KUP:,2
OP KU,OP.%%P,,* ;LOOKUP
OPTB OP.%PE:,2
OP PE,,0,* ;MTAPE
OPTB OP.%%E:,1
OP E,,0,* ;RENAME
] ;END OF IFN D10
IFN D10+D20,[
OPTB OP.%%S:,1
OP S,,0,* ;(d10: RELEAS), (d20: JSYS)
] ;END OF IFN D10+D20
;;; OPCODE TABLE MUST HAVE LESS THAN 1000 ENTRIES
IFL OPTABL+1000-.,[
.ERR ######
PRINTX \OPCODE TABLE TOO BIG - LENGTH =\
INFORM \.-OPTABL
]
.SXEVAL (REMPROP (QUOTE SQOZ/|) (QUOTE SUBR))
.ENTRY SQOZ/| SUBR 2
5BTWD: PUSH P,CFIX1
$5BTWD: PUSH FXP,R70
5BTWD0: MOVEI C,(A)
HRRZ B,(A)
JUMPE B,5BTWD1
HLRZ A,(A)
JSP T,FXNV1
LSH TT,-2
MOVEM TT,(FXP)
MOVEI A,(B)
5BTWD1: HLRZ A,(A)
JUMPE A,5BTWD2
MOVEI T,(A)
LSH T,-SEGLOG
MOVE T,ST(T)
TLNN T,SY
JRST 5BTWD9
5BTWD2: PUSHJ P,SQUEEZE ;SHOULD LEAVE SIXBIT IN R
POP FXP,D
DPB D,[400400,,TT]
POPJ P,
5BTWD9: SETZM (FXP)
MOVEI A,(C)
WTA [BAD ARG - SQUOZE!]
JRST 5BTWD0
FASEND