TITLE UTIL1
;	** (c) Copyright 1980 Massachusetts Institute of Technology **

.FASL
.MLLIT==1
.INSRT SYS: .FASL DEFS

;.GLOBAL A,B,C,AR1,AR2A,P,T,TT,R,D,F,FXP,TRUE,FALSE,FIX1A,GETCOR,CFIX1,FIX1
.GLOBAL TYPEP,QBIGNU,NREVERSE,CFIX1
.GLOBAL CONS,NCONS,XCONS,FWCONS		;BNCONS

.ENTRY LOGLDB SUBR 3
	PUSH P,CFIX1	;(LOGLDB <BYTE DESC> WD)
	HRLZ D,(A)	; WD MAY BE A BIGNUM
	LSH D,6		; BYTE LOADED MUST BE OF SIZE < OR = 36.
	HRRI D,R	; (IF 36., HIGH BIT OF RESULT WILL BE SIGN BIT, OF COURSE.)
	MOVE R,(B)	;IS NCALL ABLE
	MOVE A,B
	PUSHJ P,TYPEP
	CAIN A,QBIGNU
	JRST LOGLD1
	LDB TT,D
	JUMPGE R,LGLCPJ	;ANY HIGH ORDER BITS OF + NUMBER ARE 0 ANYWAY
	LDB F,[360600,,D]		;POSITION FIELD
	LDB T,[300600,,D]		;SIZE FIELD
	ADD F,T
	SUBI F,44			;F GETS # BITS OFF TOP
	JUMPLE F,LGLCPJ	;XFER ON BYTE IS WITHIN WORD (DONT NEED HIGH ORDER 1 S)
	SUB T,F			;T GET # OF VALID BITS THAT WERE LDB ED
	DPB F,[301400,,D]	;GENERATE REMAINING NUMBER OF 1S
	MOVNI R,1		; (DPB S INTO SIZE FIELD AND CLEARS POSITION FIELD)
	LDB F,D
	LSH F,(T)		;SHIFT THEM TO CLEAR VALID BITS
	IOR TT,F
LGLCPJ:	POPJ P,

;FXP VARIABLES
; -2(FXP)	4.9 -> SIGN OF BIGNUM
; -1(FXP)	"CARRY IN" FOR NEGATING BIGNUM
;  0(FXP)	TEMP

LOGLD1:	PUSH FXP,R	;SAVE SIGN OF BIGNUM
	HRRZ B,R	;B HAS POINTER TO FIXNUM LIST
	PUSH FXP,[1]	;"CARRY IN" FOR NEGATING BIGNUM
	PUSH FXP,[0]	;TEMP CELL
LOGLD3:	HLRZ R,(B)
	MOVE R,(R)	;GET NEXT WD OF FIXNUM DATA
	SKIPGE -2(FXP)
	 PUSHJ P,LOGLDN	;NEGATIFY
	HRRZ B,(B)
	LDB F,[360600,,D]	;POSITION FIELD
	SUBI F,43
	JUMPGE F,LOGLD2	;BYTE IS COMPLETELY OUTSIDE THIS WD
	LDB TT,D	;GET AT LEAST SOME OF THE RIGHT STUFF
	JUMPE B,LOGLD5	;GO AWAY ON REST ZERO ANYWAY 
			; IF ITS A POSITIVE NUMBER, THAT IS.
	TLZ D,770000	;POSITION FIELD FOR NEXT TIME WILL BE RIGHT ADJUSTED
	MOVNM F,(FXP)	;IN CASE BYTE OVERLAPS WD, THIS IS AMT TO SHIFT HIGH PART
	LDB T,[300600,,D]	;SIZE FLD
	ADD F,T		;COMPUTE POSITION OF TOP BIT
	JUMPLE F,LOGLX1	;ENTIRE BYTE WAS WITHIN HACKED WD
	HLRZ R,(B)	;GET NEXT WD
	MOVE R,(R)
	SKIPGE -2(FXP)
	 PUSHJ P,LOGLDN
LOGLD6:	DPB F,[300600,,D]	;THIS MANY BITS LEFT TO HACK
	LDB F,D			;GET REST OF THE BITS
	LSH F,@(FXP)		;SHIFT THEM OVER TO MATCH BITS HAVE ALREADY GOT
	IOR TT,F
LOGLX1:	SUB FXP,[3,,3]
	POPJ P,

LOGLD2:	JUMPE B,LOGLD7		;XFER ON OUT OF BIGNUM
	DPB F,[360600,,D]	;HAVE FLUSHED 43 BITS, SO REDUCE POSITION BY THAT MUCH
	JRST LOGLD3
	
LOGLD7:	MOVEI TT,0
	SKIPL -2(FXP)
	JRST LOGLX1		;HIGH BITS OF + BIGNUM ARE ALL ZERO
	MOVNI R,1
	TLZ D,770000
	LDB TT,D
	JRST LOGLX1

