; Shamelessly stolen from
; xpkIDEA.library
; V 1.0


	include "exec/types.i"
	include "exec/initializers.i"
	include "exec/libraries.i"
	include "exec/lists.i"
	include "exec/nodes.i"
	include "exec/resident.i"
	include "exec/alerts.i"
;xpk inc
	include "libraries/xpk.i"

**************************************************************************
*
*		      The XpkSubParams structure
*
*/

 STRUCTURE XpkSubParams,0
	APTR	xsp_InBuf	; /* The input data		  */
	ULONG	xsp_InLen	; /* The number of bytes to pack  */
	APTR	xsp_OutBuf	; /* The output buffer		  */
	ULONG	xsp_OutBufLen	; /* The length of the output buf */
	ULONG	xsp_OutLen	; /* Number of bytes written	  */
	ULONG	xsp_Flags	; /* Flags for master/sub comm.   */
	ULONG	xsp_Number	; /* The number of this chunk	  */
	LONG	xsp_Mode	; /* The packing mode to use	  */
	APTR	xsp_Password	; /* The password to use	  */
	STRUCT	xsp_Arg,4*4	; /* Reserved; don't use          */
	STRUCT	xsp_Sub,4*4	; /* Sublib private data	  */
	LABEL	xsp_SIZEOF


XPKIDEA_MAXSTATES:	equ	25	;umpf. 400 bytes of state mem

	xref	_SysBase

CALLSYS MACRO
	jsr	_LVO\1(a6)
	ENDM

XLIB	MACRO
	XREF	_LVO\1
	ENDM

EVEN	MACRO
	ds.w	0
	ENDM

	XLIB	AllocMem
	XLIB	FreeMem


; --- The IdeaStream structure
; the following struct gets allocated at the first call to Pack/UnpackChunk
; it is filled with proper values and then reused for subsequent calls.
; NO CHECKING FOR MODE/PASSWORD CHANGES IS DONE IF THE POINTER IS
; PRESENT IN SUB[0] !!!!!! (a speedup compromise)

	STRUCTURE	IdeaStream,0
	ULONG		ids_Mode
	ULONG		ids_Routine	;points to rout. to run
	ULONG		ids_NumStates	;nr. of states
	STRUCT		ids_Key,104	;the expanded (i)ideakey
	STRUCT		ids_States,8*XPKIDEA_MAXSTATES	;states for ofb mode
	STRUCT		ids_Inits,8*XPKIDEA_MAXSTATES	;init states for chaining modes
	LABEL		ids_SIZEOF

; --- IDEA stuff ---------


;;; 68000 assembler functions from IDEAs crypt.c
;;; Implemented by A.B.P.Soft

;;; Idea and Mul algorithm speed up, unrolling and permutation
;;; by Colin Plumb. Thats the fastest plain 68000 version I can
;;; imagine. The former one (by me, ABP) was around 10% slower.
;;; Therefore the routines Idea and the macros Mult* are
;;; (C) Colin Plumb (colin@eecg.toronto.edu)

nofKeyPerRound: equ	6 ; number of used keys per round
nofRound:	equ	8 ; number of rounds

Ones:		equ	$ffff
MulMod: 	equ	$10001

; Multiply two numbers in the range of 1..0x10000, modulo 0x10001.
; 0x10000 is represented as 0.

Mult	MACRO	; src1, src2, dest, neither source is 0
	; dest may equal src2, but not src1 (which is zeroed)
	mulu	\2,\1	; 54
	move.w	\1,\3	;  4
	swap	\1	;  4 \1 now holds high part
	sub.w	\1,\3	;  4
	moveq	#0,\1	;  4 does not affect X flag
	addx.w	\1,\3	;  4

	ENDM		; 74

; Code to handle the cases where one argument is 0 = 0x10000 = -1.
; Negate the other modulo 0x10001, giving 0x10001 - x = 1 - x.
; In-place and out-of-place versions

Invert1 MACRO	; dest
	neg.w	\1	;  4
	addq.w	#1,\1	;  4
	ENDM		;  8

Invert2 MACRO	; src, dest
	moveq	#1,\2	;  4
	sub.w	\1,\2	;  4
	ENDM		;  8

; encryption and decryption algorithm IDEA

; In:
; a0 *dataIn
; a1 *dataOut
; a2 *Key

; no registers are saved !
; d0-d3 return the 64 bit result, too.
; only a3-a7 survive this routine.
; this is done for speedup.
; only save those registers in inner loops you need there !

; Multiply value in register by next available key (pointed at by a2).
; Requires corresponding MultAux code nearby.

; Using both halves of d6 (for dbra and constant 0) is particualrly
; obscene.  But I need x0, x1, x2, x3, t0, t1, a working data register,
; and a loop counter, and saving a clear instruction per multiply (4 in the
; inner loop makes for 16 cycles) pays for the extra swap instructions.

; Unrolling this loop would eliminate 10 cycles of dbra, two swaps, and
; two exg's, for a total of 30 cycles per two iterations, or 120 cycles
; total.  Is it worth blowing it out of an '020's cache?

KeyMult MACRO	; \1 = number, \2 = register, \3 = zero register
	; flags must be set to correspond to register
	beq.s	Mul\1_a_is_0	;  8
	move.w	(a2)+,d7        ;  8
	beq.s	Mul\1_b_is_0	;  8
	mulu	\2,d7		; 54 (average of 8 bits set)
	move.w	d7,\2		;  4
	swap	d7		;  4 \1 now holds high part
	sub.w	d7,\2		;  4
	addx.w	\3,\2		;  4
