Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50301/star10.snb
There are 2 other files named star10.snb in the archive. Click here to see a list.
**
************************************
** MACHINE DEPENDENT* PDP10        *
************************************
**
INIT	BSIZE = 8
	HSIZE = 18
	WSIZE = 36
	HALF = 2 ** 18
	ADDR.WORD = 1
	JUMPLOC = FILLTAB( TABLE(14,5) ,
.		'GOTO,GOTO"<-[,MOVEI"<-,MOVE"+,ADD"-,SUB"!,IOR"'
.		'/&/,AND"&,AND"X!,XOR"'
.		'/,IDIV"*,IMUL"MOD,MOD"<-<-,LSH"->->,LSHR"'
.		'\,LCR"'
.		)
	LOGOP = FILLTAB( TABLE(11) ,
.		'<=,LE"\>,LE">=,GE"\<,GE"<,L"\>=,L"'
.		'>,G"\<=,G"=,E"\=,N"<>,A"'
.		)
	SC = '$'
	VER = VER '0  STAR10'
	MOVE = 'MOVE'
	SW.REG =
	SW.DEBUG = '+'
	BASE.REG = '5'
	R0 = '6' ; R1 = '7'
	REENT.REG = '13'
	DEFINE('DO.OP()')
	DEFINE('GENONE(OP)')
	DEFINE('GENONER(OP,R.ADDR)','GENONE')
	DEFINE('GENTWO(OP)')
	DEFINE('GENTWOI(OP)')
	DEFINE('GETROFF(LAB)')
	DEFINE('LOAD.R()')
	DEFINE('LOAD.R2(R.ADDR,R.F,R1)','LOAD.R')
	DEFINE('POINT(ENTRY,ADDR)')
	DEFINE('SIDECK(ENTRY)')
	DEFINE('STORE.L()')
	DEFINE('STORE.L2(R0)','STORE.L')
					:(RETURN)
**
BEGIN	STARTLAB = LABEL
	ASSNL('TITLE',STARTLAB)
	ASSNL('SUBTTL','	' VER)
	ASSNL('ENTRY',STARTLAB)
	ASSNL('RADIX','10')
	ASS(STARTLAB,'0')
	ASSNL(MOVE,'1,[SIXBIT/' STARTLAB '/]')
	IDENT(OPERAND)			:S(RETURN)
	ASSNL('MOVEM','^O16,' OPERAND)	:(RETURN)
**
FINISH	( ASSNL('JRA','^O16,0(^O16)') )
DSLOOP	SAVEDS BREAK.TAB = ASS(T1,'BLOCK',T2)	:S(DSLOOP)
DCLOOP	SAVEDC BREAK.TAB = ASS(T1,'ASCIZ','"' T2 '"')	:S(DCLOOP)
FIBOTH	( ASSNL('LIT') ASSNL('END') )	:(RETURN)
**
COMMENT STATE LEN(69) . T1 = PUT(';' T1) :S(COMMENT)
	PUT(';' STATE)			:(RETURN)
**
RADIX					:(RETURN)
**
STATSRT	DIFFER(SW.DEBUG) \(
.		DIFFER(OPCODE,'DO') DIFFER(OPCODE,'IF')
.		DIFFER(OPCODE,'IFANY') DIFFER(OPCODE,'CALLS')
.		) ASS(LABEL,'MOVEI','0,' STATENO)
.					:S(RETURN)
	( DIFFER(OPCODE,'BEGIN') GENLAB(LABEL) )	:(RETURN)
**
GENTWO	LOAD.R()
	DO.OP()
	STORE.L()			:(RETURN)
**
GENONE	( IDENT(L.F,'W') ASSNL(OP,L.ADDR) )	:S(RETURN)
	LOAD.R2(L.ADDR,L.F,R0)
	ASSNL(OP,R0)
	STORE.L()
						:(RETURN)
**
GENTWOI	R.ADDR POS(0) '#' =		:S(GOTLIT1)
	R.ADDR '@'			:S(GOTIND)
	R.ADDR = '@' R.ADDR		:(GOTLIT1)
GOTIND	LOAD.R()
	R.ADDR = '0(' R1 ')'
GOTLIT1 LOAD.R2(L.ADDR,L.F,R0)
	ASSNL(OP,R0 ',' R.ADDR)
	( IDENT(L.F,'W') ASSNL('MOVEM',R0 ',' L.ADDR) )	:S(RETURN)
	STORE.L()			:(RETURN)
