-
CompuBBS code - September 2020 (2/3)
From
The Deprogram@21:1/5 to
All on Sun Sep 20 18:51:51 2020
[continued from previous message]
do pingreply with tsource , tmessage
else
do processtcpip with tmessage
endif
else && No pending commands...
if gstoredflag
do flush
gstoredflag = .F.
gmoldheart = seconds() + gmolddelay
gpackets = gpackets + 1
else
if gmoldheart < seconds()
do flush
gmoldheart = seconds() + gmolddelay
endif
endif
endif
if gnextstats <= seconds()
do showstatus
gnextstats = seconds() + gstatdelay
endif
lastkey=inkey()
if lastkey # 0
activate window output
do case
case lastkey = asc("~")
? time()+" Quitting..."
mdone = .T.
case lastkey = asc("@")
? time()+" Copying to island2.dbf"
set order to
copy to m:\island2\island2
?? "Done"
case lastkey = asc("#")
? time()+" Suspending..."
suspend
case lastkey = asc("!")
? time()+" ACCEPT="+iif(gaccept,"T","F")+" ACT="+ iif(gactaccept,"T","F") + " EOM="+iif(geom,"T","F")+" NEXT="+str(tnext,9,3)+ " TOO-LATE="+str(ttoolate,6,0)+" COUNT="+str(tcount,9,0)
s = "T"+space(60)
call int99 with s
if s = "t"
tbuffered = val( substr(s,26,5) )
? "MOLD INFO: SESSION="+substr(s,2,10)+" SEQ="+substr(s,12,10)+" SOCKET="+substr(s,22,4)+" BUFFERED="+str(tbuffered,5,0)
else
? "Could not get mold info!"
tbuffered = 0
endif
if gpackets > 0
? "MESSAGES:"+str(gmessages-tbuffered,12,0)+" PACKETS:"+str(gpackets,12,0)+" ("+str( (gmessages-tbuffered)/ gpackets , 5 , 3 )+")"
gmessages = tbuffered
gpackets =0
endif
case lastkey = asc("%")
? time()+" Shutdown attempt..."
do shutdown
case lastkey = asc("(")
? time()+" toggled gaccept"
gaccept = !gaccept
case lastkey = asc("?")
? "@-Copy to island2.DBF ~-Quit !-Status #-Suspend %-ShutDown $-Print incoming"
case lastkey = asc("$")
if gprinting
? time()+" Printing off"
gprinting = .F.
else
? time()+" Printing on"
gprinting = .T.
endif
endcase
activate window ticker
endif
enddo && Main Loop
activate window output
&& Final flush to mak sure everything is sent
do flush
&& Close file
s = "C"
call int99 with s
x = "H"+READPORT
call int99 with x
if x # "h"
do alert with "Could not close PingPort!"
endif
use && Unuse Island
&& Create fresh waypoint file
f = fcreate("ISLAND2.TXT")
if f<=0
? "Could not create ISLAND.TXT!"
suspend
endif
=fputs( f , "ISLAND2" ) && ROLE
=fputs( f , str( tseq , 9 , 0 ) ) && Order number
=fputs( f , str( tmatch , 9 , 0 ) ) && Match number
=fputs( f , str( tnextdead , 9 , 0 ) ) && Next dead order pointer =fclose(f)
quit
procedure title
activate window title SAME
clear
@ 0,0 SAY " Island2 ú Version "+VERSION+" (c)1996 Joshua Levine ú Press [?] for help"
activate window ticker SAME
return
proc werror
param wcode
do case
case wcode = "w"
return "Error on file write"
case wcode = "s"
return "Error on nework send"
case wcode = "c"
return "Invalid message length"
case wcode = "d"
return "all files full"
endcase
return "Unknown error"
**** write actualy writes a string the the file, steam, and screen
proc write
parameter wstring
wl = len( wstring )
ws="W"+chr(wl)+wstring
call int99 with ws
gmessages = gmessages + 1
if ws = 'b'
gstoredflag = .T.
else
if ws = "f"
gpackets = gpackets + 1
gstoredflag = .F.
else
activate window output
? time() +" !!!! ERROR ON WRITE!!!!!!"
? ws
do alert with "Erorr on write:"+werror(ws)
activate window ticker
suspend
endif
endif
return
*** Write a message
**** ACTIONS:
**** A - Accept the order was accepted into Island
**** B - Booked this order hit the book
**** E - Execute the order was executed for this many shares at this price
**** X - Cancel this many shares were canceled
**** C - Break this order was executed, now broken
**** G - Control stock is the control type
**** R - Report trade done away but will report/clear through Island
**** ON Cancel CONTRA = Reason for cancel
***** MINDICATE = on accept always "D" (legacy)
***** on execute "A"= added liquidity, "R"=Removed liquidity
***** on report "Y" trade report, "N" don't report, "S" step-out
****** mmatch = on accept or book is MINIMUM shares, in execution is match number
****** not defined on cancels, but 0 for now
proc mwrite
parameter maction,mseq,mshares,mprice,mcontra,mindicate,mmatch,mlocate
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + "," +maction+","+str(mseq,9,0)+","+PORT+","+USER+","+TOKEN+","+BUY_SELL+","+str(mshares,9,0)+","+str(mmatch,9,0)+","+STOCK+","+str(mprice,11,4)+"," +str(mlocate,8,0)+ ", 0,"+SHORT+","+MMID+","+PA+","+mcontra+","+
mindicate+","+DISPLAY+","+right(mwhen,3)+","+CLEARING+",D"
do write with w
return
****** Swrite writes a status message that doesnot concern an order, Like G-Good morning
proc swrite
param maction , mcode
mwhen = str( tnow , 9 , 3)
xcode = left( padr( mcode , 3) , 3 )
w = left( mwhen , 5 ) +","+maction+","+" 0"+", , , , , 0, 0,*"+xcode+" , 0.0000,00000000, 0, , , , , , ,"+right( mwhen , 3 )+", , "
do write with w
return
****** Enter order adds the audit, tries for a match, and if it don't work, books it.
****** Enter order assumes ostock and obuy_sell are the right length.
****** Also assumes that buy_sell has aready been checked to be B or S.
****** Also assumes that the token is no already used
proc enter2order
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,otif,oshort,ommid,opa,odisplay,omin,oclearing,oflags
if odisplay = "P"
obasefirm = ouser
else
obasefirm = "####"
endif
&& Get the working record
if tnextdead > 0
tlocate = tnextdead
goto tnextdead
tnextdead = SEQ
else
insert into ISLAND (LEAVES) values (0) && Keep it out of the indexes for now
tlocate = recno()
endif
tseq = tseq + 1
awhen = str( tnow , 9 , 3)
oleaves = oshares
ofilled = 0
aflag = .f. && have we written the "A" message yet?
if obuy_sell = "B" && Buy order...
set order to SSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
*** There were at least enough to fill the minimum quantity
mmax = oshares
else
*** Not enough to fill the min, so fill none
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
*** Max out with the number of shares specified
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice >= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0)+ ", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0)+", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
else && sell order..
set order to BSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
mmax = oshares
else
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice <= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +","+str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0) +", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0) +", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
endif
if oleaves > 0 && any non-executed shares left?
if otif = 0 && Fill or kill, so cancel leaves
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ "," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
endif
w = left( awhen , 5 ) +",X," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ ", 0," +oshort +"," +ommid +"," +
opa+",#IOC, ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
oleaves = 0
else
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+",B," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
else
w = left( awhen , 5 ) +",B," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0) +"," +
oshort +"," +ommid +"," +opa+", , ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
endif
do write with w
endif && otif == 0
endif && oleaves > 0
if oleaves > 0 && Still open?
goto tlocate
replace ;
PORT with oport,;
USER with ouser,;
TOKEN with otoken,;
BUY_SELL with obuy_sell,;
LEAVES with oleaves,;
STOCK with ostock,;
PRICE with oprice,;
SHORT with oshort,;
MMID with ommid,;
PA with opa,;
DISPLAY with odisplay,;
CLEARING with oclearing,;
FILLED with ofilled,;
SEQ with tseq
else && leaves = 0 (add current order to deadlist)
goto tlocate
replace SEQ with tnextdead
tnextdead = recno()
endif && oleaves > 0
return
****** Enter Report adds a type R line to the file
****** Enter order assumes ostock and obuy_sell are the right length.
proc enter2report
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,oshort,ommid,opa,oreport,oclearing,ocontra
tseq = tseq + 1
tmatch = tmatch + 1
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",R,"+str(tseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(tmatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oSHORT+","+oMMID+","+oPA+","+ocontra+","+oreport+",R,"+
right(mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter Reject adds a type J line to the file
proc enter2reject
parameter oport,ouser,otoken,otype,oreason
tseq = tseq + 1
*** Leaves MUST be 0 or it might be included in the match!
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",J," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken+"," +otype+", 0, 0, , 0.0000,00000000, 0, , , , ," +oreason +",N,"+right(mwhen,3)+", ,D"
do write with w
return
****** Enter break adds a type C line to the file
proc enterbreak
parameter oseq, oport , ouser, otoken, obuy_sell, oshares, omatch, ostock, oprice, ommid, oreason, omisc, oclearing , oshort
if oseq > tseq .or. oseq < 1
? time()+" Bad SEQ in Break! OSEQ="+str(oseq,9,0)+" RECS="+str( tseq, 9,0)
return
endif
if oshares <= 0
? time()+" Jerk boy BREAK zero shares SEQ="+str(oseq,9,0)
return
endif
if oprice <= 0
? time()+" Jerk boy BREAK zero price SEQ="+str(oseq,9,0)
return
endif
if ! omisc $ "AR"
? time()+" Invalid A/R BREAK MISC="+omisc+" SEQ="+str(oseq,9,0)
return
endif
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",C,"+str(oseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(omatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oshort+","+oMMID+", ,"+oreason +","+omisc+", ,"+right(
mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter maint adds a type M line to the file
*** SHORTTYPE
***** N - No short sale checks
***** B - Bidtick test
***** L - Lasttrade test
*** BLOCKSUB - Block subscriber only orders?
***** B - Block
***** N - No block
*** CENTER
***** Q - NASDAQ
***** L - LISTED
proc entermaint
parameter oport,ouser,otoken,ostock,oshorttype,oblocksub,ocenter,omisc
if ! oshorttype $ "NBL"
? time()+" Bad SHORTTYPE="+oshorttype+" STOCK="+ostock
return
endif
if !oblocksub $ "BN"
? time()+" Bad BLOCKSUB="+oblocksub+" STOCK="+ostock
return
endif
if !ocenter $ "QL"
? time()+" Bad CENTER="+ocenter+" STOCK="+ostock
return
endif
if len( omisc ) # 4
? time()+" Bad omisc len!"+omisc
return
endif
for eml = 1 to 4
emb = substr( omisc , eml , 1 )
if !isalpha( emb ) .and. emb # " "
? time()+" Bad omisc letter!"+omisc
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",S, 0, 0," +ostock +", 0.0000,00000000, 0,"+oshorttype+", , ,"+omisc+","+ocenter+","+oblocksub+"," +right(awhen,3) +", , "
do write with w
return
*** STATE - Trading state
***** T - Trading
***** H - Halted
proc enterstate
parameter oport,ouser,otoken,ostock,ostate
if !ostate $ "TH"
? time()+" Bad STATE="+ostate+" STOCK="+ostock
return
endif
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",T, 0, 0," +ostock +", 0.0000,00000000, 0, , , , ,"+ostate+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter account configures an OUCH account
proc enteraccount
parameter oaccount,opassword,otest,otrusted, othresh, osscheck,oiflag, odefault
if !otest$"TN"
? time()+" Bad TEST flag in enteraccount:"+otest
return
endif
if !otrusted$"TN"
? time()+" Bad TRUSTED flag in enteraccount:"+otrusted
return
endif
if !osscheck$"YN"
? time()+" Bad SSCHECK flag in enteraccount:"+osscheck
return
endif
if !oiflag$"IN"
? time()+" Bad IFLAG flag in enteraccount:"+oiflag
return
endif
if len( opassword ) # 10
? time()+" Bad opassword len!"+opassword
return
endif
for eml = 1 to 10
emb = substr( opassword , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " " .and. emb # "!" .and. emb # "#"
? time()+" Bad opassword letter!"+opassword+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
if len( odefault ) # 4
? time()+" Bad odefault len!"+odefault
return
endif
for eml = 1 to 4
emb = substr( odefault , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad odefault letter!"+odefault +":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", ,"+opassword+",A,"+str(othresh,9,0)+", 0, , 0.0000,00000000, 0,"+osscheck+","+odefault +", ,"+otest+ " "+ otrusted +" ,"+oiflag+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter firm configures an OUCH account for clearing
proc enterfirm
parameter oaccount,ommid,oclearing
if !oclearing$"AIQRN"
? time()+" Bad clearing in enterfirm:"+oclearing
return
endif
if len( ommid ) # 4
? time()+" Bad ommid len!"+ommid
return
endif
for eml = 1 to 4
emb = substr( ommid , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad ommid letter!"+ommid+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", , ,F, 0, 0, , 0.0000,00000000, 0, ,"+ ommid +", , , , ," +right(awhen,3) +","+oclearing+", "
do write with w
return
proc new2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
if LEAVES <= oshares
ttoolate = ttoolate + 1
return
endif
xshares = LEAVES - oshares
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return
****** Cancel Order takes a locator and a SEQ number
****** passed shares in new intedned order size
****** returns number of shares canceled and leaves record pointer on order canceled.
proc i2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
msize = LEAVES + FILLED && Current size of order
if oshares >= msize
*** ? time()+" INTENEDED CANCEL BIGGER THAN ORDER SHARES="+str( oshares, 6 , 0 )+" REASON="+ocontra
return 0
endif
xshares = msize - oshares && HOwmany do we have to cancel to get from current size to new size?
if xshares > LEAVES && Don't cancel more than are open
xshares = LEAVES
endif
if xshares = 0
ttoolate = ttoolate + 1
return 0
endif
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return xshares
proc initstatus
activate window status
@ 0,1 SAY "Orders:"
@ 0,27 SAY "Executions:"
@ 0,52 SAY "Cancels:"
activate window ticker
return
proc showstatus
activate window status
@ 0,11 SAY tseq PICTURE "##,###,###"
@ 0,38 SAY tmatch PICTURE "##,###,###"
@ 0,60 SAY txcount PICTURE "##,###,###"
activate window ticker
return
proc processtcpip
[continued in next message]
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
-
From
The Deprogram@21:1/5 to
All on Sun Sep 20 18:52:54 2020
[continued from previous message]
do pingreply with tsource , tmessage
else
do processtcpip with tmessage
endif
else && No pending commands...
if gstoredflag
do flush
gstoredflag = .F.
gmoldheart = seconds() + gmolddelay
gpackets = gpackets + 1
else
if gmoldheart < seconds()
do flush
gmoldheart = seconds() + gmolddelay
endif
endif
endif
if gnextstats <= seconds()
do showstatus
gnextstats = seconds() + gstatdelay
endif
lastkey=inkey()
if lastkey # 0
activate window output
do case
case lastkey = asc("~")
? time()+" Quitting..."
mdone = .T.
case lastkey = asc("@")
? time()+" Copying to island2.dbf"
set order to
copy to m:\island2\island2
?? "Done"
case lastkey = asc("#")
? time()+" Suspending..."
suspend
case lastkey = asc("!")
? time()+" ACCEPT="+iif(gaccept,"T","F")+" ACT="+ iif(gactaccept,"T","F") + " EOM="+iif(geom,"T","F")+" NEXT="+str(tnext,9,3)+ " TOO-LATE="+str(ttoolate,6,0)+" COUNT="+str(tcount,9,0)
s = "T"+space(60)
call int99 with s
if s = "t"
tbuffered = val( substr(s,26,5) )
? "MOLD INFO: SESSION="+substr(s,2,10)+" SEQ="+substr(s,12,10)+" SOCKET="+substr(s,22,4)+" BUFFERED="+str(tbuffered,5,0)
else
? "Could not get mold info!"
tbuffered = 0
endif
if gpackets > 0
? "MESSAGES:"+str(gmessages-tbuffered,12,0)+" PACKETS:"+str(gpackets,12,0)+" ("+str( (gmessages-tbuffered)/ gpackets , 5 , 3 )+")"
gmessages = tbuffered
gpackets =0
endif
case lastkey = asc("%")
? time()+" Shutdown attempt..."
do shutdown
case lastkey = asc("(")
? time()+" toggled gaccept"
gaccept = !gaccept
case lastkey = asc("?")
? "@-Copy to island2.DBF ~-Quit !-Status #-Suspend %-ShutDown $-Print incoming"
case lastkey = asc("$")
if gprinting
? time()+" Printing off"
gprinting = .F.
else
? time()+" Printing on"
gprinting = .T.
endif
endcase
activate window ticker
endif
enddo && Main Loop
activate window output
&& Final flush to mak sure everything is sent
do flush
&& Close file
s = "C"
call int99 with s
x = "H"+READPORT
call int99 with x
if x # "h"
do alert with "Could not close PingPort!"
endif
use && Unuse Island
&& Create fresh waypoint file
f = fcreate("ISLAND2.TXT")
if f<=0
? "Could not create ISLAND.TXT!"
suspend
endif
=fputs( f , "ISLAND2" ) && ROLE
=fputs( f , str( tseq , 9 , 0 ) ) && Order number
=fputs( f , str( tmatch , 9 , 0 ) ) && Match number
=fputs( f , str( tnextdead , 9 , 0 ) ) && Next dead order pointer =fclose(f)
quit
procedure title
activate window title SAME
clear
@ 0,0 SAY " Island2 ú Version "+VERSION+" (c)1996 Joshua Levine ú Press [?] for help"
activate window ticker SAME
return
proc werror
param wcode
do case
case wcode = "w"
return "Error on file write"
case wcode = "s"
return "Error on nework send"
case wcode = "c"
return "Invalid message length"
case wcode = "d"
return "all files full"
endcase
return "Unknown error"
**** write actualy writes a string the the file, steam, and screen
proc write
parameter wstring
wl = len( wstring )
ws="W"+chr(wl)+wstring
call int99 with ws
gmessages = gmessages + 1
if ws = 'b'
gstoredflag = .T.
else
if ws = "f"
gpackets = gpackets + 1
gstoredflag = .F.
else
activate window output
? time() +" !!!! ERROR ON WRITE!!!!!!"
? ws
do alert with "Erorr on write:"+werror(ws)
activate window ticker
suspend
endif
endif
return
*** Write a message
**** ACTIONS:
**** A - Accept the order was accepted into Island
**** B - Booked this order hit the book
**** E - Execute the order was executed for this many shares at this price
**** X - Cancel this many shares were canceled
**** C - Break this order was executed, now broken
**** G - Control stock is the control type
**** R - Report trade done away but will report/clear through Island
**** ON Cancel CONTRA = Reason for cancel
***** MINDICATE = on accept always "D" (legacy)
***** on execute "A"= added liquidity, "R"=Removed liquidity
***** on report "Y" trade report, "N" don't report, "S" step-out
****** mmatch = on accept or book is MINIMUM shares, in execution is match number
****** not defined on cancels, but 0 for now
proc mwrite
parameter maction,mseq,mshares,mprice,mcontra,mindicate,mmatch,mlocate
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + "," +maction+","+str(mseq,9,0)+","+PORT+","+USER+","+TOKEN+","+BUY_SELL+","+str(mshares,9,0)+","+str(mmatch,9,0)+","+STOCK+","+str(mprice,11,4)+"," +str(mlocate,8,0)+ ", 0,"+SHORT+","+MMID+","+PA+","+mcontra+","+
mindicate+","+DISPLAY+","+right(mwhen,3)+","+CLEARING+",D"
do write with w
return
****** Swrite writes a status message that doesnot concern an order, Like G-Good morning
proc swrite
param maction , mcode
mwhen = str( tnow , 9 , 3)
xcode = left( padr( mcode , 3) , 3 )
w = left( mwhen , 5 ) +","+maction+","+" 0"+", , , , , 0, 0,*"+xcode+" , 0.0000,00000000, 0, , , , , , ,"+right( mwhen , 3 )+", , "
do write with w
return
****** Enter order adds the audit, tries for a match, and if it don't work, books it.
****** Enter order assumes ostock and obuy_sell are the right length.
****** Also assumes that buy_sell has aready been checked to be B or S.
****** Also assumes that the token is no already used
proc enter2order
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,otif,oshort,ommid,opa,odisplay,omin,oclearing,oflags
if odisplay = "P"
obasefirm = ouser
else
obasefirm = "####"
endif
&& Get the working record
if tnextdead > 0
tlocate = tnextdead
goto tnextdead
tnextdead = SEQ
else
insert into ISLAND (LEAVES) values (0) && Keep it out of the indexes for now
tlocate = recno()
endif
tseq = tseq + 1
awhen = str( tnow , 9 , 3)
oleaves = oshares
ofilled = 0
aflag = .f. && have we written the "A" message yet?
if obuy_sell = "B" && Buy order...
set order to SSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
*** There were at least enough to fill the minimum quantity
mmax = oshares
else
*** Not enough to fill the min, so fill none
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
*** Max out with the number of shares specified
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice >= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0)+ ", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0)+", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
else && sell order..
set order to BSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
mmax = oshares
else
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice <= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +","+str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0) +", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0) +", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
endif
if oleaves > 0 && any non-executed shares left?
if otif = 0 && Fill or kill, so cancel leaves
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ "," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
endif
w = left( awhen , 5 ) +",X," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ ", 0," +oshort +"," +ommid +"," +
opa+",#IOC, ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
oleaves = 0
else
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+",B," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
else
w = left( awhen , 5 ) +",B," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0) +"," +
oshort +"," +ommid +"," +opa+", , ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
endif
do write with w
endif && otif == 0
endif && oleaves > 0
if oleaves > 0 && Still open?
goto tlocate
replace ;
PORT with oport,;
USER with ouser,;
TOKEN with otoken,;
BUY_SELL with obuy_sell,;
LEAVES with oleaves,;
STOCK with ostock,;
PRICE with oprice,;
SHORT with oshort,;
MMID with ommid,;
PA with opa,;
DISPLAY with odisplay,;
CLEARING with oclearing,;
FILLED with ofilled,;
SEQ with tseq
else && leaves = 0 (add current order to deadlist)
goto tlocate
replace SEQ with tnextdead
tnextdead = recno()
endif && oleaves > 0
return
****** Enter Report adds a type R line to the file
****** Enter order assumes ostock and obuy_sell are the right length.
proc enter2report
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,oshort,ommid,opa,oreport,oclearing,ocontra
tseq = tseq + 1
tmatch = tmatch + 1
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",R,"+str(tseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(tmatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oSHORT+","+oMMID+","+oPA+","+ocontra+","+oreport+",R,"+
right(mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter Reject adds a type J line to the file
proc enter2reject
parameter oport,ouser,otoken,otype,oreason
tseq = tseq + 1
*** Leaves MUST be 0 or it might be included in the match!
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",J," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken+"," +otype+", 0, 0, , 0.0000,00000000, 0, , , , ," +oreason +",N,"+right(mwhen,3)+", ,D"
do write with w
return
****** Enter break adds a type C line to the file
proc enterbreak
parameter oseq, oport , ouser, otoken, obuy_sell, oshares, omatch, ostock, oprice, ommid, oreason, omisc, oclearing , oshort
if oseq > tseq .or. oseq < 1
? time()+" Bad SEQ in Break! OSEQ="+str(oseq,9,0)+" RECS="+str( tseq, 9,0)
return
endif
if oshares <= 0
? time()+" Jerk boy BREAK zero shares SEQ="+str(oseq,9,0)
return
endif
if oprice <= 0
? time()+" Jerk boy BREAK zero price SEQ="+str(oseq,9,0)
return
endif
if ! omisc $ "AR"
? time()+" Invalid A/R BREAK MISC="+omisc+" SEQ="+str(oseq,9,0)
return
endif
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",C,"+str(oseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(omatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oshort+","+oMMID+", ,"+oreason +","+omisc+", ,"+right(
mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter maint adds a type M line to the file
*** SHORTTYPE
***** N - No short sale checks
***** B - Bidtick test
***** L - Lasttrade test
*** BLOCKSUB - Block subscriber only orders?
***** B - Block
***** N - No block
*** CENTER
***** Q - NASDAQ
***** L - LISTED
proc entermaint
parameter oport,ouser,otoken,ostock,oshorttype,oblocksub,ocenter,omisc
if ! oshorttype $ "NBL"
? time()+" Bad SHORTTYPE="+oshorttype+" STOCK="+ostock
return
endif
if !oblocksub $ "BN"
? time()+" Bad BLOCKSUB="+oblocksub+" STOCK="+ostock
return
endif
if !ocenter $ "QL"
? time()+" Bad CENTER="+ocenter+" STOCK="+ostock
return
endif
if len( omisc ) # 4
? time()+" Bad omisc len!"+omisc
return
endif
for eml = 1 to 4
emb = substr( omisc , eml , 1 )
if !isalpha( emb ) .and. emb # " "
? time()+" Bad omisc letter!"+omisc
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",S, 0, 0," +ostock +", 0.0000,00000000, 0,"+oshorttype+", , ,"+omisc+","+ocenter+","+oblocksub+"," +right(awhen,3) +", , "
do write with w
return
*** STATE - Trading state
***** T - Trading
***** H - Halted
proc enterstate
parameter oport,ouser,otoken,ostock,ostate
if !ostate $ "TH"
? time()+" Bad STATE="+ostate+" STOCK="+ostock
return
endif
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",T, 0, 0," +ostock +", 0.0000,00000000, 0, , , , ,"+ostate+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter account configures an OUCH account
proc enteraccount
parameter oaccount,opassword,otest,otrusted, othresh, osscheck,oiflag, odefault
if !otest$"TN"
? time()+" Bad TEST flag in enteraccount:"+otest
return
endif
if !otrusted$"TN"
? time()+" Bad TRUSTED flag in enteraccount:"+otrusted
return
endif
if !osscheck$"YN"
? time()+" Bad SSCHECK flag in enteraccount:"+osscheck
return
endif
if !oiflag$"IN"
? time()+" Bad IFLAG flag in enteraccount:"+oiflag
return
endif
if len( opassword ) # 10
? time()+" Bad opassword len!"+opassword
return
endif
for eml = 1 to 10
emb = substr( opassword , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " " .and. emb # "!" .and. emb # "#"
? time()+" Bad opassword letter!"+opassword+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
if len( odefault ) # 4
? time()+" Bad odefault len!"+odefault
return
endif
for eml = 1 to 4
emb = substr( odefault , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad odefault letter!"+odefault +":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", ,"+opassword+",A,"+str(othresh,9,0)+", 0, , 0.0000,00000000, 0,"+osscheck+","+odefault +", ,"+otest+ " "+ otrusted +" ,"+oiflag+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter firm configures an OUCH account for clearing
proc enterfirm
parameter oaccount,ommid,oclearing
if !oclearing$"AIQRN"
? time()+" Bad clearing in enterfirm:"+oclearing
return
endif
if len( ommid ) # 4
? time()+" Bad ommid len!"+ommid
return
endif
for eml = 1 to 4
emb = substr( ommid , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad ommid letter!"+ommid+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", , ,F, 0, 0, , 0.0000,00000000, 0, ,"+ ommid +", , , , ," +right(awhen,3) +","+oclearing+", "
do write with w
return
proc new2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
if LEAVES <= oshares
ttoolate = ttoolate + 1
return
endif
xshares = LEAVES - oshares
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return
****** Cancel Order takes a locator and a SEQ number
****** passed shares in new intedned order size
****** returns number of shares canceled and leaves record pointer on order canceled.
proc i2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
msize = LEAVES + FILLED && Current size of order
if oshares >= msize
*** ? time()+" INTENEDED CANCEL BIGGER THAN ORDER SHARES="+str( oshares, 6 , 0 )+" REASON="+ocontra
return 0
endif
xshares = msize - oshares && HOwmany do we have to cancel to get from current size to new size?
if xshares > LEAVES && Don't cancel more than are open
xshares = LEAVES
endif
if xshares = 0
ttoolate = ttoolate + 1
return 0
endif
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return xshares
proc initstatus
activate window status
@ 0,1 SAY "Orders:"
@ 0,27 SAY "Executions:"
@ 0,52 SAY "Cancels:"
activate window ticker
return
proc showstatus
activate window status
@ 0,11 SAY tseq PICTURE "##,###,###"
@ 0,38 SAY tmatch PICTURE "##,###,###"
@ 0,60 SAY txcount PICTURE "##,###,###"
activate window ticker
return
proc processtcpip
[continued in next message]
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
-
From
The Deprogram@21:1/5 to
All on Sun Sep 20 18:53:24 2020
[continued from previous message]
do pingreply with tsource , tmessage
else
do processtcpip with tmessage
endif
else && No pending commands...
if gstoredflag
do flush
gstoredflag = .F.
gmoldheart = seconds() + gmolddelay
gpackets = gpackets + 1
else
if gmoldheart < seconds()
do flush
gmoldheart = seconds() + gmolddelay
endif
endif
endif
if gnextstats <= seconds()
do showstatus
gnextstats = seconds() + gstatdelay
endif
lastkey=inkey()
if lastkey # 0
activate window output
do case
case lastkey = asc("~")
? time()+" Quitting..."
mdone = .T.
case lastkey = asc("@")
? time()+" Copying to island2.dbf"
set order to
copy to m:\island2\island2
?? "Done"
case lastkey = asc("#")
? time()+" Suspending..."
suspend
case lastkey = asc("!")
? time()+" ACCEPT="+iif(gaccept,"T","F")+" ACT="+ iif(gactaccept,"T","F") + " EOM="+iif(geom,"T","F")+" NEXT="+str(tnext,9,3)+ " TOO-LATE="+str(ttoolate,6,0)+" COUNT="+str(tcount,9,0)
s = "T"+space(60)
call int99 with s
if s = "t"
tbuffered = val( substr(s,26,5) )
? "MOLD INFO: SESSION="+substr(s,2,10)+" SEQ="+substr(s,12,10)+" SOCKET="+substr(s,22,4)+" BUFFERED="+str(tbuffered,5,0)
else
? "Could not get mold info!"
tbuffered = 0
endif
if gpackets > 0
? "MESSAGES:"+str(gmessages-tbuffered,12,0)+" PACKETS:"+str(gpackets,12,0)+" ("+str( (gmessages-tbuffered)/ gpackets , 5 , 3 )+")"
gmessages = tbuffered
gpackets =0
endif
case lastkey = asc("%")
? time()+" Shutdown attempt..."
do shutdown
case lastkey = asc("(")
? time()+" toggled gaccept"
gaccept = !gaccept
case lastkey = asc("?")
? "@-Copy to island2.DBF ~-Quit !-Status #-Suspend %-ShutDown $-Print incoming"
case lastkey = asc("$")
if gprinting
? time()+" Printing off"
gprinting = .F.
else
? time()+" Printing on"
gprinting = .T.
endif
endcase
activate window ticker
endif
enddo && Main Loop
activate window output
&& Final flush to mak sure everything is sent
do flush
&& Close file
s = "C"
call int99 with s
x = "H"+READPORT
call int99 with x
if x # "h"
do alert with "Could not close PingPort!"
endif
use && Unuse Island
&& Create fresh waypoint file
f = fcreate("ISLAND2.TXT")
if f<=0
? "Could not create ISLAND.TXT!"
suspend
endif
=fputs( f , "ISLAND2" ) && ROLE
=fputs( f , str( tseq , 9 , 0 ) ) && Order number
=fputs( f , str( tmatch , 9 , 0 ) ) && Match number
=fputs( f , str( tnextdead , 9 , 0 ) ) && Next dead order pointer =fclose(f)
quit
procedure title
activate window title SAME
clear
@ 0,0 SAY " Island2 ú Version "+VERSION+" (c)1996 Joshua Levine ú Press [?] for help"
activate window ticker SAME
return
proc werror
param wcode
do case
case wcode = "w"
return "Error on file write"
case wcode = "s"
return "Error on nework send"
case wcode = "c"
return "Invalid message length"
case wcode = "d"
return "all files full"
endcase
return "Unknown error"
**** write actualy writes a string the the file, steam, and screen
proc write
parameter wstring
wl = len( wstring )
ws="W"+chr(wl)+wstring
call int99 with ws
gmessages = gmessages + 1
if ws = 'b'
gstoredflag = .T.
else
if ws = "f"
gpackets = gpackets + 1
gstoredflag = .F.
else
activate window output
? time() +" !!!! ERROR ON WRITE!!!!!!"
? ws
do alert with "Erorr on write:"+werror(ws)
activate window ticker
suspend
endif
endif
return
*** Write a message
**** ACTIONS:
**** A - Accept the order was accepted into Island
**** B - Booked this order hit the book
**** E - Execute the order was executed for this many shares at this price
**** X - Cancel this many shares were canceled
**** C - Break this order was executed, now broken
**** G - Control stock is the control type
**** R - Report trade done away but will report/clear through Island
**** ON Cancel CONTRA = Reason for cancel
***** MINDICATE = on accept always "D" (legacy)
***** on execute "A"= added liquidity, "R"=Removed liquidity
***** on report "Y" trade report, "N" don't report, "S" step-out
****** mmatch = on accept or book is MINIMUM shares, in execution is match number
****** not defined on cancels, but 0 for now
proc mwrite
parameter maction,mseq,mshares,mprice,mcontra,mindicate,mmatch,mlocate
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + "," +maction+","+str(mseq,9,0)+","+PORT+","+USER+","+TOKEN+","+BUY_SELL+","+str(mshares,9,0)+","+str(mmatch,9,0)+","+STOCK+","+str(mprice,11,4)+"," +str(mlocate,8,0)+ ", 0,"+SHORT+","+MMID+","+PA+","+mcontra+","+
mindicate+","+DISPLAY+","+right(mwhen,3)+","+CLEARING+",D"
do write with w
return
****** Swrite writes a status message that doesnot concern an order, Like G-Good morning
proc swrite
param maction , mcode
mwhen = str( tnow , 9 , 3)
xcode = left( padr( mcode , 3) , 3 )
w = left( mwhen , 5 ) +","+maction+","+" 0"+", , , , , 0, 0,*"+xcode+" , 0.0000,00000000, 0, , , , , , ,"+right( mwhen , 3 )+", , "
do write with w
return
****** Enter order adds the audit, tries for a match, and if it don't work, books it.
****** Enter order assumes ostock and obuy_sell are the right length.
****** Also assumes that buy_sell has aready been checked to be B or S.
****** Also assumes that the token is no already used
proc enter2order
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,otif,oshort,ommid,opa,odisplay,omin,oclearing,oflags
if odisplay = "P"
obasefirm = ouser
else
obasefirm = "####"
endif
&& Get the working record
if tnextdead > 0
tlocate = tnextdead
goto tnextdead
tnextdead = SEQ
else
insert into ISLAND (LEAVES) values (0) && Keep it out of the indexes for now
tlocate = recno()
endif
tseq = tseq + 1
awhen = str( tnow , 9 , 3)
oleaves = oshares
ofilled = 0
aflag = .f. && have we written the "A" message yet?
if obuy_sell = "B" && Buy order...
set order to SSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
*** There were at least enough to fill the minimum quantity
mmax = oshares
else
*** Not enough to fill the min, so fill none
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
*** Max out with the number of shares specified
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice >= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0)+ ", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0)+", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
else && sell order..
set order to BSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
mmax = oshares
else
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice <= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +","+str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0) +", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0) +", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
endif
if oleaves > 0 && any non-executed shares left?
if otif = 0 && Fill or kill, so cancel leaves
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ "," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
endif
w = left( awhen , 5 ) +",X," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ ", 0," +oshort +"," +ommid +"," +
opa+",#IOC, ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
oleaves = 0
else
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+",B," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
else
w = left( awhen , 5 ) +",B," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0) +"," +
oshort +"," +ommid +"," +opa+", , ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
endif
do write with w
endif && otif == 0
endif && oleaves > 0
if oleaves > 0 && Still open?
goto tlocate
replace ;
PORT with oport,;
USER with ouser,;
TOKEN with otoken,;
BUY_SELL with obuy_sell,;
LEAVES with oleaves,;
STOCK with ostock,;
PRICE with oprice,;
SHORT with oshort,;
MMID with ommid,;
PA with opa,;
DISPLAY with odisplay,;
CLEARING with oclearing,;
FILLED with ofilled,;
SEQ with tseq
else && leaves = 0 (add current order to deadlist)
goto tlocate
replace SEQ with tnextdead
tnextdead = recno()
endif && oleaves > 0
return
****** Enter Report adds a type R line to the file
****** Enter order assumes ostock and obuy_sell are the right length.
proc enter2report
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,oshort,ommid,opa,oreport,oclearing,ocontra
tseq = tseq + 1
tmatch = tmatch + 1
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",R,"+str(tseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(tmatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oSHORT+","+oMMID+","+oPA+","+ocontra+","+oreport+",R,"+
right(mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter Reject adds a type J line to the file
proc enter2reject
parameter oport,ouser,otoken,otype,oreason
tseq = tseq + 1
*** Leaves MUST be 0 or it might be included in the match!
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",J," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken+"," +otype+", 0, 0, , 0.0000,00000000, 0, , , , ," +oreason +",N,"+right(mwhen,3)+", ,D"
do write with w
return
****** Enter break adds a type C line to the file
proc enterbreak
parameter oseq, oport , ouser, otoken, obuy_sell, oshares, omatch, ostock, oprice, ommid, oreason, omisc, oclearing , oshort
if oseq > tseq .or. oseq < 1
? time()+" Bad SEQ in Break! OSEQ="+str(oseq,9,0)+" RECS="+str( tseq, 9,0)
return
endif
if oshares <= 0
? time()+" Jerk boy BREAK zero shares SEQ="+str(oseq,9,0)
return
endif
if oprice <= 0
? time()+" Jerk boy BREAK zero price SEQ="+str(oseq,9,0)
return
endif
if ! omisc $ "AR"
? time()+" Invalid A/R BREAK MISC="+omisc+" SEQ="+str(oseq,9,0)
return
endif
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",C,"+str(oseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(omatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oshort+","+oMMID+", ,"+oreason +","+omisc+", ,"+right(
mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter maint adds a type M line to the file
*** SHORTTYPE
***** N - No short sale checks
***** B - Bidtick test
***** L - Lasttrade test
*** BLOCKSUB - Block subscriber only orders?
***** B - Block
***** N - No block
*** CENTER
***** Q - NASDAQ
***** L - LISTED
proc entermaint
parameter oport,ouser,otoken,ostock,oshorttype,oblocksub,ocenter,omisc
if ! oshorttype $ "NBL"
? time()+" Bad SHORTTYPE="+oshorttype+" STOCK="+ostock
return
endif
if !oblocksub $ "BN"
? time()+" Bad BLOCKSUB="+oblocksub+" STOCK="+ostock
return
endif
if !ocenter $ "QL"
? time()+" Bad CENTER="+ocenter+" STOCK="+ostock
return
endif
if len( omisc ) # 4
? time()+" Bad omisc len!"+omisc
return
endif
for eml = 1 to 4
emb = substr( omisc , eml , 1 )
if !isalpha( emb ) .and. emb # " "
? time()+" Bad omisc letter!"+omisc
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",S, 0, 0," +ostock +", 0.0000,00000000, 0,"+oshorttype+", , ,"+omisc+","+ocenter+","+oblocksub+"," +right(awhen,3) +", , "
do write with w
return
*** STATE - Trading state
***** T - Trading
***** H - Halted
proc enterstate
parameter oport,ouser,otoken,ostock,ostate
if !ostate $ "TH"
? time()+" Bad STATE="+ostate+" STOCK="+ostock
return
endif
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",T, 0, 0," +ostock +", 0.0000,00000000, 0, , , , ,"+ostate+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter account configures an OUCH account
proc enteraccount
parameter oaccount,opassword,otest,otrusted, othresh, osscheck,oiflag, odefault
if !otest$"TN"
? time()+" Bad TEST flag in enteraccount:"+otest
return
endif
if !otrusted$"TN"
? time()+" Bad TRUSTED flag in enteraccount:"+otrusted
return
endif
if !osscheck$"YN"
? time()+" Bad SSCHECK flag in enteraccount:"+osscheck
return
endif
if !oiflag$"IN"
? time()+" Bad IFLAG flag in enteraccount:"+oiflag
return
endif
if len( opassword ) # 10
? time()+" Bad opassword len!"+opassword
return
endif
for eml = 1 to 10
emb = substr( opassword , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " " .and. emb # "!" .and. emb # "#"
? time()+" Bad opassword letter!"+opassword+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
if len( odefault ) # 4
? time()+" Bad odefault len!"+odefault
return
endif
for eml = 1 to 4
emb = substr( odefault , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad odefault letter!"+odefault +":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", ,"+opassword+",A,"+str(othresh,9,0)+", 0, , 0.0000,00000000, 0,"+osscheck+","+odefault +", ,"+otest+ " "+ otrusted +" ,"+oiflag+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter firm configures an OUCH account for clearing
proc enterfirm
parameter oaccount,ommid,oclearing
if !oclearing$"AIQRN"
? time()+" Bad clearing in enterfirm:"+oclearing
return
endif
if len( ommid ) # 4
? time()+" Bad ommid len!"+ommid
return
endif
for eml = 1 to 4
emb = substr( ommid , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad ommid letter!"+ommid+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", , ,F, 0, 0, , 0.0000,00000000, 0, ,"+ ommid +", , , , ," +right(awhen,3) +","+oclearing+", "
do write with w
return
proc new2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
if LEAVES <= oshares
ttoolate = ttoolate + 1
return
endif
xshares = LEAVES - oshares
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return
****** Cancel Order takes a locator and a SEQ number
****** passed shares in new intedned order size
****** returns number of shares canceled and leaves record pointer on order canceled.
proc i2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
msize = LEAVES + FILLED && Current size of order
if oshares >= msize
*** ? time()+" INTENEDED CANCEL BIGGER THAN ORDER SHARES="+str( oshares, 6 , 0 )+" REASON="+ocontra
return 0
endif
xshares = msize - oshares && HOwmany do we have to cancel to get from current size to new size?
if xshares > LEAVES && Don't cancel more than are open
xshares = LEAVES
endif
if xshares = 0
ttoolate = ttoolate + 1
return 0
endif
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return xshares
proc initstatus
activate window status
@ 0,1 SAY "Orders:"
@ 0,27 SAY "Executions:"
@ 0,52 SAY "Cancels:"
activate window ticker
return
proc showstatus
activate window status
@ 0,11 SAY tseq PICTURE "##,###,###"
@ 0,38 SAY tmatch PICTURE "##,###,###"
@ 0,60 SAY txcount PICTURE "##,###,###"
activate window ticker
return
proc processtcpip
[continued in next message]
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
-
From
The Deprogram@21:1/5 to
All on Sun Sep 20 18:54:37 2020
[continued from previous message]
do pingreply with tsource , tmessage
else
do processtcpip with tmessage
endif
else && No pending commands...
if gstoredflag
do flush
gstoredflag = .F.
gmoldheart = seconds() + gmolddelay
gpackets = gpackets + 1
else
if gmoldheart < seconds()
do flush
gmoldheart = seconds() + gmolddelay
endif
endif
endif
if gnextstats <= seconds()
do showstatus
gnextstats = seconds() + gstatdelay
endif
lastkey=inkey()
if lastkey # 0
activate window output
do case
case lastkey = asc("~")
? time()+" Quitting..."
mdone = .T.
case lastkey = asc("@")
? time()+" Copying to island2.dbf"
set order to
copy to m:\island2\island2
?? "Done"
case lastkey = asc("#")
? time()+" Suspending..."
suspend
case lastkey = asc("!")
? time()+" ACCEPT="+iif(gaccept,"T","F")+" ACT="+ iif(gactaccept,"T","F") + " EOM="+iif(geom,"T","F")+" NEXT="+str(tnext,9,3)+ " TOO-LATE="+str(ttoolate,6,0)+" COUNT="+str(tcount,9,0)
s = "T"+space(60)
call int99 with s
if s = "t"
tbuffered = val( substr(s,26,5) )
? "MOLD INFO: SESSION="+substr(s,2,10)+" SEQ="+substr(s,12,10)+" SOCKET="+substr(s,22,4)+" BUFFERED="+str(tbuffered,5,0)
else
? "Could not get mold info!"
tbuffered = 0
endif
if gpackets > 0
? "MESSAGES:"+str(gmessages-tbuffered,12,0)+" PACKETS:"+str(gpackets,12,0)+" ("+str( (gmessages-tbuffered)/ gpackets , 5 , 3 )+")"
gmessages = tbuffered
gpackets =0
endif
case lastkey = asc("%")
? time()+" Shutdown attempt..."
do shutdown
case lastkey = asc("(")
? time()+" toggled gaccept"
gaccept = !gaccept
case lastkey = asc("?")
? "@-Copy to island2.DBF ~-Quit !-Status #-Suspend %-ShutDown $-Print incoming"
case lastkey = asc("$")
if gprinting
? time()+" Printing off"
gprinting = .F.
else
? time()+" Printing on"
gprinting = .T.
endif
endcase
activate window ticker
endif
enddo && Main Loop
activate window output
&& Final flush to mak sure everything is sent
do flush
&& Close file
s = "C"
call int99 with s
x = "H"+READPORT
call int99 with x
if x # "h"
do alert with "Could not close PingPort!"
endif
use && Unuse Island
&& Create fresh waypoint file
f = fcreate("ISLAND2.TXT")
if f<=0
? "Could not create ISLAND.TXT!"
suspend
endif
=fputs( f , "ISLAND2" ) && ROLE
=fputs( f , str( tseq , 9 , 0 ) ) && Order number
=fputs( f , str( tmatch , 9 , 0 ) ) && Match number
=fputs( f , str( tnextdead , 9 , 0 ) ) && Next dead order pointer =fclose(f)
quit
procedure title
activate window title SAME
clear
@ 0,0 SAY " Island2 ú Version "+VERSION+" (c)1996 Joshua Levine ú Press [?] for help"
activate window ticker SAME
return
proc werror
param wcode
do case
case wcode = "w"
return "Error on file write"
case wcode = "s"
return "Error on nework send"
case wcode = "c"
return "Invalid message length"
case wcode = "d"
return "all files full"
endcase
return "Unknown error"
**** write actualy writes a string the the file, steam, and screen
proc write
parameter wstring
wl = len( wstring )
ws="W"+chr(wl)+wstring
call int99 with ws
gmessages = gmessages + 1
if ws = 'b'
gstoredflag = .T.
else
if ws = "f"
gpackets = gpackets + 1
gstoredflag = .F.
else
activate window output
? time() +" !!!! ERROR ON WRITE!!!!!!"
? ws
do alert with "Erorr on write:"+werror(ws)
activate window ticker
suspend
endif
endif
return
*** Write a message
**** ACTIONS:
**** A - Accept the order was accepted into Island
**** B - Booked this order hit the book
**** E - Execute the order was executed for this many shares at this price
**** X - Cancel this many shares were canceled
**** C - Break this order was executed, now broken
**** G - Control stock is the control type
**** R - Report trade done away but will report/clear through Island
**** ON Cancel CONTRA = Reason for cancel
***** MINDICATE = on accept always "D" (legacy)
***** on execute "A"= added liquidity, "R"=Removed liquidity
***** on report "Y" trade report, "N" don't report, "S" step-out
****** mmatch = on accept or book is MINIMUM shares, in execution is match number
****** not defined on cancels, but 0 for now
proc mwrite
parameter maction,mseq,mshares,mprice,mcontra,mindicate,mmatch,mlocate
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + "," +maction+","+str(mseq,9,0)+","+PORT+","+USER+","+TOKEN+","+BUY_SELL+","+str(mshares,9,0)+","+str(mmatch,9,0)+","+STOCK+","+str(mprice,11,4)+"," +str(mlocate,8,0)+ ", 0,"+SHORT+","+MMID+","+PA+","+mcontra+","+
mindicate+","+DISPLAY+","+right(mwhen,3)+","+CLEARING+",D"
do write with w
return
****** Swrite writes a status message that doesnot concern an order, Like G-Good morning
proc swrite
param maction , mcode
mwhen = str( tnow , 9 , 3)
xcode = left( padr( mcode , 3) , 3 )
w = left( mwhen , 5 ) +","+maction+","+" 0"+", , , , , 0, 0,*"+xcode+" , 0.0000,00000000, 0, , , , , , ,"+right( mwhen , 3 )+", , "
do write with w
return
****** Enter order adds the audit, tries for a match, and if it don't work, books it.
****** Enter order assumes ostock and obuy_sell are the right length.
****** Also assumes that buy_sell has aready been checked to be B or S.
****** Also assumes that the token is no already used
proc enter2order
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,otif,oshort,ommid,opa,odisplay,omin,oclearing,oflags
if odisplay = "P"
obasefirm = ouser
else
obasefirm = "####"
endif
&& Get the working record
if tnextdead > 0
tlocate = tnextdead
goto tnextdead
tnextdead = SEQ
else
insert into ISLAND (LEAVES) values (0) && Keep it out of the indexes for now
tlocate = recno()
endif
tseq = tseq + 1
awhen = str( tnow , 9 , 3)
oleaves = oshares
ofilled = 0
aflag = .f. && have we written the "A" message yet?
if obuy_sell = "B" && Buy order...
set order to SSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
*** There were at least enough to fill the minimum quantity
mmax = oshares
else
*** Not enough to fill the min, so fill none
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
*** Max out with the number of shares specified
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice >= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0)+ ", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0)+", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
else && sell order..
set order to BSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
mmax = oshares
else
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice <= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +","+str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0) +", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0) +", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
endif
if oleaves > 0 && any non-executed shares left?
if otif = 0 && Fill or kill, so cancel leaves
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ "," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
endif
w = left( awhen , 5 ) +",X," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ ", 0," +oshort +"," +ommid +"," +
opa+",#IOC, ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
oleaves = 0
else
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+",B," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
else
w = left( awhen , 5 ) +",B," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0) +"," +
oshort +"," +ommid +"," +opa+", , ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
endif
do write with w
endif && otif == 0
endif && oleaves > 0
if oleaves > 0 && Still open?
goto tlocate
replace ;
PORT with oport,;
USER with ouser,;
TOKEN with otoken,;
BUY_SELL with obuy_sell,;
LEAVES with oleaves,;
STOCK with ostock,;
PRICE with oprice,;
SHORT with oshort,;
MMID with ommid,;
PA with opa,;
DISPLAY with odisplay,;
CLEARING with oclearing,;
FILLED with ofilled,;
SEQ with tseq
else && leaves = 0 (add current order to deadlist)
goto tlocate
replace SEQ with tnextdead
tnextdead = recno()
endif && oleaves > 0
return
****** Enter Report adds a type R line to the file
****** Enter order assumes ostock and obuy_sell are the right length.
proc enter2report
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,oshort,ommid,opa,oreport,oclearing,ocontra
tseq = tseq + 1
tmatch = tmatch + 1
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",R,"+str(tseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(tmatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oSHORT+","+oMMID+","+oPA+","+ocontra+","+oreport+",R,"+
right(mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter Reject adds a type J line to the file
proc enter2reject
parameter oport,ouser,otoken,otype,oreason
tseq = tseq + 1
*** Leaves MUST be 0 or it might be included in the match!
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",J," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken+"," +otype+", 0, 0, , 0.0000,00000000, 0, , , , ," +oreason +",N,"+right(mwhen,3)+", ,D"
do write with w
return
****** Enter break adds a type C line to the file
proc enterbreak
parameter oseq, oport , ouser, otoken, obuy_sell, oshares, omatch, ostock, oprice, ommid, oreason, omisc, oclearing , oshort
if oseq > tseq .or. oseq < 1
? time()+" Bad SEQ in Break! OSEQ="+str(oseq,9,0)+" RECS="+str( tseq, 9,0)
return
endif
if oshares <= 0
? time()+" Jerk boy BREAK zero shares SEQ="+str(oseq,9,0)
return
endif
if oprice <= 0
? time()+" Jerk boy BREAK zero price SEQ="+str(oseq,9,0)
return
endif
if ! omisc $ "AR"
? time()+" Invalid A/R BREAK MISC="+omisc+" SEQ="+str(oseq,9,0)
return
endif
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",C,"+str(oseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(omatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oshort+","+oMMID+", ,"+oreason +","+omisc+", ,"+right(
mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter maint adds a type M line to the file
*** SHORTTYPE
***** N - No short sale checks
***** B - Bidtick test
***** L - Lasttrade test
*** BLOCKSUB - Block subscriber only orders?
***** B - Block
***** N - No block
*** CENTER
***** Q - NASDAQ
***** L - LISTED
proc entermaint
parameter oport,ouser,otoken,ostock,oshorttype,oblocksub,ocenter,omisc
if ! oshorttype $ "NBL"
? time()+" Bad SHORTTYPE="+oshorttype+" STOCK="+ostock
return
endif
if !oblocksub $ "BN"
? time()+" Bad BLOCKSUB="+oblocksub+" STOCK="+ostock
return
endif
if !ocenter $ "QL"
? time()+" Bad CENTER="+ocenter+" STOCK="+ostock
return
endif
if len( omisc ) # 4
? time()+" Bad omisc len!"+omisc
return
endif
for eml = 1 to 4
emb = substr( omisc , eml , 1 )
if !isalpha( emb ) .and. emb # " "
? time()+" Bad omisc letter!"+omisc
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",S, 0, 0," +ostock +", 0.0000,00000000, 0,"+oshorttype+", , ,"+omisc+","+ocenter+","+oblocksub+"," +right(awhen,3) +", , "
do write with w
return
*** STATE - Trading state
***** T - Trading
***** H - Halted
proc enterstate
parameter oport,ouser,otoken,ostock,ostate
if !ostate $ "TH"
? time()+" Bad STATE="+ostate+" STOCK="+ostock
return
endif
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",T, 0, 0," +ostock +", 0.0000,00000000, 0, , , , ,"+ostate+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter account configures an OUCH account
proc enteraccount
parameter oaccount,opassword,otest,otrusted, othresh, osscheck,oiflag, odefault
if !otest$"TN"
? time()+" Bad TEST flag in enteraccount:"+otest
return
endif
if !otrusted$"TN"
? time()+" Bad TRUSTED flag in enteraccount:"+otrusted
return
endif
if !osscheck$"YN"
? time()+" Bad SSCHECK flag in enteraccount:"+osscheck
return
endif
if !oiflag$"IN"
? time()+" Bad IFLAG flag in enteraccount:"+oiflag
return
endif
if len( opassword ) # 10
? time()+" Bad opassword len!"+opassword
return
endif
for eml = 1 to 10
emb = substr( opassword , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " " .and. emb # "!" .and. emb # "#"
? time()+" Bad opassword letter!"+opassword+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
if len( odefault ) # 4
? time()+" Bad odefault len!"+odefault
return
endif
for eml = 1 to 4
emb = substr( odefault , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad odefault letter!"+odefault +":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", ,"+opassword+",A,"+str(othresh,9,0)+", 0, , 0.0000,00000000, 0,"+osscheck+","+odefault +", ,"+otest+ " "+ otrusted +" ,"+oiflag+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter firm configures an OUCH account for clearing
proc enterfirm
parameter oaccount,ommid,oclearing
if !oclearing$"AIQRN"
? time()+" Bad clearing in enterfirm:"+oclearing
return
endif
if len( ommid ) # 4
? time()+" Bad ommid len!"+ommid
return
endif
for eml = 1 to 4
emb = substr( ommid , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad ommid letter!"+ommid+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", , ,F, 0, 0, , 0.0000,00000000, 0, ,"+ ommid +", , , , ," +right(awhen,3) +","+oclearing+", "
do write with w
return
proc new2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
if LEAVES <= oshares
ttoolate = ttoolate + 1
return
endif
xshares = LEAVES - oshares
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return
****** Cancel Order takes a locator and a SEQ number
****** passed shares in new intedned order size
****** returns number of shares canceled and leaves record pointer on order canceled.
proc i2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
msize = LEAVES + FILLED && Current size of order
if oshares >= msize
*** ? time()+" INTENEDED CANCEL BIGGER THAN ORDER SHARES="+str( oshares, 6 , 0 )+" REASON="+ocontra
return 0
endif
xshares = msize - oshares && HOwmany do we have to cancel to get from current size to new size?
if xshares > LEAVES && Don't cancel more than are open
xshares = LEAVES
endif
if xshares = 0
ttoolate = ttoolate + 1
return 0
endif
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return xshares
proc initstatus
activate window status
@ 0,1 SAY "Orders:"
@ 0,27 SAY "Executions:"
@ 0,52 SAY "Cancels:"
activate window ticker
return
proc showstatus
activate window status
@ 0,11 SAY tseq PICTURE "##,###,###"
@ 0,38 SAY tmatch PICTURE "##,###,###"
@ 0,60 SAY txcount PICTURE "##,###,###"
activate window ticker
return
proc processtcpip
[continued in next message]
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
-
From
The Deprogram@21:1/5 to
All on Sun Sep 20 19:00:57 2020
[continued from previous message]
do pingreply with tsource , tmessage
else
do processtcpip with tmessage
endif
else && No pending commands...
if gstoredflag
do flush
gstoredflag = .F.
gmoldheart = seconds() + gmolddelay
gpackets = gpackets + 1
else
if gmoldheart < seconds()
do flush
gmoldheart = seconds() + gmolddelay
endif
endif
endif
if gnextstats <= seconds()
do showstatus
gnextstats = seconds() + gstatdelay
endif
lastkey=inkey()
if lastkey # 0
activate window output
do case
case lastkey = asc("~")
? time()+" Quitting..."
mdone = .T.
case lastkey = asc("@")
? time()+" Copying to island2.dbf"
set order to
copy to m:\island2\island2
?? "Done"
case lastkey = asc("#")
? time()+" Suspending..."
suspend
case lastkey = asc("!")
? time()+" ACCEPT="+iif(gaccept,"T","F")+" ACT="+ iif(gactaccept,"T","F") + " EOM="+iif(geom,"T","F")+" NEXT="+str(tnext,9,3)+ " TOO-LATE="+str(ttoolate,6,0)+" COUNT="+str(tcount,9,0)
s = "T"+space(60)
call int99 with s
if s = "t"
tbuffered = val( substr(s,26,5) )
? "MOLD INFO: SESSION="+substr(s,2,10)+" SEQ="+substr(s,12,10)+" SOCKET="+substr(s,22,4)+" BUFFERED="+str(tbuffered,5,0)
else
? "Could not get mold info!"
tbuffered = 0
endif
if gpackets > 0
? "MESSAGES:"+str(gmessages-tbuffered,12,0)+" PACKETS:"+str(gpackets,12,0)+" ("+str( (gmessages-tbuffered)/ gpackets , 5 , 3 )+")"
gmessages = tbuffered
gpackets =0
endif
case lastkey = asc("%")
? time()+" Shutdown attempt..."
do shutdown
case lastkey = asc("(")
? time()+" toggled gaccept"
gaccept = !gaccept
case lastkey = asc("?")
? "@-Copy to island2.DBF ~-Quit !-Status #-Suspend %-ShutDown $-Print incoming"
case lastkey = asc("$")
if gprinting
? time()+" Printing off"
gprinting = .F.
else
? time()+" Printing on"
gprinting = .T.
endif
endcase
activate window ticker
endif
enddo && Main Loop
activate window output
&& Final flush to mak sure everything is sent
do flush
&& Close file
s = "C"
call int99 with s
x = "H"+READPORT
call int99 with x
if x # "h"
do alert with "Could not close PingPort!"
endif
use && Unuse Island
&& Create fresh waypoint file
f = fcreate("ISLAND2.TXT")
if f<=0
? "Could not create ISLAND.TXT!"
suspend
endif
=fputs( f , "ISLAND2" ) && ROLE
=fputs( f , str( tseq , 9 , 0 ) ) && Order number
=fputs( f , str( tmatch , 9 , 0 ) ) && Match number
=fputs( f , str( tnextdead , 9 , 0 ) ) && Next dead order pointer =fclose(f)
quit
procedure title
activate window title SAME
clear
@ 0,0 SAY " Island2 ú Version "+VERSION+" (c)1996 Joshua Levine ú Press [?] for help"
activate window ticker SAME
return
proc werror
param wcode
do case
case wcode = "w"
return "Error on file write"
case wcode = "s"
return "Error on nework send"
case wcode = "c"
return "Invalid message length"
case wcode = "d"
return "all files full"
endcase
return "Unknown error"
**** write actualy writes a string the the file, steam, and screen
proc write
parameter wstring
wl = len( wstring )
ws="W"+chr(wl)+wstring
call int99 with ws
gmessages = gmessages + 1
if ws = 'b'
gstoredflag = .T.
else
if ws = "f"
gpackets = gpackets + 1
gstoredflag = .F.
else
activate window output
? time() +" !!!! ERROR ON WRITE!!!!!!"
? ws
do alert with "Erorr on write:"+werror(ws)
activate window ticker
suspend
endif
endif
return
*** Write a message
**** ACTIONS:
**** A - Accept the order was accepted into Island
**** B - Booked this order hit the book
**** E - Execute the order was executed for this many shares at this price
**** X - Cancel this many shares were canceled
**** C - Break this order was executed, now broken
**** G - Control stock is the control type
**** R - Report trade done away but will report/clear through Island
**** ON Cancel CONTRA = Reason for cancel
***** MINDICATE = on accept always "D" (legacy)
***** on execute "A"= added liquidity, "R"=Removed liquidity
***** on report "Y" trade report, "N" don't report, "S" step-out
****** mmatch = on accept or book is MINIMUM shares, in execution is match number
****** not defined on cancels, but 0 for now
proc mwrite
parameter maction,mseq,mshares,mprice,mcontra,mindicate,mmatch,mlocate
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + "," +maction+","+str(mseq,9,0)+","+PORT+","+USER+","+TOKEN+","+BUY_SELL+","+str(mshares,9,0)+","+str(mmatch,9,0)+","+STOCK+","+str(mprice,11,4)+"," +str(mlocate,8,0)+ ", 0,"+SHORT+","+MMID+","+PA+","+mcontra+","+
mindicate+","+DISPLAY+","+right(mwhen,3)+","+CLEARING+",D"
do write with w
return
****** Swrite writes a status message that doesnot concern an order, Like G-Good morning
proc swrite
param maction , mcode
mwhen = str( tnow , 9 , 3)
xcode = left( padr( mcode , 3) , 3 )
w = left( mwhen , 5 ) +","+maction+","+" 0"+", , , , , 0, 0,*"+xcode+" , 0.0000,00000000, 0, , , , , , ,"+right( mwhen , 3 )+", , "
do write with w
return
****** Enter order adds the audit, tries for a match, and if it don't work, books it.
****** Enter order assumes ostock and obuy_sell are the right length.
****** Also assumes that buy_sell has aready been checked to be B or S.
****** Also assumes that the token is no already used
proc enter2order
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,otif,oshort,ommid,opa,odisplay,omin,oclearing,oflags
if odisplay = "P"
obasefirm = ouser
else
obasefirm = "####"
endif
&& Get the working record
if tnextdead > 0
tlocate = tnextdead
goto tnextdead
tnextdead = SEQ
else
insert into ISLAND (LEAVES) values (0) && Keep it out of the indexes for now
tlocate = recno()
endif
tseq = tseq + 1
awhen = str( tnow , 9 , 3)
oleaves = oshares
ofilled = 0
aflag = .f. && have we written the "A" message yet?
if obuy_sell = "B" && Buy order...
set order to SSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
*** There were at least enough to fill the minimum quantity
mmax = oshares
else
*** Not enough to fill the min, so fill none
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
*** Max out with the number of shares specified
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice >= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0)+ ", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0)+", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
else && sell order..
set order to BSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
mmax = oshares
else
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice <= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +","+str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0) +", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0) +", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
endif
if oleaves > 0 && any non-executed shares left?
if otif = 0 && Fill or kill, so cancel leaves
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ "," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
endif
w = left( awhen , 5 ) +",X," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ ", 0," +oshort +"," +ommid +"," +
opa+",#IOC, ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
oleaves = 0
else
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+",B," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
else
w = left( awhen , 5 ) +",B," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0) +"," +
oshort +"," +ommid +"," +opa+", , ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
endif
do write with w
endif && otif == 0
endif && oleaves > 0
if oleaves > 0 && Still open?
goto tlocate
replace ;
PORT with oport,;
USER with ouser,;
TOKEN with otoken,;
BUY_SELL with obuy_sell,;
LEAVES with oleaves,;
STOCK with ostock,;
PRICE with oprice,;
SHORT with oshort,;
MMID with ommid,;
PA with opa,;
DISPLAY with odisplay,;
CLEARING with oclearing,;
FILLED with ofilled,;
SEQ with tseq
else && leaves = 0 (add current order to deadlist)
goto tlocate
replace SEQ with tnextdead
tnextdead = recno()
endif && oleaves > 0
return
****** Enter Report adds a type R line to the file
****** Enter order assumes ostock and obuy_sell are the right length.
proc enter2report
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,oshort,ommid,opa,oreport,oclearing,ocontra
tseq = tseq + 1
tmatch = tmatch + 1
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",R,"+str(tseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(tmatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oSHORT+","+oMMID+","+oPA+","+ocontra+","+oreport+",R,"+
right(mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter Reject adds a type J line to the file
proc enter2reject
parameter oport,ouser,otoken,otype,oreason
tseq = tseq + 1
*** Leaves MUST be 0 or it might be included in the match!
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",J," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken+"," +otype+", 0, 0, , 0.0000,00000000, 0, , , , ," +oreason +",N,"+right(mwhen,3)+", ,D"
do write with w
return
****** Enter break adds a type C line to the file
proc enterbreak
parameter oseq, oport , ouser, otoken, obuy_sell, oshares, omatch, ostock, oprice, ommid, oreason, omisc, oclearing , oshort
if oseq > tseq .or. oseq < 1
? time()+" Bad SEQ in Break! OSEQ="+str(oseq,9,0)+" RECS="+str( tseq, 9,0)
return
endif
if oshares <= 0
? time()+" Jerk boy BREAK zero shares SEQ="+str(oseq,9,0)
return
endif
if oprice <= 0
? time()+" Jerk boy BREAK zero price SEQ="+str(oseq,9,0)
return
endif
if ! omisc $ "AR"
? time()+" Invalid A/R BREAK MISC="+omisc+" SEQ="+str(oseq,9,0)
return
endif
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",C,"+str(oseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(omatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oshort+","+oMMID+", ,"+oreason +","+omisc+", ,"+right(
mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter maint adds a type M line to the file
*** SHORTTYPE
***** N - No short sale checks
***** B - Bidtick test
***** L - Lasttrade test
*** BLOCKSUB - Block subscriber only orders?
***** B - Block
***** N - No block
*** CENTER
***** Q - NASDAQ
***** L - LISTED
proc entermaint
parameter oport,ouser,otoken,ostock,oshorttype,oblocksub,ocenter,omisc
if ! oshorttype $ "NBL"
? time()+" Bad SHORTTYPE="+oshorttype+" STOCK="+ostock
return
endif
if !oblocksub $ "BN"
? time()+" Bad BLOCKSUB="+oblocksub+" STOCK="+ostock
return
endif
if !ocenter $ "QL"
? time()+" Bad CENTER="+ocenter+" STOCK="+ostock
return
endif
if len( omisc ) # 4
? time()+" Bad omisc len!"+omisc
return
endif
for eml = 1 to 4
emb = substr( omisc , eml , 1 )
if !isalpha( emb ) .and. emb # " "
? time()+" Bad omisc letter!"+omisc
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",S, 0, 0," +ostock +", 0.0000,00000000, 0,"+oshorttype+", , ,"+omisc+","+ocenter+","+oblocksub+"," +right(awhen,3) +", , "
do write with w
return
*** STATE - Trading state
***** T - Trading
***** H - Halted
proc enterstate
parameter oport,ouser,otoken,ostock,ostate
if !ostate $ "TH"
? time()+" Bad STATE="+ostate+" STOCK="+ostock
return
endif
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",T, 0, 0," +ostock +", 0.0000,00000000, 0, , , , ,"+ostate+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter account configures an OUCH account
proc enteraccount
parameter oaccount,opassword,otest,otrusted, othresh, osscheck,oiflag, odefault
if !otest$"TN"
? time()+" Bad TEST flag in enteraccount:"+otest
return
endif
if !otrusted$"TN"
? time()+" Bad TRUSTED flag in enteraccount:"+otrusted
return
endif
if !osscheck$"YN"
? time()+" Bad SSCHECK flag in enteraccount:"+osscheck
return
endif
if !oiflag$"IN"
? time()+" Bad IFLAG flag in enteraccount:"+oiflag
return
endif
if len( opassword ) # 10
? time()+" Bad opassword len!"+opassword
return
endif
for eml = 1 to 10
emb = substr( opassword , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " " .and. emb # "!" .and. emb # "#"
? time()+" Bad opassword letter!"+opassword+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
if len( odefault ) # 4
? time()+" Bad odefault len!"+odefault
return
endif
for eml = 1 to 4
emb = substr( odefault , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad odefault letter!"+odefault +":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", ,"+opassword+",A,"+str(othresh,9,0)+", 0, , 0.0000,00000000, 0,"+osscheck+","+odefault +", ,"+otest+ " "+ otrusted +" ,"+oiflag+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter firm configures an OUCH account for clearing
proc enterfirm
parameter oaccount,ommid,oclearing
if !oclearing$"AIQRN"
? time()+" Bad clearing in enterfirm:"+oclearing
return
endif
if len( ommid ) # 4
? time()+" Bad ommid len!"+ommid
return
endif
for eml = 1 to 4
emb = substr( ommid , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad ommid letter!"+ommid+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", , ,F, 0, 0, , 0.0000,00000000, 0, ,"+ ommid +", , , , ," +right(awhen,3) +","+oclearing+", "
do write with w
return
proc new2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
if LEAVES <= oshares
ttoolate = ttoolate + 1
return
endif
xshares = LEAVES - oshares
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return
****** Cancel Order takes a locator and a SEQ number
****** passed shares in new intedned order size
****** returns number of shares canceled and leaves record pointer on order canceled.
proc i2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
msize = LEAVES + FILLED && Current size of order
if oshares >= msize
*** ? time()+" INTENEDED CANCEL BIGGER THAN ORDER SHARES="+str( oshares, 6 , 0 )+" REASON="+ocontra
return 0
endif
xshares = msize - oshares && HOwmany do we have to cancel to get from current size to new size?
if xshares > LEAVES && Don't cancel more than are open
xshares = LEAVES
endif
if xshares = 0
ttoolate = ttoolate + 1
return 0
endif
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return xshares
proc initstatus
activate window status
@ 0,1 SAY "Orders:"
@ 0,27 SAY "Executions:"
@ 0,52 SAY "Cancels:"
activate window ticker
return
proc showstatus
activate window status
@ 0,11 SAY tseq PICTURE "##,###,###"
@ 0,38 SAY tmatch PICTURE "##,###,###"
@ 0,60 SAY txcount PICTURE "##,###,###"
activate window ticker
return
proc processtcpip
[continued in next message]
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
-
From
The Deprogram@21:1/5 to
All on Sun Sep 20 19:01:28 2020
[continued from previous message]
do pingreply with tsource , tmessage
else
do processtcpip with tmessage
endif
else && No pending commands...
if gstoredflag
do flush
gstoredflag = .F.
gmoldheart = seconds() + gmolddelay
gpackets = gpackets + 1
else
if gmoldheart < seconds()
do flush
gmoldheart = seconds() + gmolddelay
endif
endif
endif
if gnextstats <= seconds()
do showstatus
gnextstats = seconds() + gstatdelay
endif
lastkey=inkey()
if lastkey # 0
activate window output
do case
case lastkey = asc("~")
? time()+" Quitting..."
mdone = .T.
case lastkey = asc("@")
? time()+" Copying to island2.dbf"
set order to
copy to m:\island2\island2
?? "Done"
case lastkey = asc("#")
? time()+" Suspending..."
suspend
case lastkey = asc("!")
? time()+" ACCEPT="+iif(gaccept,"T","F")+" ACT="+ iif(gactaccept,"T","F") + " EOM="+iif(geom,"T","F")+" NEXT="+str(tnext,9,3)+ " TOO-LATE="+str(ttoolate,6,0)+" COUNT="+str(tcount,9,0)
s = "T"+space(60)
call int99 with s
if s = "t"
tbuffered = val( substr(s,26,5) )
? "MOLD INFO: SESSION="+substr(s,2,10)+" SEQ="+substr(s,12,10)+" SOCKET="+substr(s,22,4)+" BUFFERED="+str(tbuffered,5,0)
else
? "Could not get mold info!"
tbuffered = 0
endif
if gpackets > 0
? "MESSAGES:"+str(gmessages-tbuffered,12,0)+" PACKETS:"+str(gpackets,12,0)+" ("+str( (gmessages-tbuffered)/ gpackets , 5 , 3 )+")"
gmessages = tbuffered
gpackets =0
endif
case lastkey = asc("%")
? time()+" Shutdown attempt..."
do shutdown
case lastkey = asc("(")
? time()+" toggled gaccept"
gaccept = !gaccept
case lastkey = asc("?")
? "@-Copy to island2.DBF ~-Quit !-Status #-Suspend %-ShutDown $-Print incoming"
case lastkey = asc("$")
if gprinting
? time()+" Printing off"
gprinting = .F.
else
? time()+" Printing on"
gprinting = .T.
endif
endcase
activate window ticker
endif
enddo && Main Loop
activate window output
&& Final flush to mak sure everything is sent
do flush
&& Close file
s = "C"
call int99 with s
x = "H"+READPORT
call int99 with x
if x # "h"
do alert with "Could not close PingPort!"
endif
use && Unuse Island
&& Create fresh waypoint file
f = fcreate("ISLAND2.TXT")
if f<=0
? "Could not create ISLAND.TXT!"
suspend
endif
=fputs( f , "ISLAND2" ) && ROLE
=fputs( f , str( tseq , 9 , 0 ) ) && Order number
=fputs( f , str( tmatch , 9 , 0 ) ) && Match number
=fputs( f , str( tnextdead , 9 , 0 ) ) && Next dead order pointer =fclose(f)
quit
procedure title
activate window title SAME
clear
@ 0,0 SAY " Island2 ú Version "+VERSION+" (c)1996 Joshua Levine ú Press [?] for help"
activate window ticker SAME
return
proc werror
param wcode
do case
case wcode = "w"
return "Error on file write"
case wcode = "s"
return "Error on nework send"
case wcode = "c"
return "Invalid message length"
case wcode = "d"
return "all files full"
endcase
return "Unknown error"
**** write actualy writes a string the the file, steam, and screen
proc write
parameter wstring
wl = len( wstring )
ws="W"+chr(wl)+wstring
call int99 with ws
gmessages = gmessages + 1
if ws = 'b'
gstoredflag = .T.
else
if ws = "f"
gpackets = gpackets + 1
gstoredflag = .F.
else
activate window output
? time() +" !!!! ERROR ON WRITE!!!!!!"
? ws
do alert with "Erorr on write:"+werror(ws)
activate window ticker
suspend
endif
endif
return
*** Write a message
**** ACTIONS:
**** A - Accept the order was accepted into Island
**** B - Booked this order hit the book
**** E - Execute the order was executed for this many shares at this price
**** X - Cancel this many shares were canceled
**** C - Break this order was executed, now broken
**** G - Control stock is the control type
**** R - Report trade done away but will report/clear through Island
**** ON Cancel CONTRA = Reason for cancel
***** MINDICATE = on accept always "D" (legacy)
***** on execute "A"= added liquidity, "R"=Removed liquidity
***** on report "Y" trade report, "N" don't report, "S" step-out
****** mmatch = on accept or book is MINIMUM shares, in execution is match number
****** not defined on cancels, but 0 for now
proc mwrite
parameter maction,mseq,mshares,mprice,mcontra,mindicate,mmatch,mlocate
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + "," +maction+","+str(mseq,9,0)+","+PORT+","+USER+","+TOKEN+","+BUY_SELL+","+str(mshares,9,0)+","+str(mmatch,9,0)+","+STOCK+","+str(mprice,11,4)+"," +str(mlocate,8,0)+ ", 0,"+SHORT+","+MMID+","+PA+","+mcontra+","+
mindicate+","+DISPLAY+","+right(mwhen,3)+","+CLEARING+",D"
do write with w
return
****** Swrite writes a status message that doesnot concern an order, Like G-Good morning
proc swrite
param maction , mcode
mwhen = str( tnow , 9 , 3)
xcode = left( padr( mcode , 3) , 3 )
w = left( mwhen , 5 ) +","+maction+","+" 0"+", , , , , 0, 0,*"+xcode+" , 0.0000,00000000, 0, , , , , , ,"+right( mwhen , 3 )+", , "
do write with w
return
****** Enter order adds the audit, tries for a match, and if it don't work, books it.
****** Enter order assumes ostock and obuy_sell are the right length.
****** Also assumes that buy_sell has aready been checked to be B or S.
****** Also assumes that the token is no already used
proc enter2order
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,otif,oshort,ommid,opa,odisplay,omin,oclearing,oflags
if odisplay = "P"
obasefirm = ouser
else
obasefirm = "####"
endif
&& Get the working record
if tnextdead > 0
tlocate = tnextdead
goto tnextdead
tnextdead = SEQ
else
insert into ISLAND (LEAVES) values (0) && Keep it out of the indexes for now
tlocate = recno()
endif
tseq = tseq + 1
awhen = str( tnow , 9 , 3)
oleaves = oshares
ofilled = 0
aflag = .f. && have we written the "A" message yet?
if obuy_sell = "B" && Buy order...
set order to SSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
*** There were at least enough to fill the minimum quantity
mmax = oshares
else
*** Not enough to fill the min, so fill none
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "S" .and. oprice >= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
*** Max out with the number of shares specified
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice >= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0)+ ", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0)+", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
else && sell order..
set order to BSEEK
do case
case omin > 1 && Minimum quantity specified?
*** if the min is bigger than the size, set it to the size
if omin > oshares
mmin = oshares
else
mmin = omin
endif
*** First prescan to see if we have enough size to fill it
if seek( ostock )
scan while mmin > 0 .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE
mmin = mmin - LEAVES
endscan
endif
if mmin <= 0
mmax = oshares
else
mmax = 0
endif
case odisplay = "R" .or. odisplay = "P" && Is this a round-lot only order?
mmax = 0
*** Prescan to find the number of a shares available
if seek( ostock )
scan while mmax <= oshares .and. ostock = STOCK .and. BUY_SELL = "B" .and. oprice <= PRICE .and. obasefirm # MMID
mmax = mmax + LEAVES
endscan
endif
if mmax >= oshares
mmax = oshares
endif
*** Round down to nearest round lot wihtout using floating point
mmax = val( substr( str( mmax , 6, 0 ) , 1 ,4 ) + "00" )
otherwise
mmax = oshares
endcase
do while mmax > 0 .and. seek( ostock ) .and. oprice <= PRICE
if !aflag
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +","+str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
aflag = .T.
endif
tecount = tecount + 1
eshares = min( LEAVES , mmax )
oleaves = oleaves - eshares
mmax = mmax - eshares
ofilled = ofilled + eshares
tmatch = tmatch + 1
w = left( awhen , 5 ) +",E," +str( SEQ ,9,0) +"," +PORT +"," +USER +"," +TOKEN +"," +BUY_SELL +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str( recno() ,8,0) +", 0," +SHORT +"," +MMID
+"," +PA+"," +ommid+",A," +DISPLAY +"," +right(awhen,3) +"," +CLEARING+",D"
do write with w
w = left( awhen , 5 ) +",E," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(eshares,6,0) +"," +str(tmatch,9,0) +"," +ostock +"," +str(PRICE,11,4) +"," +str(tlocate,8,0) +", 0," +oshort +"," +
ommid +"," +opa+","+MMID+",R," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
dleaves = LEAVES - eshares
if dleaves <= 0 && Dead record?
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves , FILLED with FILLED + eshares
endif
enddo
endif
if oleaves > 0 && any non-executed shares left?
if otif = 0 && Fill or kill, so cancel leaves
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ "," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+", ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
endif
w = left( awhen , 5 ) +",X," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0)+ ", 0," +oshort +"," +ommid +"," +
opa+",#IOC, ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
do write with w
oleaves = 0
else
if !aflag && did we not make an A message yet?
w = left( awhen , 5 ) +",A," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oshares,6,0) +", " +str(omin,6,0) +"," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0)
+"," +oshort +"," +ommid +"," +opa+","+oflags+",B," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
else
w = left( awhen , 5 ) +",B," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken +"," +obuy_sell +", " +str(oleaves,6,0) +", 0," +ostock +"," +str(oprice,11,4) +"," +str(tlocate,8,0) +"," +str(otif,5,0) +"," +
oshort +"," +ommid +"," +opa+", , ," +odisplay +"," +right(awhen,3) +"," +oclearing+",D"
endif
do write with w
endif && otif == 0
endif && oleaves > 0
if oleaves > 0 && Still open?
goto tlocate
replace ;
PORT with oport,;
USER with ouser,;
TOKEN with otoken,;
BUY_SELL with obuy_sell,;
LEAVES with oleaves,;
STOCK with ostock,;
PRICE with oprice,;
SHORT with oshort,;
MMID with ommid,;
PA with opa,;
DISPLAY with odisplay,;
CLEARING with oclearing,;
FILLED with ofilled,;
SEQ with tseq
else && leaves = 0 (add current order to deadlist)
goto tlocate
replace SEQ with tnextdead
tnextdead = recno()
endif && oleaves > 0
return
****** Enter Report adds a type R line to the file
****** Enter order assumes ostock and obuy_sell are the right length.
proc enter2report
parameter oport,ouser,otoken,obuy_sell,oshares,ostock,oprice,oshort,ommid,opa,oreport,oclearing,ocontra
tseq = tseq + 1
tmatch = tmatch + 1
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",R,"+str(tseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(tmatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oSHORT+","+oMMID+","+oPA+","+ocontra+","+oreport+",R,"+
right(mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter Reject adds a type J line to the file
proc enter2reject
parameter oport,ouser,otoken,otype,oreason
tseq = tseq + 1
*** Leaves MUST be 0 or it might be included in the match!
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",J," +str(tseq,9,0) +"," +oport+"," +ouser +"," +otoken+"," +otype+", 0, 0, , 0.0000,00000000, 0, , , , ," +oreason +",N,"+right(mwhen,3)+", ,D"
do write with w
return
****** Enter break adds a type C line to the file
proc enterbreak
parameter oseq, oport , ouser, otoken, obuy_sell, oshares, omatch, ostock, oprice, ommid, oreason, omisc, oclearing , oshort
if oseq > tseq .or. oseq < 1
? time()+" Bad SEQ in Break! OSEQ="+str(oseq,9,0)+" RECS="+str( tseq, 9,0)
return
endif
if oshares <= 0
? time()+" Jerk boy BREAK zero shares SEQ="+str(oseq,9,0)
return
endif
if oprice <= 0
? time()+" Jerk boy BREAK zero price SEQ="+str(oseq,9,0)
return
endif
if ! omisc $ "AR"
? time()+" Invalid A/R BREAK MISC="+omisc+" SEQ="+str(oseq,9,0)
return
endif
mwhen = str( tnow , 9 , 3)
w = left( mwhen , 5 ) + ",C,"+str(oseq,9,0) +"," +oPORT+"," +oUSER+"," +oTOKEN+"," +oBUY_SELL +", "+str(oshares,6,0)+","+str(omatch,9,0)+"," +oSTOCK+","+str(oprice,11,4)+",00000000, 0,"+oshort+","+oMMID+", ,"+oreason +","+omisc+", ,"+right(
mwhen,3)+","+oCLEARING+",D"
do write with w
return
****** Enter maint adds a type M line to the file
*** SHORTTYPE
***** N - No short sale checks
***** B - Bidtick test
***** L - Lasttrade test
*** BLOCKSUB - Block subscriber only orders?
***** B - Block
***** N - No block
*** CENTER
***** Q - NASDAQ
***** L - LISTED
proc entermaint
parameter oport,ouser,otoken,ostock,oshorttype,oblocksub,ocenter,omisc
if ! oshorttype $ "NBL"
? time()+" Bad SHORTTYPE="+oshorttype+" STOCK="+ostock
return
endif
if !oblocksub $ "BN"
? time()+" Bad BLOCKSUB="+oblocksub+" STOCK="+ostock
return
endif
if !ocenter $ "QL"
? time()+" Bad CENTER="+ocenter+" STOCK="+ostock
return
endif
if len( omisc ) # 4
? time()+" Bad omisc len!"+omisc
return
endif
for eml = 1 to 4
emb = substr( omisc , eml , 1 )
if !isalpha( emb ) .and. emb # " "
? time()+" Bad omisc letter!"+omisc
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",S, 0, 0," +ostock +", 0.0000,00000000, 0,"+oshorttype+", , ,"+omisc+","+ocenter+","+oblocksub+"," +right(awhen,3) +", , "
do write with w
return
*** STATE - Trading state
***** T - Trading
***** H - Halted
proc enterstate
parameter oport,ouser,otoken,ostock,ostate
if !ostate $ "TH"
? time()+" Bad STATE="+ostate+" STOCK="+ostock
return
endif
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oport+","+ouser+","+otoken+",T, 0, 0," +ostock +", 0.0000,00000000, 0, , , , ,"+ostate+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter account configures an OUCH account
proc enteraccount
parameter oaccount,opassword,otest,otrusted, othresh, osscheck,oiflag, odefault
if !otest$"TN"
? time()+" Bad TEST flag in enteraccount:"+otest
return
endif
if !otrusted$"TN"
? time()+" Bad TRUSTED flag in enteraccount:"+otrusted
return
endif
if !osscheck$"YN"
? time()+" Bad SSCHECK flag in enteraccount:"+osscheck
return
endif
if !oiflag$"IN"
? time()+" Bad IFLAG flag in enteraccount:"+oiflag
return
endif
if len( opassword ) # 10
? time()+" Bad opassword len!"+opassword
return
endif
for eml = 1 to 10
emb = substr( opassword , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " " .and. emb # "!" .and. emb # "#"
? time()+" Bad opassword letter!"+opassword+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
if len( odefault ) # 4
? time()+" Bad odefault len!"+odefault
return
endif
for eml = 1 to 4
emb = substr( odefault , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad odefault letter!"+odefault +":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", ,"+opassword+",A,"+str(othresh,9,0)+", 0, , 0.0000,00000000, 0,"+osscheck+","+odefault +", ,"+otest+ " "+ otrusted +" ,"+oiflag+", ," +right(awhen,3) +", , "
do write with w
return
*** Enter firm configures an OUCH account for clearing
proc enterfirm
parameter oaccount,ommid,oclearing
if !oclearing$"AIQRN"
? time()+" Bad clearing in enterfirm:"+oclearing
return
endif
if len( ommid ) # 4
? time()+" Bad ommid len!"+ommid
return
endif
for eml = 1 to 4
emb = substr( ommid , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb) .and. emb # " "
? time()+" Bad ommid letter!"+ommid+":"+str(eml)
return
endif
endfor
if len( oaccount ) # 6
? time()+" Bad oaccount len!"+oaccount
return
endif
for eml = 1 to 6
emb = substr( oaccount , eml , 1 )
if !isalpha( emb ) .and. !isdigit( emb ) .and. emb # " "
? time()+" Bad oaccount letter!"+oaccount+":"+str(eml)
return
endif
endfor
awhen = str( tnow , 9 , 3 )
w = left( awhen , 5 ) +",M, 0,"+oaccount+", , ,F, 0, 0, , 0.0000,00000000, 0, ,"+ ommid +", , , , ," +right(awhen,3) +","+oclearing+", "
do write with w
return
proc new2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
if LEAVES <= oshares
ttoolate = ttoolate + 1
return
endif
xshares = LEAVES - oshares
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return
****** Cancel Order takes a locator and a SEQ number
****** passed shares in new intedned order size
****** returns number of shares canceled and leaves record pointer on order canceled.
proc i2cancel
parameter olocate,oseq,oshares,ocontra && Contra indeicates reason for cancel
if olocate <= 0 .or. olocate > reccount()
? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
return 0
endif
goto olocate
if oseq # SEQ
*** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)
ttoolate = ttoolate + 1
return 0
endif
msize = LEAVES + FILLED && Current size of order
if oshares >= msize
*** ? time()+" INTENEDED CANCEL BIGGER THAN ORDER SHARES="+str( oshares, 6 , 0 )+" REASON="+ocontra
return 0
endif
xshares = msize - oshares && HOwmany do we have to cancel to get from current size to new size?
if xshares > LEAVES && Don't cancel more than are open
xshares = LEAVES
endif
if xshares = 0
ttoolate = ttoolate + 1
return 0
endif
do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 , recno()
txcount = txcount + 1
dleaves = LEAVES - xshares
if dleaves <=0
&& Must set LEAVES to zero to pull order from indexes
replace LEAVES with 0 , SEQ with tnextdead
tnextdead = recno()
else
replace LEAVES with dleaves
endif
return xshares
proc initstatus
activate window status
@ 0,1 SAY "Orders:"
@ 0,27 SAY "Executions:"
@ 0,52 SAY "Cancels:"
activate window ticker
return
proc showstatus
activate window status
@ 0,11 SAY tseq PICTURE "##,###,###"
@ 0,38 SAY tmatch PICTURE "##,###,###"
@ 0,60 SAY txcount PICTURE "##,###,###"
activate window ticker
return
proc processtcpip
[continued in next message]
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)