Mul\1_done:
	ENDM			; 94 total

MultAux MACRO	; \1 = number, \2 = register
Mul\1_a_is_0:			; 10 branch overhead
	moveq	#1,\2	;  4
	sub.w	(a2)+,\2        ;  4
	bra.s	Mul\1_done	; 10 = 32 total for this path

Mul\1_b_is_0:			; 26 test & branch overhead
	neg.w	\2	;  4
	addq.w	#1,\2	;  4
	bra.s	Mul\1_done	; 10 = 44 total for this path
	ENDM

	MultAux 1,d0
	MultAux 2,d3
	MultAux 3,d4
	MultAux 4,d5

Idea:

	moveq	#nofRound-1,d6	;  4

	moveq	#0,d4		;  4

	move.w	(a0)+,d0        ;  8
	KeyMult 1,d0,d4 	; 94

	move.w	(a0)+,d2        ;  8
	move.w	(a0)+,d1        ;  8
	move.w	(a0)+,d3        ;  8

CryptLoop:
	swap	d6		;  4

	exg	d1,d2		;  6   swap x1 and x2
	add.w	(a2)+,d1        ;  8   x1 += *key++;
	add.w	(a2)+,d2        ;  8   x2 += *key++;

	eor.w	d4,d3		;  4   x3 ^= t0
	KeyMult 2,d3,d6 	; 94   x3 = Mul(x3, *key++);

	move.w	d0,d4		;  4   t0 = Mul(x0^x2, *Key++);
	eor.w	d2,d4		;  4
	KeyMult 3,d4,d6 	; 94

	move.w	d1,d5		;  4   t1 = Mul(t0 + (x1^x3), *Key++);
	eor.w	d3,d5		;  4
	add.w	d4,d5		;  4
	KeyMult 4,d5,d6 	; 94

	add.w	d5,d4		;  4   t0 += t1

	eor.w	d5,d0		;  4   x0 ^= t1;

	KeyMult 5,d0,d6 	; 94   x0 = Mul(x0, *Key++);

	eor.w	d4,d1		;  4   x1 = x1 ^ t0;
	eor.w	d5,d2		;  4   x2 = x2 ^ t1;

	swap	d6		;  4
	dbra	d6,CryptLoop	; 10
				;  4  -> From top, if expired

	add.w	(a2)+,d1        ;  8   x1 += *key++
	add.w	(a2)+,d2        ;  8   x2 += *key++

	swap	d6		;  4
	eor.w	d4,d3		;  4   x3 ^= t0
	KeyMult 6,d3,d6 	; 94   x3 = Mul(x3, *Key++);

	movem.w d0-d3,(a1)      ; 24
	lea	8(a1),a1

	rts			; 16

; End of Idea

	MultAux 5,d0
	MultAux 6,d3
IdeaEnd:


; 32 bit multiplier macro

CMUL	MACRO
	move.l	\2,-(a7)
	move.l	\1,-(a7)
	swap	\2
	mulu	\1,\2
	swap	\1
	mulu	2(a7),\1
	add.l	\1,\2
	swap	\2
	clr.w	\2
	move.w	2(a7),\1
	mulu	6(a7),\1
	add.l	\1,\2
	addq.l	#8,a7
	ENDM


;The following isn't of interest for the resulting speed. Its only called once

; MulInv routine
; compute inverse of x via euclidian gcd algorithm
; in:
; d0.w = x
; out:
; d0.w = MulInv(x)

MulInv:
	and.l	#Ones,d0
	bne	mulinv1
	rts
mulinv1:
	cmp.w	#1,d0
	bne	mulinv11
	rts
mulinv11:
	move.l	#MulMod,d1
	moveq	#0,d4
	moveq	#1,d5
mulinv12:
	move.l	d1,d2
	divu	d0,d2
	move.l	d2,d3
	swap	d3
	and.l	#Ones,d2
	and.l	#Ones,d3
	bne	mulinv2
	tst.l	d5
	bge	mulinv3
	add.l	#MulMod,d5
	bra	mulinv3
mulinv2:
	move.l	d0,d1
	move.l	d3,d0
	move.l	d5,d6

	CMUL	d2,d5

	sub.l	d5,d4

	move.l	d4,d5
	move.l	d6,d4
mulinv3:
	tst.w	d3
	bne	mulinv12
	move.l	d5,d0
	and.l	#Ones,d0
	rts


; ExpandUserKey routine
; makes 832 bit idea key from 128 bit input key
; in:
; a0 *UserKey
; a1 *Key		;104 bytes buffer
; out:
; --			;result in mem

ExpandUserKey:
	move.l	a1,a2
	move.l	(a0)+,(a2)+
	move.l	(a0)+,(a2)+
	move.l	(a0)+,(a2)+
	move.l	(a0)+,(a2)+
	moveq	#nofRound,d0
ex1:
	move.l	d0,d1
	and.b	#%111,d1
	cmp.b	#6,d1
	bne	ex2

	move.w	d0,d1
	add.w	d1,d1
	move.w	-14(a1,d1.w),d2
	and.w	#$7f,d2
	lsl.w	#5,d2
	lsl.w	#4,d2	;have no 9<<
	move.w	-28(a1,d1.w),d3
	lsr.w	#7,d3
	eor.w	d3,d2
	move.w	d2,0(a1,d1.w)

	bra	exend