**
CALLSRT 				:(RETURN)
**
GENCALL CALLLAB = DIFFER(SW.REENT) GETROFF(CALLLAB)
	ASSNL('EXTERN',LOC)
	ASSNL('JSA','^O16,' LOC)
	( NE(NARG,0) ASS(CALLLAB,'BLOCK',NARG) )	:(RETURN)
**
GENLOG	IDENT(OP,'A')			:S(GENLB)
	IDENT(L.F,'1')			:S(GENL1)
	LOAD.R2(L.ADDR,L.F,R0)
	( IDENT(R.ADDR,'#0')  ASSNL('JUMP' OP,R0 ',' LOC) )  :S(RETURN)
	OP = COMPOP()
	R.ADDR POS(0) '#' =		:F(GENL2)
	ASSNL('CAI' OP, R0 ',' R.ADDR)	:(GENLB)
GENL2	( IDENT(R.F,'W') ASSNL('CAM' OP,R0 ',' R.ADDR) )     :S(GENLB)
	( LOAD.R() ASSNL('CAM' OP,R0 ',' R1) )	:(GENLB)
GENLB	ASSNL('JRST',LOC)		:(RETURN)
GENL1	ASSNL(MOVE,R0 ',' L.ADDR)
	T1 = TAB.MASK(L.ENTRY)
	SIDE = 'TLN'
	SIDE = GT(T1,17) 'TRN'
	T1 = GT(T1,17) T1 - 18
	R.A = R.ADDR ; R.ADDR = '^B1' DUPL('0',17 - T1)
	IDENT(R.A,'#1') 		:S(GENLBT)
	DIFFER(R.A,'#0')		:S(LOGERR)
	OP = IDENT(OP,'E') 'N' 		:S(GENLBT)
	OP = IDENT(OP,'N') 'E' 		:S(GENLBT)
LOGERR	( ERROR('BIT TESTS SUPPORT ONLY (EQ,NE) FOR (0,1)') ) :S(RETURN)
GENLBT	ASSNL(SIDE OP,R0 ',' R.ADDR)	:(GENLB)
**
ASS	T1 = IDENT(T2) DIFFER(T1) T1 ':'	:S(ASS1)
	T1 = DIFFER(T1) T1 ':'
ASS1	T4 = T4 SAVECOM
	SAVECOM =
	T2 = GE(SIZE(T2),6) T2 ' '
*	T3 ',(' = ',0('
	T3 = DIFFER(T4) RPAD(T3,24) ';' T4
	( PUT( RPAD(T1,8) RPAD(T2,8) T3 ) )	:(RETURN)
**
GENLOAD	ASSNL(MOVE,R ',' ADDR)		:(RETURN)
**
GETREG	GETREG = WHEN + 2		:(RETURN)
**
TABSTM	MASK = CKTYPE(LF,'1') LOW
	IDENT(BASE,'REG') DIFFER(SW.REG) PUT('REG=' BASE.REG)
					:(RETURN)
**
SIDECK	SIDECK = 'HRR'
	SIDECK = IDENT( TAB.RANGE(ENTRY ) , '0,17' ) 'HLR'     :(RETURN)
**
POINT	LOW = TAB.RANGE(ENTRY)
	LOW ',' REM . HIGH =
	POINT = '[  POINT  ' (HIGH - LOW + 1) ',' ADDR
.		',' HIGH ']'		:(RETURN)
**
** NOTE: R0=LEFT, R1=RIGHT
**
LOAD.R	R.ADDR POS(0) '#' =		:F(NOTLIT)
	R.ADDR = CONVERT(R.ADDR,'INTEGER')	:F(NOTINT)
	( LT(R.ADDR,HALF) GT(R.ADDR,-HALF) ASSNL('HRREI',R1 ',' R.ADDR)
. )					:S(RETURN)
	R.A = R.ADDR / HALF
	R.ADDR = REMDR(R.ADDR,HALF)
	( LT(R.ADDR,HALF) GT(R.ADDR,-HALF) ASSNL('MOVSI',R1 ',' R.ADDR)
. )					:S(RETURN)
NOTINT	( IDENT(OP,MOVE) ASSNL(MOVE,R1 ',[' R.ADDR ']') )   :S(RETURN)
NOTLIT	( IDENT(R.F,'W') ASSNL(MOVE,R1 ',' R.ADDR) ) :S(RETURN)
	( IDENT(R.F,'Y') ASSNL('LDB',R1 ',' POINT(R.ENTRY,R.ADDR)) )
