**********************************************************************
* 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 )
;
;
**********************************************************************