ex2:
	cmp.b	#7,d1
	bne	ex3


	move.w	d0,d1
	add.w	d1,d1
	move.w	-30(a1,d1.w),d2
	and.w	#$7f,d2
	lsl.w	#5,d2
	lsl.w	#4,d2	;have no 9<<
	move.w	-28(a1,d1.w),d3
	lsr.w	#7,d3
	eor.w	d3,d2
	move.w	d2,0(a1,d1.w)

	bra	exend
ex3:
	move.w	d0,d1
	add.w	d1,d1
	move.w	-14(a1,d1.w),d2
	and.w	#$7f,d2
	lsl.w	#5,d2
	lsl.w	#4,d2	;have no 9<<
	move.w	-12(a1,d1.w),d3
	lsr.w	#7,d3
	eor.w	d3,d2
	move.w	d2,0(a1,d1.w)
exend:
	addq	#1,d0
	cmp.b	#52,d0
	blt	ex1
	rts


; InvertIdeaKey routine
; makes decryption key from encryption key
; in:
; a0: *ideakey
; a1: *iideakey
; out:
; -- ; in mem

InvertIdeaKey:
	move.w	(a0)+,d0
	bsr	MulInv
	move.w	d0,96(a1)
	move.w	(a0)+,d0
	neg.w	d0
	move.w	d0,98(a1)
	move.w	(a0)+,d0
	neg.w	d0
	move.w	d0,100(a1)
	move.w	(a0)+,d0
	bsr	MulInv
	move.w	d0,102(a1)
	moveq	#42,d1
invloop:
	move.l	d1,d2
	add.w	d2,d2
	move.w	(a0)+,8(a1,d2.w)
	move.w	(a0)+,10(a1,d2.w)
	move.w	(a0)+,d0
	movem.l d1-d2,-(a7)
	bsr	MulInv
	movem.l (a7)+,d1-d2
	move.w	d0,0(a1,d2.w)
	move.w	(a0)+,d3
	neg.w	d3
	move.w	(a0)+,d4
	neg.w	d4
	tst.w	d1
	beq	ikey1
	exg	d3,d4
ikey1:
	move.w	d3,2(a1,d2.w)
	move.w	d4,4(a1,d2.w)
	move.w	(a0)+,d0
	movem.l d1-d2,-(a7)
	bsr	MulInv
	movem.l (a7)+,d1-d2
	move.w	d0,6(a1,d2.w)
	subq	#6,d1
	bge	invloop
	rts

; --- Idea support for xpk routines

; the following does a InvertIdeaKey a0->a1, where both may point to the
; same memory. InvertIdeaKey would produce bogus, if used this way.

SaveInvert:
	move.l	a2,-(a7)
	move.l	a1,a2		;dst buf
	lea	-104(a7),a7
	move.l	a7,a1		;tmp. dst in stack
	bsr	InvertIdeaKey
	move.l	a7,a0
	moveq	#51,d0
cpkey:
	move.w	(a0)+,(a2)+
	dbf	d0,cpkey
	lea	104(a7),a7
	move.l	(a7)+,a2
	rts

; Initializes are called from Pack/Unpack to do the following:
;  - alloc one IdeaStream struct and put it to params.Sub[0]
;  - choose the mode to use and enter the Routine in struct
;  - parse the password and fill in the key/initializers in struct

	xdef	@PackInit
@PackInit:
PackInit:

	movem.l a0-a5/d1-d7,-(a7)
	move.l	a6,a5	;lib base
	move.l	a0,a4	;xparams

	move.l	_SysBase,a6
	move.l	#ids_SIZEOF,d0
	move.l	#$10001,d1
	CALLSYS AllocMem
	move.l	a5,a6				;restore libbase
	move.l	d0,a3
	move.l	d0,xsp_Sub(a4)
	bne	allocok
	move.l	#XPKERR_NOMEM,d0
	bra	endinit
allocok:
	move.l	xsp_Mode(a4),d0
	move.l	d0,ids_Mode(a3)
	moveq	#25,d1
	sub.l	d1,d0
	ble	initecb
	cmp.l	d1,d0
	ble	initcfb
	sub.l	d1,d0
	cmp.l	d1,d0
	ble	initofb
	sub.l	d1,d0
	move.l	d0,ids_NumStates(a3)
;init cbc
	lea	CBCRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
	bra	buildkey
initcfb:
	move.l	d0,ids_NumStates(a3)
	lea	CFBRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
	bra	buildkey
initofb:
	move.l	d0,ids_NumStates(a3)
	lea	OFBRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
	bra	buildkey
initecb:
	clr.l	ids_NumStates(a3)       ;to be clean here
	lea	ECBRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
buildkey:
	move.l	a4,a0	;params
	move.l	a3,a1	;ideastream
	bsr	ParsePassword	; may ret. error state
endinit:
	movem.l (a7)+,a0-a5/d1-d7
	rts

	xdef	@UnpackInit
@UnpackInit:
UnpackInit:
	movem.l a0-a5/d1-d7,-(a7)
	move.l	a6,a5	;lib base
	move.l	a0,a4	;xparams

	move.l	_SysBase,a6
	move.l	#ids_SIZEOF,d0
	move.l	#$10001,d1
	CALLSYS AllocMem
	move.l	a5,a6				;restore libbase
	move.l	d0,a3
	move.l	d0,xsp_Sub(a4)
	bne	uallocok
	move.l	#XPKERR_NOMEM,d0
	bra	uiniterr
uallocok:
	move.l	xsp_InBuf(a4),a0
	move.l	xsp_Mode(a4),d0                 ; OIS
	move.l	d0,ids_Mode(a3)

	moveq	#25,d1
	sub.l	d1,d0
	ble	uinitecb
	cmp.l	d1,d0
	ble	uinitcfb
	sub.l	d1,d0
	cmp.l	d1,d0
	ble	uinitofb
	sub.l	d1,d0
	move.l	d0,ids_NumStates(a3)
