Metropoli BBS
VIEWER: objfix.s MODE: TEXT (ASCII)
**********************************************************************
* Name:		OBJFIX
* Stack:	( id --> )
* Desc:		Fix bad download if possible
* Author:	HP, optimized by M.H.
**********************************************************************
ASSEMBLE
	CON(1)	8
RPL
xNAME OBJFIX
::
  CK1&Dispatch
  idnt
  ::
     DUPSAFE@ NOTcase SETNONEXTERR	( No variable to fix )
     DTYPECSTR? NOTcase2DROP		( Nothing to fix - already ob )
     OVER PURGE				( id $ )
     CODE
		GOSBVL	=SAVPTR
		C=DAT1	A
		R0=C	A		->$
		D0=C
		D0=D0+	5
		A=DAT0	A
		C=C+A	A
		C=C+CON	A,5
		B=C	A		->$tail
		LC(5)	#105		Check atleast one block
		?A<C	A
		GOYES	goobfixexit
		D0=D0+	5		->$body
		A=DAT0	14
		C=A	W
		LC(N)	14
		NIBASC	'HPHP48-'
		?A#C	W
		GOYES	goobfixexit
		D0=D0+	14+2		Skip "HPHP48-" and "X"

		A=DAT0	A
		D1=A
		A=DAT1	A
		LC(5)	=PRLG
		?A#C	A
		GOYES	goobfixexit	Can't fix non-object

		GOSBVL	=SAFESKIPOB	Can't fix if contains ACPTR
goobfixexit	GOC	obfixexit	Can't fix invalid objects

		CD0EX
		D=C	A		->obend
		A=B	A
		A=A-C	A
		GOC	obfixexit	Can't fix insufficient object

		C=0	A
		LC(2)	5+5+2*8		$ + $size + HPHP48-X
		A=A+C	A
		R1=A	A
		A=R0	A
		D1=A			->$
		A=A+C	A
		D0=A			->ob
		C=D	A
		C=C-A	A		obsize
		ST=0	15		Disable ON-C
		GOSBVL	=MOVEDOWN	Move down over $
		A=B	A
		C=R1	A
		GOSBVL	=MOVERSD	Remove extra space (*safe*)
		A=B	A
		D0=A
		A=DAT0	A		Fix link
		C=R1	A
		A=A-C	A
		DAT0=A	A
obfixexit	ST=1	15
		GOVLNG	=GETPTRLOOP

     ENDCODE
     SWAP STO				( Store back under old name )
  ;
;
**********************************************************************
[ RETURN TO DIRECTORY ]