LOGLD5:	SKIPGE -2(FXP)		;SKIP ON NUMBER POSITIVE (NOT TRYING TO NEGATE IT)
	SKIPE  -1(FXP)		;PROPAGATING A ONE INTO AN INFINTE CHAIN OF ONES
	 JRST LOGLX1		;REST ALL ZERO, ANYWAY
	TLZ D,770000		;DUPLICATE THIS LOSSAGE TO AVOID SLOWING MAIN CASE
	MOVNM F,(FXP)
	LDB T,[300600,,D]
	ADD F,T
	JUMPLE F,LOGLX1
	HRLOI R,377777		;GENERATE ONES AND FINISH JOB
	JRST LOGLD6

LOGLDN:	XOR R,[377777,,777777]
	SKIPN -1(FXP)		;CARRY IN?
	POPJ P,			;NO, OK
	CAME R,[377777,,777777]	;MOBY NEGATIVE NUMBER ABOUT TO GET CREATED?
	AOJA R,LOGLD4		;NO, GOBBLE IN CARRY
	XOR R,[377777,,7777777]	;YES, GET BACK ORIGINAL NUMBER AND LEAVE CARRY
	POPJ P,

LOGLD4:	CLEARM -1(FXP)		;FLUSH CARRY
	POPJ P,

.ENTRY LOGDPB SUBR 4	;(LOGDPB DATA-TO-STORE <BYTE-DESC> WD)
	MOVE TT,(C)
	HRLZ D,(B)
	LSH D,6
	HRRI D,TT
	MOVE R,(A)
	MOVE A,C
	PUSHJ P,TYPEP
	CAIN A,QBIGNU
	JRST LOGDP1		;DEPOSITING INTO BIGNUM
	LDB F,[360600,,D]	;POSITION FIELD
	LDB T,[300600,,D]	;SIZE FIELD
	ADD F,T
	SUBI F,43
	JUMPG F,LOGDP2		;FIELD DEPOSITING INTO WONT FIT IN FIXNUM
	DPB R,D
	JRST FIX1

LOGDP2:	PUSH P,[0]		;NIL (FIXNUM LIST OF BIGNUM "SO FAR")
	PUSH FXP,TT		;SAVE SIGN (WHICH WILL NOT BE CHANGED BY DPB)
LOGDP5:	SUB T,F			;COMPUTE PART THAT DOES FIT IN LOW WD
	JUMPLE T,LOGDP3		;LOW ORDER WD UNCHANGED
	PUSH FXP,F		;# OF BITS THAT DIDN'T FIT
	DPB T,[300600,,D]	;BITS THAT FIT IN LOW WD
	DPB R,D			;DEPOSIT IN THOSE
	MOVNS T
	LSH R,(T)		;SHIFT THOSE AWAY
	TLZ TT,400000		;ASSURE BIGNUM COMPONENTS POSITIVE
	JSP T,FWCONS
	POP P,B
	PUSHJ P,CONS
	PUSH P,A
	POP FXP,F		;GET BACK NUMBER OF BITS THAT DIDNT FIT
	DPB F,[301400,,D]	;PUT THEM INTO BYTE PNTR, ALSO CLEAR POSITION FIELD
				; MAKING IT RIGHT ADJUSTED
	MOVEI TT,0		;GENERATE FRESH ZEROS
LOGDP6:	DPB R,D			;EFFECTIVELY MASK REMAINING DATA TO CORRECT SIZE
	JSP T,FWCONS
	POP P,B
	PUSHJ P,CONS
LOGDB3:	HLRZ TT,(A)		;MAKE SURE HI ORDER WORD ISNT 0
	SKIPN TT,(TT)
	 JRST [ HRRZ A,(A)	;IT IS, SO FLUSH IT
		HRRZ B,(A)	;WILL IT REALLY FIT IN A FIXNUM?
		JUMPN B,LOGDB3	;PROBABLY NOT..
		HLRZ A,(A)	;YES... IS IT POSITIVE
		POP FXP,TT
		JUMPGE TT,LOGDBX	;YES JUST RETURN LAST COMPONENT OF BIGNUM
		MOVN TT,(A)	;NOPE, HAVE TO NEGATE IT
		JRST FIX1]
	PUSHJ P,NREVERSE	;SO LOW ORDER WD FIRST
	POP FXP,TT
	JUMPGE TT,BNCONS	;POSITIVE NUMBER, OK
	PUSHJ P,BNCONS		;GET BIGNUM HEADER
	HRROS (A)		;MAKE BIGNUM NEGATIVE
LOGDBX:	POPJ P,

LOGDP3:	CAMN TT,[SETZ]
	 JRST [	MOVEI TT,0	;MOBY NEGATIVE NUMBER
		PUSH FXP,[1]
		JRST LOGDP4]
	MOVMS TT		;COMPONENETS OF BIGNUM ALWAYS POSITIVE
	PUSH FXP,[0]