;init cbc
	lea	UCBCRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
	moveq	#-1,d7			;need inv key
	bra	ubuildkey
uinitcfb:
	move.l	d0,ids_NumStates(a3)
	lea	UCFBRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
	moveq	#0,d7			;no inv
	bra	ubuildkey
uinitofb:
	move.l	d0,ids_NumStates(a3)
	lea	UOFBRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
	moveq	#0,d7			;no inv
	bra	ubuildkey
uinitecb:
	clr.l	ids_NumStates(a3)
	lea	UECBRoutine(pc),a0
	move.l	a0,ids_Routine(a3)
	moveq	#-1,d7			;inv
ubuildkey:
	move.l	a4,a0	;params
	move.l	a3,a1	;ideastream
	bsr	ParsePassword	; may ret. error state
	tst.l	d0
	bne	uiniterr
uendinit:
	tst.l	d7
	beq	unokeyinversion
	move.l	xsp_Sub(a4),a0
	lea	ids_Key(a0),a0
	move.l	a0,a1
	bsr	SaveInvert
unokeyinversion:
	moveq	#0,d0
uiniterr:
	movem.l (a7)+,a0-a5/d1-d7
	rts

;
; <password>	::=	<keyspec>[<initializer>]*.
; <keyspec>	::=	<valuespec>.
; <initializer> ::=	":"<valuespec>.
; <valuespec>	::=	[<charstring>|<hexstring>].
; <charstring>	::=	["!".."~"]*.                    ;without ":"
; <hexstring>	::=	"#"["0".."9"|"a".."f"|"A".."F"]*.
;


PW_ERROR:	equ	-1
PW_EOL: 	equ	-2
PW_COLON:	equ	-3

ParsePassword:
	;a0 = parms a1 = idstream
	movem.l d1-d7/a2-a5,-(a7)
	lea	-16(a7),a7
	move.l	xsp_Password(a0),d0
	beq	pmisspwd
	move.l	d0,a2
	move.l	a7,a3
	bsr	parsekey
	cmp.b	#PW_COLON,d0
	beq	parseinits
	cmp.b	#PW_EOL,d0
	beq	ppwdok
	bra	pbadpwd 		;error during key parse
parseinits:
	lea	ids_Inits(a1),a3        ;curr. init val.
	moveq	#XPKIDEA_MAXSTATES,d7	;max initilizers
parseinitloop:
	subq	#1,d7
	blt	pbadpwd
	bsr	parseinitial
	cmp.b	#PW_COLON,d0
	beq	parseinitloop
	cmp.b	#PW_EOL,d0
	bne	pbadpwd
ppwdok:
	lea	ids_Key(a1),a1
	move.l	a7,a0
	bsr	ExpandUserKey
	moveq	#0,d0
	bra	endppw
pbadpwd:
	moveq	#XPKERR_WRONGPW,d0
	bra	endppw
pmisspwd:
	moveq	#XPKERR_NEEDPASSWD,d0
endppw:
	lea	16(a7),a7
	movem.l (a7)+,d1-d7/a2-a5
	rts

parsekey:
	;a0 = parms a1 = ids a2 = char a3 = dest. buf
	moveq	#0,d0
	move.b	(a2)+,d0
	beq	pkeyeol
	cmp.b	#':',d0
	beq	pkeycolon
	cmp.b	#'#',d0
	beq	phexkey
	lea	-1(a2),a2
	bra	pasciikey
pkeyeol:
	moveq	#PW_EOL,d0
	rts
pkeycolon:
	clr.l	(a3)+
	clr.l	(a3)+
	clr.l	(a3)+
	clr.l	(a3)+
	moveq	#PW_COLON,d0
	rts

phexkey:
	moveq	#0,d0
	move.l	d0,d1
	move.l	d0,d2
	move.l	d0,d3
phexkeyloop:
	moveq	#0,d4
	move.b	(a2)+,d4
	beq	phexkeynohex
	cmp.b	#':',d4
	beq	phexkeynohex
	cmp.b	#'0',d4
	blt	phexkeynohex
	cmp.b	#'9',d4
	bgt	phexkeynodigit
	sub.b	#'0',d4
	bra	phexkeynextdigit
phexkeynodigit:
	and.b	#%11011111,d4
	cmp.b	#'A',d4
	blt	phexkeynohex
	cmp.b	#'F',d4
	bgt	phexkeynohex
	sub.b	#$37,d4
phexkeynextdigit:
;shift it into d0-d3

	lsl.l	#1,d3
	bcs	phexkeyerr	;any bit shift off ?
	lsl.l	#1,d3
	bcs	phexkeyerr
	lsl.l	#1,d3
	bcs	phexkeyerr
	lsl.l	#1,d3
	bcs	phexkeyerr
	rol.l	#4,d2
	move.l	d2,d5
	and.l	#$F,d5
	or.l	d5,d3
	rol.l	#4,d1
	move.l	d1,d5
	and.l	#$F,d5
	or.l	d5,d2
	rol.l	#4,d0
	move.l	d0,d5
	and.l	#$F,d5
	or.l	d5,d1

	or.l	d4,d0	;the new hex digit
	bra	phexkeyloop

phexkeynohex:
	move.l	d3,(a3)+
	move.l	d2,(a3)+
	move.l	d1,(a3)+
	move.l	d0,(a3)+
	tst.b	d4
	bne	phexkeynoend
	moveq	#PW_EOL,d0
	rts