.						:S(RETURN)
	( IDENT(R.F,'H') ASSNL(SIDECK(R.ENTRY),R1 ',' R.ADDR) )
.					:S(RETURN)
					:(RETURN)
**
DO.OP	OFFLOC(L.ADDR)
	IDENT(L.F,'W')				:F(DO.OPY)
	( \(DIFFER(OP,'SUB') DIFFER(OP,'IDIV'))
.		ASSNL('EXCH',R1 ',' L.ADDR) )
	ASSNL(OP 'M',R1 ',' L.ADDR)		:(RETURN)
DO.OPY	( IDENT(L.F,'Y') ASSNL('LDB',R0 ',' POINT(L.ENTRY,L.ADDR))
.		ASSNL(OP,R0 ',' R1) ) 		:S(RETURN)
	( IDENT(L.F,'H') ASSNL(SIDECK(L.ENTRY),R0 ',' L.ADDR)
.		ASSNL(OP,R0 ',' R1) ) 		:S(RETURN)
	ERROR('UNSUPPORTED MODE')		:(RETURN)
**
STORE.L OFFLOC(L.ADDR)
	IDENT(L.F,'W')				:S(RETURN)
	( IDENT(L.F,'Y') ASSNL('DPB',R0 ',' POINT(L.ENTRY,L.ADDR))
. )						:S(RETURN)
	( IDENT(L.F,'H') ASSNL(SIDECK(R.ENTRY) 'M',R0 ',' L.ADDR)
. )						:S(RETURN)
	ERROR('UNSUPPORTED MODE')		:(RETURN)
**
GETROFF GETROFF = REENT.OFF<LAB> '(' REENT.REG ')'	:(RETURN)
**
********
** OPTIMIZATION
********
CKREGD	DIFFER(SW.OPT2) 		:F(RETURN)
	ADDR POS(0) '@' 		:S(RETURN)
	BASELOC = EQ(OFF,0) '@' ADDR	:F(RETURN)
	LREG =				:(FRETURN)
********
** OPERATIONS
********
O.MOVEI	OP = MOVE
	CKTYPET(TF,'B',R.TYPE)		:F(O.MOVE)
	( DIFFER(L.F,'W') ERROR('ADDRESS CONSTANTS FOR WORDS ONLY') )
	ASSNL('MOVEI',R1 ',' R.ADDR)	:(DOMOV)
**
O.MOVE	IDENT(L.F,'1')			:S(MOV1)
	OP = IDENT(L.F,'W') IDENT(R.ADDR,'#0') 'SETZM'	:S(O.ONE)
	LOAD.R()
DOMOV	( IDENT(L.F,'W') DO.OP() )	:S(RETURN)
	STORE.L2(R1)			:(RETURN)
MOV1	R.A = R.ADDR
	R.ADDR = '#[^B1' DUPL('0',35 - TAB.MASK(L.ENTRY)) ']'
	R.F = 'W' ; L.F = 'W'
	OP = IDENT(R.A,'#0') 'ANDCA'	:S(O.TWO)
	OP = IDENT(R.A,'#1') 'IOR'	:S(O.TWO)
	ERROR('BIT MOVES NOT IMPLEMENTED')	:(RETURN)
**
O.GOTO	ASSNL('JRST',LEFT)		:(RETURN)
**
O.LCR	R.ADDR = IDENT(L.F,'W') ASSNL('SETO',R0 ',')	:S(LCR1)
	( ASSNL('LDB',R0 ',' POINT(L.ENTRY,'[-1]')) )
LCR1	ASSNL('XORM',R0 ',' L.ADDR)	:(RETURN)
**
O.LSHR	OP = 'LSH'
	R.ADDR '#' = '#-'		:S(O.LSH)
O.LSH
O.TWOI	GENTWOI(OP)			:(RETURN)
**
O.ONE	GENONE(OP)			:(RETURN)
**
O.MOD	OP = 'IDIV'
	( LOAD.R() DO.OP() STORE.L2(R1) )	:(RETURN)
**
O.ADD	OP = IDENT(L.F,'W') IDENT(R.ADDR,'#1') 'AOS'  :S(O.ONE)F(O.TWO)
**
O.SUB	OP = IDENT(L.F,'W') IDENT(R.ADDR,'#1') 'SOS'  :S(O.ONE)F(O.TWO)
**
O.IOR ;O.AND ;O.XOR ;O.IMUL ;O.IDIV
O.TWO	GENTWO(OP)			:(RETURN)
**
END