LOGDP4:	JSP T,FWCONS
	POP P,B
	PUSHJ P,CONS
	PUSH P,A
	POP FXP,TT		;0 EXCEPT 1 IF NEGATED MOBY NEGATIVE NUMBER
	LDB F,[360600,,D]	;DECREMENT POSITION FIELD
	SUBI F,43
	DPB F,[360600,,D]
LOGDB8:	LDB T,[300600,,D]	;SIZE FIELD
	ADD F,T
	SUBI F,43
	JUMPG F,LOGDP5		;XFER ON ALL BITS WONT FIT INTO THIS ONE EITHER
	JRST LOGDP6		;THEY WILL, SO PUT THEM IN AND FINISH OFF

LOGDP1:	PUSH FXP,TT		;DEPOSITING INTO BIGNUM (SAVE SIGN)
	PUSH P,[0]		;NIL (FIXNUM LIST SO FAR)
	HRRZ C,TT
LOGDB1:	HLRZ TT,(C)
	MOVE TT,(TT)
	HRRZ C,(C)
	LDB F,[360600,,D]
	LDB T,[300600,,D]
	ADD F,T
	SUBI F,43
	JUMPG F,LOGDB2		;DROP THRU ON BYTE ENTIRELY WITHIN CURRENT WD
LOGDB7:	DPB R,D			;DEPOSIT IN STUFF
LOGDB4:	JSP T,FWCONS		;DUPLICATE OUT REST
	POP P,B
	PUSHJ P,CONS
	JUMPE C,LOGDB3
	PUSH P,A
	HLRZ TT,(C)
	MOVE TT,(TT)
	HRRZ C,(C)
	JRST LOGDB4

LOGDB2:	SUB T,F
	JUMPLE T,LOGDB5		;LOW WD UNCHANGED
	PUSH FXP,F		;BYTE SPLIT ACROSS THIS WD AND NEXT ONE
	DPB T,[300600,,D]	;T HAS # BITS THAT GO IN LOW WD
	DPB R,D
	MOVNS T
	LSH R,(T)		;FLUSH BITS USED UP
	TLZ TT,400000
	JSP T,FWCONS
	POP P,B
	PUSHJ P,CONS
	PUSH P,A
	POP FXP,F
	DPB F,[301400,,D]
	JUMPE C,[ MOVEI TT,0
		  JRST LOGDB7]
	HLRZ TT,(C)
	MOVE TT,(TT)
	HRRZ C,(C)
	JRST LOGDB7

LOGDB5:	JSP T,FWCONS		;DUPLICATE THAT WORD
	POP P,B
	PUSHJ P,CONS
	PUSH P,A
	LDB F,[360600,,D]	
	SUBI F,43
	DPB F,[360600,,D]
	JUMPN C,LOGDB1		;MORE BIGNUM, SO SEE IF DESIRED BYTE IN THERE
	MOVEI TT,0
	JRST LOGDB8

.ENTRY LOGLDB-FROM-FIXNUM SUBR 3
LGLDFX:	PUSH P,CFIX1	;(LOGLDB-FROM-FIXNUM <BYTE DESC> WD)
	HRLZ D,(A)	; WD MUST BE A FIXNUM
	LSH D,6		; BYTE LOADED MUST BE OF SIZE < OR = 36.
	TLO D,B		; (IF 36., HIGH BIT OF RESULT WILL BE SIGN BIT, OF COURSE.)
			;IS NCALL ABLE
	LDB TT,D	;NO EXTENSION OF SIGN ON NEG NUMBERS IF BYTE EXTENDS BEYOND 36
	POPJ P,		;ANY HIGH ORDER BITS OF + NUMBER ARE 0 ANYWAY

.ENTRY LOGDPB-INTO-FIXNUM SUBR 4
LGDPFX:	PUSH P,CFIX1	;(LOGDPB-FROM-FIXNUM <VAL> <BYTE DESC> <WD>) NCALLABLE
	HRLZ D,(B)	;GET BYTE DESC.
	LSH D,6
	HRRI D,TT
	MOVE TT,(C)
	MOVE R,(A)
	DPB R,D
	POPJ P,
	
.ENTRY MASK-FIELD-FROM-FIXNUM SUBR 3
LGMFFX:	PUSH P,CFIX1	;(MASK-FIELD-FROM-FIXNUM <BYTE-DESC> WD)
	MOVNI R,1	; WD MUST BE A FIXNUM
	MOVEI TT,0	;MASK CORRESPONDING TO <BYTE-DESC> IS AND'ED WITH WD AND RETURNNED
	HRLZ D,(A)	;IS NCALL ABLE
	LSH D,6
	HRRI D,TT
	DPB R,D
	AND TT,(B)
	POPJ P,

FASEND