phexkeynoend:
	cmp.b	#':',d4
	bne	phexkeyerr
	moveq	#PW_COLON,d0
	rts
phexkeyerr:
	moveq	#PW_ERROR,d0
	rts

pasciikey:
	moveq	#0,d0
	move.l	d0,d1
	move.l	d0,d2
	move.l	d0,d3
pasckeyloop:
	moveq	#0,d4
	move.b	(a2)+,d4
	beq	pasckeyend
	cmp.b	#':',d4
	beq	pasckeycolon
	cmp.b	#'!',d4
	blt	pasckeyerr
	cmp.b	#'~',d4
	bgt	pasckeyerr
	sub.b	#'!',d4

	move.l	d4,d5

SMUL	MACRO	;src,dst,tmpreg 	;simple mul with some output
	move.l	\2,\3			;for the hash function
	swap	\3
	mulu	\1,\3
	swap	\3
	clr.w	\3
	mulu	\1,\2
	add.l	\3,\2
	ENDM

	SMUL	#94,d3,d6
	add.l	d5,d3
	move.l	d3,d5
	swap	d5
	and.l	#Ones,d5

	SMUL	#94,d2,d6
	add.l	d5,d2
	move.l	d2,d5
	swap	d5
	and.l	#Ones,d5

	SMUL	#94,d1,d6
	add.l	d5,d1
	move.l	d1,d5
	swap	d5
	and.l	#Ones,d5

	SMUL	#94,d0,d6
	add.l	d5,d0

	bra	pasckeyloop

pasckeyend:
	move.l	d3,(a3)+
	move.l	d2,(a3)+
	move.l	d1,(a3)+
	move.l	d0,(a3)+
	moveq	#PW_EOL,d0
	rts
pasckeycolon:
	move.l	d3,(a3)+
	move.l	d2,(a3)+
	move.l	d1,(a3)+
	move.l	d0,(a3)+
	moveq	#PW_COLON,d0
	rts
pasckeyerr:
	moveq	#PW_ERROR,d0
	rts


parseinitial:
	;a0 = parms a1 = ids a2 = char a3 = dest. buf
	moveq	#0,d0
	move.b	(a2)+,d0
	beq	pinieol
	cmp.b	#':',d0
	beq	pinicolon
	cmp.b	#'#',d0
	beq	phexini
	lea	-1(a2),a2
	bra	pasciiini
pinieol:
	moveq	#PW_EOL,d0
	rts
pinicolon:
	clr.l	(a3)+
	clr.l	(a3)+
	moveq	#PW_COLON,d0
	rts

phexini:
	moveq	#0,d0
	move.l	d0,d1
phexiniloop:
	moveq	#0,d4
	move.b	(a2)+,d4
	beq	phexininohex
	cmp.b	#':',d4
	beq	phexininohex
	cmp.b	#'0',d4
	blt	phexininohex
	cmp.b	#'9',d4
	bgt	phexininodigit
	sub.b	#'0',d4
	bra	phexininextdigit
phexininodigit:
	and.b	#%11011111,d4
	cmp.b	#'A',d4
	blt	phexininohex
	cmp.b	#'F',d4
	bgt	phexininohex
	sub.b	#$37,d4
phexininextdigit:

	lsl.l	#1,d1
	bcs	phexinierr
	lsl.l	#1,d1
	bcs	phexinierr
	lsl.l	#1,d1
	bcs	phexinierr
	lsl.l	#1,d1
	bcs	phexinierr
	rol.l	#4,d0
	move.l	d0,d5
	and.l	#$F,d5
	or.l	d5,d1

	or.l	d4,d0	;the new hex digit
	bra	phexiniloop

phexininohex:
	move.l	d1,(a3)+
	move.l	d0,(a3)+
	tst.b	d4
	bne	phexininoend
	moveq	#PW_EOL,d0
	rts
phexininoend:
	cmp.b	#':',d4
	bne	phexinierr
	moveq	#PW_COLON,d0
	rts
phexinierr:
	moveq	#PW_ERROR,d0
	rts

pasciiini:
	moveq	#0,d0
	move.l	d0,d1
pasciniloop:
	moveq	#0,d4
	move.b	(a2)+,d4
	beq	pasciniend
	cmp.b	#':',d4
	beq	pascinicolon
	cmp.b	#'!',d4
	blt	pascinierr
	cmp.b	#'~',d4
	bgt	pascinierr
	sub.b	#'!',d4

	move.l	d4,d5

	SMUL	#94,d1,d6
	add.l	d5,d1
	move.l	d1,d5
	swap	d5
	and.l	#Ones,d5

	SMUL	#94,d0,d6
	add.l	d5,d0

	bra	pasciniloop

pasciniend:
	move.l	d1,(a3)+
	move.l	d0,(a3)+
	moveq	#PW_EOL,d0
	rts
pascinicolon:
	move.l	d1,(a3)+
	move.l	d0,(a3)+
	moveq	#PW_COLON,d0
	rts
pascinierr:
	moveq	#PW_ERROR,d0
	rts


;the ecb packer routine
;this is heavily commented for the interested
;the others are more cryptic (this IS a crypt prg, you know)
ECBRoutine:
	clr.l	-(a7)           ;instead of bytebybyte clearing the stack
	clr.l	-(a7)           ;we simply push 8 zero bytes.
	move.l	a0,a4		;xparms in a4
	move.l	xsp_Sub(a4),a3  ;our idea stream structure in a3
	lea	ids_Key(a3),a5  ;a5 points to key
	move.l	xsp_InBuf(a4),a0        ;inbuf to a0
	move.l	xsp_OutBuf(a4),a1       ;outbuf to a1

	move.l	xsp_InLen(a4),d0        ;get inlen
	move.l	d0,d1
	lsr.l	#3,d0		;len/8 -> num of blocks to code
	move.l	d0,d4		;d4 is the block counter
	and.l	#7,d1		;len MOD 8 -> num of exceeding bytes
	move.l	d1,d6		;d6 holds them
	beq	noextra 	;if there are some of them
	addq	#1,d0		;we will write one more block
noextra:
	lsl.l	#3,d0		;num blks -> num bytes
	move.l	d0,xsp_OutLen(a4)
	move.l	d6,-(a7)        ; save len exceed to stack
ecbloop:
	move.l	d4,-(a7)         ;remember Idea crashs the regs
	move.l	a5,a2		;key pointer for idea
	bsr	Idea		;do what we have to do ;>
	move.l	(a7)+,d4
	subq	#1,d4		;one less block
	bne	ecbloop 	;wasn't the last

	move.l	(a7)+,d6        ;restore len exceed
	beq	ecbnoexceed	;was noone

	moveq	#1,d4		; one additional loop to run
	move.l	a7,a2		; stack as temp buffer
ecbcpex:
	move.b	(a0)+,(a2)+     ; copy the bytes exceeding
	subq.b	#1,d6		; into the already cleared stack
	bne	ecbcpex 	; (remember the 2 clr's above)
	move.l	a7,a0		; stack as crypt input
	clr.l	-(a7)           ; no len exceed anymore
	bra	ecbloop 	; let's crypt it ...

ecbnoexceed:
	moveq	#0,d0		; was no error
	lea	8(a7),a7        ; untrash stack
	rts			; and went otherwards

UECBRoutine:

	move.l	a0,a4
	move.l	xsp_Sub(a4),a3
	lea	ids_Key(a3),a5
	move.l	xsp_InBuf(a4),a0
	move.l	xsp_OutBuf(a4),a1
	move.l	xsp_InLen(a4),d0        ;OIS InLen == OutLen
	move.l	d0,xsp_OutLen(a4)       ;into the xparm.OutLen
	move.l	xsp_InLen(a4),d0
	lsr.l	#3,d0			;-->blocks
	move.l	d0,d4
uecbloop:
	move.l	d4,-(a7)
	move.l	a5,a2		;key
	bsr	Idea
	move.l	(a7)+,d4
	subq	#1,d4
	bne	uecbloop
	moveq	#0,d0
	rts

CBCRoutine:
	clr.l	-(a7)
	clr.l	-(a7)
	move.l	a0,a4
	move.l	xsp_Sub(a4),a3
	lea	ids_Key(a3),a5
	move.l	ids_NumStates(a3),d5
	lea	ids_Inits(a3),a3
	move.l	xsp_InBuf(a4),a0
	move.l	xsp_OutBuf(a4),a1

	move.l	xsp_InLen(a4),d0

	move.l	d0,d1
	lsr.l	#3,d0
	move.l	d0,d4
	and.l	#7,d1
	move.l	d1,d6
	beq	cbcnoextra
	addq	#1,d0
cbcnoextra:
	lsl.l	#3,d0
	move.l	d0,xsp_OutLen(a4)
	move.l	d6,-(a7)
cbcloop1:

	move.w	(a3)+,(a1)      ;whats that ????
	move.w	(a0)+,d0        ;oh yeah...
	eor.w	d0,(a1)+        ;xor the Input with the Output(i-N)
	move.w	(a3)+,(a1)
	move.w	(a0)+,d0
;				;even if this looks somewhat
	eor.w	d0,(a1)+        ;huge, no C compiler
	move.w	(a3)+,(a1)      ;would get it so small...
	move.w	(a0)+,d0
;				;maybe nobody gets it smaller.
	eor.w	d0,(a1)+
	move.w	(a3)+,(a1)
	move.w	(a0)+,d0
	eor.w	d0,(a1)+

	lea	-8(a1),a1       ;stueck zurueck @;-)

	movem.l a0/d4-d5,-(a7)
	move.l	a5,a2		;key
	move.l	a1,a0
	bsr	Idea
	movem.l (a7)+,a0/d4-d5
	subq	#1,d4
	beq	cbcend
	tst.l	d5
	beq	cbcloop1
	subq	#1,d5		;if N blocks are coded
	bne	cbcloop1
	move.l	xsp_OutBuf(a4),a3       ;switch from initializers
	bra	cbcloop1
cbcend:
	move.l	(a7)+,d6        ;len exceed
	tst.b	d6
	beq	cbcnoexceed

	moveq	#1,d4
	move.l	a7,a2
cbccpex:
	move.b	(a0)+,(a2)+     ; copy the bytes exceeding
	subq.b	#1,d6
	bne	cbccpex
	move.l	a7,a0		; stack as input
	clr.l	-(a7)           ; no len exceed anymore
	bra	cbcloop1	; crypt it ...

cbcnoexceed:

	moveq	#0,d0
	lea	8(a7),a7
	rts

UCBCRoutine:

	move.l	a0,a4
	move.l	xsp_Sub(a4),a3
	lea	ids_Key(a3),a5
	move.l	ids_NumStates(a3),d5
	lea	ids_Inits(a3),a3
	move.l	xsp_InBuf(a4),a0
	move.l	xsp_OutBuf(a4),a1

	move.l	xsp_InLen(a4),d0                ;OIS
	move.l	d0,xsp_OutLen(a4)
	move.l	xsp_InLen(a4),d0

	lsr.l	#3,d0
	move.l	d0,d4

ucbcloop1:

	movem.l d4-d5,-(a7)
	move.l	a5,a2		;key
	bsr	Idea
	movem.l (a7)+,d4-d5

	lea	-8(a1),a1

	move.w	(a3)+,d0        ;hmmm.
	eor.w	d0,(a1)+        ;let's make this
	move.w	(a3)+,d0        ;somewhat slower...
	eor.w	d0,(a1)+
	move.w	(a3)+,d0
	eor.w	d0,(a1)+
	move.w	(a3)+,d0
	eor.w	d0,(a1)+

	subq	#1,d4
	beq	ucbcend
	tst.l	d5
	beq	ucbcloop1
	subq	#1,d5
	bne	ucbcloop1
	move.l	xsp_InBuf(a4),a3
	bra	ucbcloop1
ucbcend:
	moveq	#0,d0
	rts

CFBRoutine:
	clr.l	-(a7)
	clr.l	-(a7)
	move.l	a0,a4
	move.l	xsp_Sub(a4),a3
	lea	ids_Key(a3),a5
	move.l	ids_NumStates(a3),d5
	lea	ids_Inits(a3),a3
	move.l	xsp_InBuf(a4),a0
	move.l	xsp_OutBuf(a4),a1

	move.l	xsp_InLen(a4),d0

	move.l	d0,d1
	lsr.l	#3,d0
	move.l	d0,d4
	and.l	#7,d1
	move.l	d1,d6
	beq	cfbnoextra
	addq	#1,d0
cfbnoextra:
	lsl.l	#3,d0
	move.l	d0,xsp_OutLen(a4)
	move.l	d6,-(a7)
cfbloop1:

	move.l	(a3)+,(a1)+
	move.l	(a3)+,(a1)+
	lea	-8(a1),a1

	movem.l a0/d4-d5,-(a7)
	move.l	a5,a2		;key
	move.l	a1,a0
	bsr	Idea
	movem.l (a7)+,a0/d4-d5

	lea	-8(a1),a1

	move.w	(a0)+,d0
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	eor.w	d0,(a1)+

	subq	#1,d4
	beq	cfbend
	tst.l	d5
	beq	cfbloop1
	subq	#1,d5		;if N blocks are coded
	bne	cfbloop1
	move.l	xsp_OutBuf(a4),a3       ;switch from initializers
	bra	cfbloop1
cfbend:
	move.l	(a7)+,d6        ;len exceed
	tst.b	d6
	beq	cfbnoexceed

	moveq	#1,d4
	move.l	a7,a2
cfbcpex:
	move.b	(a0)+,(a2)+     ; copy the bytes exceeding
	subq.b	#1,d6
	bne	cfbcpex
	move.l	a7,a0		; stack as input
	clr.l	-(a7)           ; no len exceed anymore
	bra	cfbloop1	; crypt it ...

cfbnoexceed:
	moveq	#0,d0
	lea	8(a7),a7
	rts

UCFBRoutine:

	move.l	a0,a4
	move.l	xsp_Sub(a4),a3
	lea	ids_Key(a3),a5
	move.l	ids_NumStates(a3),d5
	lea	ids_Inits(a3),a3
	move.l	xsp_InBuf(a4),a0
	move.l	xsp_OutBuf(a4),a1

	move.l	xsp_InLen(a4),d0                ; OIS
	move.l	d0,xsp_OutLen(a4)
	move.l	xsp_InLen(a4),d0

	lsr.l	#3,d0
	move.l	d0,d4

ucfbloop1:

	move.l	(a3)+,(a1)+
	move.l	(a3)+,(a1)+
	lea	-8(a1),a1

	movem.l a0/d4-d5,-(a7)
	move.l	a1,a0
	move.l	a5,a2		;key
	bsr	Idea
	movem.l (a7)+,a0/d4-d5

	lea	-8(a1),a1
	move.w	(a0)+,d0
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	eor.w	d0,(a1)+

	subq	#1,d4
	beq	ucfbend
	tst.l	d5
	beq	ucfbloop1
	subq	#1,d5
	bne	ucfbloop1
	move.l	xsp_InBuf(a4),a3
	bra	ucfbloop1
ucfbend:
	moveq	#0,d0
	rts

OFBRoutine:
;ofb is somewhat mysterious mode. It circulary crypts the states, which
;are initialized by the initializers, and only xors the data over this
;states. This is both slow and unsafe, but its a standard method...

	clr.l	-(a7)
	clr.l	-(a7)
	move.l	a0,a4
	move.l	xsp_Sub(a4),a3
	lea	ids_Key(a3),a5
	move.l	ids_NumStates(a3),d5
	lea	ids_Inits(a3),a0
;copy inits to stats
	lea	ids_States(a3),a1
ofbstatcp:
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	subq	#1,d5
	bne	ofbstatcp

	move.l	ids_NumStates(a3),d5
	lea	ids_States(a3),a3

	move.l	xsp_InBuf(a4),a0
	move.l	xsp_OutBuf(a4),a1

	move.l	xsp_InLen(a4),d0

	move.l	d0,d1
	lsr.l	#3,d0
	move.l	d0,d4
	and.l	#7,d1
	move.l	d1,d6
	beq	ofbnoextra
	addq	#1,d0
ofbnoextra:
	lsl.l	#3,d0
	move.l	d0,xsp_OutLen(a4)
	move.l	d6,-(a7)
ofbloop1:

	movem.l a0-a1/d4-d5,-(a7)
	move.l	a5,a2		;key
	move.l	a3,a0
	move.l	a3,a1		;crypt from and to states
	bsr	Idea
	movem.l (a7)+,a0-a1/d4-d5

	move.w	(a0)+,d0
	move.w	(a3)+,(a1)
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	move.w	(a3)+,(a1)
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	move.w	(a3)+,(a1)
	eor.w	d0,(a1)+
	move.w	(a0)+,d0
	move.w	(a3)+,(a1)
	eor.w	d0,(a1)+

	subq	#1,d4
	beq	ofbend
	subq	#1,d5		;if N blocks are coded
	bne	ofbloop1
	move.l	xsp_Sub(a4),a3
	move.l	ids_NumStates(a3),d5
	lea	ids_States(a3),a3       ;reset states
	bra	ofbloop1
ofbend:
	move.l	(a7)+,d6        ;len exceed
	tst.b	d6
	beq	ofbnoexceed

	moveq	#1,d4
	move.l	a7,a2
ofbcpex:
	move.b	(a0)+,(a2)+     ; copy the bytes exceeding
	subq.b	#1,d6
	bne	ofbcpex
	move.l	a7,a0		; stack as input
	clr.l	-(a7)           ; no len exceed anymore
	bra	ofbloop1	; crypt it ...

ofbnoexceed:

	moveq	#0,d0
	lea	8(a7),a7
	rts


UOFBRoutine:

	move.l	a0,a4
	move.l	xsp_Sub(a4),a3
	lea	ids_Key(a3),a5
	move.l	ids_NumStates(a3),d5
	lea	ids_Inits(a3),a0
;copy inits to stats
	lea	ids_States(a3),a1
uofbstatcp:
	move.l	(a0)+,(a1)+
	move.l	(a0)+,(a1)+
	subq	#1,d5
	bne	uofbstatcp

	move.l	ids_NumStates(a3),d5
	lea	ids_States(a3),a3

	move.l	xsp_InBuf(a4),a0
	move.l	xsp_OutBuf(a4),a1

	move.l	xsp_InLen(a4),d0                ; OIS
	move.l	d0,xsp_OutLen(a4)
	move.l	xsp_InLen(a4),d0

	lsr.l	#3,d0
	move.l	d0,d4

uofbloop1:

	movem.l a0-a1/d4-d5,-(a7)
	move.l	a5,a2		;key
	move.l	a3,a0
	move.l	a3,a1		;crypt from and to states
	bsr	Idea
	movem.l (a7)+,a0-a1/d4-d5

	move.w	(a0)+,d0
	move.w	(a3)+,d1
	eor.w	d1,d0
	move.w	d0,(a1)+
	move.w	(a0)+,d0
	move.w	(a3)+,d1
	eor.w	d1,d0
	move.w	d0,(a1)+
	move.w	(a0)+,d0
	move.w	(a3)+,d1
	eor.w	d1,d0
	move.w	d0,(a1)+
	move.w	(a0)+,d0
	move.w	(a3)+,d1
	eor.w	d1,d0
	move.w	d0,(a1)+

	subq	#1,d4
	beq	uofbend
	subq	#1,d5		;if N blocks are coded
	bne	uofbloop1
	move.l	xsp_Sub(a4),a3
	move.l	ids_NumStates(a3),d5
	lea	ids_States(a3),a3       ;reset states
	bra	uofbloop1
uofbend:
	moveq	#0,d0
	rts

; --- Lib Entrys ---------

	xdef	@PackChunk
PackChunk:
@PackChunk:
	movem.l a0-a5/d1-d7,-(a7)
	tst.l	xsp_Sub(a0)
	bne	packisinit
	bsr	PackInit
	tst.l	d0
	bne	pcend
packisinit:
	move.l	xsp_Sub(a0),a1
	move.l	ids_Routine(a1),a1
	jsr	(a1)    ;looks a little bit like assembler ooP
pcend:
	movem.l (a7)+,a0-a5/d1-d7
	rts

	xdef	 @PackFree
PackFree:
@PackFree:
	movem.l a0-a3/d1-d3,-(a7)
	move.l	xsp_Sub(a0),a1
	move.l	#ids_SIZEOF,d0

;even if the ami is no multi user machine, we don't let key info hang
;around in the memory.

	lsr.l	#1,d0
FreeZero:
	clr.w	(a1)+
	subq	#1,d0
	bne	FreeZero

	move.l	xsp_Sub(a0),a1
	move.l	#ids_SIZEOF,d0
	move.l	a6,a3
	move.l	_SysBase,a6
	CALLSYS FreeMem
	move.l	a3,a6
	movem.l (a7)+,a0-a3/d1-d3
	moveq	#0,d0
	rts


	xdef	@PackReset
PackReset:
@PackReset:
	moveq	#0,d0	;there is nothing to reset, coz any chunk is
	rts		;crypted the same way. To be honest, in ofb mode
			;the initializers are copied to the states for
			;every chunk to make this sure !

	xdef	@UnpackChunk
UnpackChunk:
@UnpackChunk:
	movem.l a0-a5/d1-d7,-(a7)
	tst.l	xsp_Sub(a0)
	bne	upackisinit
	bsr	UnpackInit
	tst.l	d0
	bne	upcend
upackisinit:
	move.l	xsp_Sub(a0),a1
	move.l	ids_Routine(a1),a1
	jsr	(a1)
upcend:
	movem.l (a7)+,a0-a5/d1-d7
	rts


	xdef	@UnpackFree
UnpackFree:
@UnpackFree:
	bra	PackFree

	END