|
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885888688878888888988908891889288938894889588968897889888998900890189028903890489058906890789088909891089118912891389148915891689178918891989208921892289238924892589268927892889298930893189328933893489358936893789388939894089418942894389448945894689478948894989508951895289538954895589568957895889598960896189628963896489658966896789688969897089718972897389748975897689778978897989808981898289838984898589868987898889898990899189928993899489958996899789988999900090019002900390049005900690079008900990109011901290139014901590169017901890199020902190229023902490259026902790289029903090319032903390349035903690379038903990409041904290439044904590469047904890499050905190529053905490559056905790589059906090619062906390649065906690679068906990709071907290739074907590769077907890799080908190829083908490859086908790889089909090919092909390949095909690979098909991009101910291039104910591069107910891099110911191129113911491159116911791189119912091219122912391249125912691279128912991309131913291339134913591369137913891399140914191429143914491459146914791489149915091519152915391549155915691579158915991609161916291639164916591669167916891699170917191729173917491759176917791789179918091819182918391849185918691879188918991909191919291939194919591969197919891999200920192029203920492059206920792089209921092119212921392149215921692179218921992209221922292239224922592269227922892299230923192329233923492359236923792389239924092419242924392449245924692479248924992509251925292539254925592569257925892599260926192629263926492659266926792689269927092719272927392749275927692779278927992809281928292839284928592869287928892899290929192929293929492959296929792989299930093019302930393049305930693079308930993109311931293139314931593169317931893199320932193229323932493259326932793289329933093319332933393349335933693379338933993409341934293439344934593469347934893499350935193529353935493559356935793589359936093619362936393649365936693679368936993709371937293739374937593769377937893799380938193829383938493859386938793889389939093919392939393949395939693979398939994009401940294039404940594069407940894099410941194129413941494159416941794189419942094219422942394249425942694279428942994309431943294339434943594369437943894399440944194429443944494459446944794489449945094519452945394549455945694579458945994609461946294639464946594669467946894699470947194729473947494759476947794789479948094819482948394849485948694879488948994909491949294939494949594969497949894999500950195029503950495059506950795089509951095119512951395149515951695179518951995209521952295239524952595269527952895299530953195329533953495359536953795389539954095419542954395449545954695479548954995509551955295539554955595569557955895599560956195629563956495659566956795689569957095719572957395749575957695779578957995809581958295839584958595869587958895899590959195929593959495959596959795989599960096019602960396049605960696079608960996109611961296139614961596169617961896199620962196229623962496259626962796289629963096319632963396349635963696379638963996409641964296439644964596469647964896499650965196529653965496559656965796589659966096619662966396649665966696679668966996709671967296739674967596769677967896799680968196829683968496859686968796889689969096919692969396949695969696979698969997009701970297039704970597069707970897099710971197129713971497159716971797189719972097219722972397249725972697279728972997309731973297339734973597369737973897399740974197429743974497459746974797489749975097519752975397549755975697579758975997609761976297639764976597669767976897699770977197729773977497759776977797789779978097819782978397849785978697879788978997909791979297939794979597969797979897999800980198029803980498059806980798089809981098119812981398149815981698179818981998209821982298239824982598269827982898299830983198329833983498359836983798389839984098419842984398449845984698479848984998509851985298539854985598569857985898599860986198629863986498659866986798689869987098719872987398749875987698779878987998809881988298839884988598869887988898899890989198929893989498959896989798989899990099019902990399049905990699079908990999109911991299139914991599169917991899199920992199229923992499259926992799289929993099319932993399349935993699379938993999409941994299439944994599469947994899499950995199529953995499559956995799589959996099619962996399649965996699679968996999709971997299739974997599769977997899799980998199829983998499859986998799889989999099919992999399949995999699979998999910000100011000210003100041000510006100071000810009100101001110012100131001410015100161001710018100191002010021100221002310024100251002610027100281002910030100311003210033100341003510036100371003810039100401004110042100431004410045100461004710048100491005010051100521005310054100551005610057100581005910060100611006210063100641006510066100671006810069100701007110072100731007410075100761007710078100791008010081100821008310084100851008610087100881008910090100911009210093100941009510096100971009810099101001010110102101031010410105101061010710108101091011010111101121011310114101151011610117101181011910120101211012210123101241012510126101271012810129101301013110132101331013410135101361013710138101391014010141101421014310144101451014610147101481014910150101511015210153101541015510156101571015810159101601016110162101631016410165101661016710168101691017010171101721017310174101751017610177101781017910180101811018210183101841018510186101871018810189101901019110192101931019410195101961019710198101991020010201102021020310204102051020610207102081020910210102111021210213102141021510216102171021810219 |
- /***************************************************************
-
- bwb_cmd.c Miscellaneous Commands
- for Bywater BASIC Interpreter
-
- Copyright (c) 1993, Ted A. Campbell
- Bywater Software
-
- email: tcamp@delphi.com
-
- Copyright and Permissions Information:
-
- All U.S. and international rights are claimed by the author,
- Ted A. Campbell.
-
- This software is released under the terms of the GNU General
- Public License (GPL), which is distributed with this software
- in the file "COPYING". The GPL specifies the terms under
- which users may copy and use the software in this distribution.
-
- A separate license is available for commercial distribution,
- for information on which you should contact the author.
-
- ***************************************************************/
-
- /*---------------------------------------------------------------*/
- /* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
- /* 11/1995 (eidetics@cerf.net). */
- /* */
- /* Those additionally marked with "DD" were at the suggestion of */
- /* Dale DePriest (daled@cadence.com). */
- /* */
- /* Version 3.00 by Howard Wulf, AF5NE */
- /* */
- /* Version 3.10 by Howard Wulf, AF5NE */
- /* */
- /* Version 3.20 by Howard Wulf, AF5NE */
- /* */
- /* Version 3.20A by Ken Martin Mainly corrected fprint issues */
- /* */
- /*---------------------------------------------------------------*/
-
-
-
- #include "bwbasic.h"
-
- static void bwb_copy_file (char *Source, char *Target);
- static LineType *bwb_delete (LineType * l);
- static void bwb_display_file (char *Source);
- static LineType *bwb_load (LineType * Line, char *Prompt, int IsNew);
- static void bwb_new (void);
- static LineType *bwb_run_filename_or_linenumber (LineType * L);
- static LineType *bwb_save (LineType * Line, char *Prompt);
- static LineType *bwb_system (LineType * l);
- static LineType *bwb_xlist (LineType * l, FILE * file);
- static LineType *bwx_run (LineType * Line, char *ProgramName);
- static void CommandOptionVersion (int n, char *OutputLine);
- static void CommandUniqueID (int i, char *UniqueID);
- static void CommandVector (int i, char *Vector);
- static VariableType *find_variable_by_type (char *name, int dimensions,
- char VariableTypeCode);
- static void FixUp (char *Name);
- static LineType *H14_RENAME (LineType * l);
- static int line_read_matrix_redim (LineType * l, VariableType * v);
- static void ProcessEscapeChars (const char *Input, char *Output);
- static int xl_line (FILE * file, LineType * l);
-
-
- /*
- fprintf( file, "------------------------------------------------------------\n");
- 123456789012345678901234567890123456789012345678901234567890
- fprintf( file, " SYNTAX: %s\n", IntrinsicCommandTable[n].Syntax);
- sprintf( tbuf, "DESCRIPTION: %s\n", IntrinsicCommandTable[n].Description);
- fprintf( file, " " );
- fprintf( file, " [%c] %s\n", X, bwb_vertable[i].Name);
- 1234567890123
- */
- #define LEFT_LENGTH 13
- #define RIGHT_LENGTH 47
- #define TOTAL_LENGTH ( LEFT_LENGTH + RIGHT_LENGTH )
-
- /*
- --------------------------------------------------------------------------------------------
- EDIT, RENUM, RENUMBER
- --------------------------------------------------------------------------------------------
- */
-
- static LineType *
- bwx_run (LineType * Line, char *ProgramName)
- {
- size_t n;
- char *tbuf;
-
- assert (Line != NULL);
- assert( My != NULL );
-
- if (is_empty_string (ProgramName))
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- if (is_empty_string (My->ProgramFilename))
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- n = bwb_strlen (ProgramName) + 1 + bwb_strlen (My->ProgramFilename);
- if ((tbuf = (char *) calloc (n + 1 /* NulChar */ , sizeof (char))) == NULL)
- {
- WARN_OUT_OF_MEMORY;
- return (Line);
- }
- bwb_strcpy (tbuf, ProgramName);
- bwb_strcat (tbuf, " ");
- bwb_strcat (tbuf, My->ProgramFilename);
- system (tbuf);
- free (tbuf);
- tbuf = NULL;
-
- /* open edited file for read */
- bwb_NEW (Line); /* Relocated by JBV (bug found by DD) */
- if (bwb_fload (NULL) == FALSE)
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- return (Line);
- }
-
-
-
- /***************************************************************
-
- FUNCTION: bwb_edit()
-
- DESCRIPTION: This function implements the BASIC EDIT
- program by shelling out to a default editor
- specified by the variable BWB.EDITOR$.
-
- SYNTAX: EDIT
-
- ***************************************************************/
-
- LineType *
- bwb_EDIT (LineType * Line)
- {
- /*
- SYNTAX: EDIT
- */
-
- assert (Line != NULL);
- assert( My != NULL );
-
- return bwx_run (Line, My->OptionEditString);
- }
-
- /***************************************************************
-
- FUNCTION: bwb_renum()
-
- DESCRIPTION: This function implements the BASIC RENUM
- command by shelling out to a default
- renumbering program called "renum".
- Added by JBV 10/95
-
- SYNTAX: RENUM
-
- ***************************************************************/
-
- LineType *
- bwb_RENUM (LineType * Line)
- {
- /*
- SYNTAX: RENUM
- */
-
- assert (Line != NULL);
- assert( My != NULL );
-
- return bwx_run (Line, My->OptionRenumString);
- }
-
- LineType *
- bwb_RENUMBER (LineType * Line)
- {
- /*
- SYNTAX: RENUMBER
- */
-
- assert (Line != NULL);
- assert( My != NULL );
-
- return bwx_run (Line, My->OptionRenumString);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- REM
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_REM (LineType * L)
- {
- /*
- SYNTAX: REM comment
- */
- /*
- This line holds BASIC comments.
- */
-
- assert (L != NULL);
-
- line_skip_eol (L);
- return L;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- IMAGE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_IMAGE (LineType * L)
- {
- /*
- SYNTAX: IMAGE print-using-format
- */
-
- assert (L != NULL);
-
- line_skip_eol (L);
- return L;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- LET
- --------------------------------------------------------------------------------------------
- */
-
-
- LineType *
- bwb_LET (LineType * L)
- {
- /*
- SYNTAX: LET variable [,...] = expression
- */
- VariableType *v;
- VariantType x;
- VariantType *X;
-
- assert (L != NULL);
- X = &x;
- CLEAR_VARIANT (X);
- /* read the list of variables */
- do
- {
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
-
- /* skip the equal sign */
- if (line_skip_EqualChar (L))
- {
- /* OK */
- }
- else if (line_skip_word (L, "EQ"))
- {
- /* OK */
- }
- else if (line_skip_word (L, ".EQ."))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
-
- /* evaluate the expression */
- if (line_read_expression (L, X)) /* bwb_LET */
- {
- /* save the value */
- if (line_is_eol (L) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
- L->position = L->Startpos;
-
- /* for each variable, assign the value */
- do
- {
- /* read a variable */
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- assert (v != NULL);
- assert (X != NULL);
- if (var_set (v, X) == FALSE)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
-
- /* we are now at the equals sign */
- line_skip_eol (L);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- }
- EXIT:
- RELEASE_VARIANT (X);
- return L;
- }
-
-
- LineType *
- bwb_CONST (LineType * L)
- {
- /*
- SYNTAX: CONST variable [,...] = expression
- */
- VariableType *v;
- VariantType x;
- VariantType *X;
-
- assert (L != NULL);
-
- X = &x;
- CLEAR_VARIANT (X);
- /* read the list of variables */
- do
- {
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
- /* we are now at the equals sign */
-
- /* skip the equal sign */
- if (line_skip_EqualChar (L))
- {
- /* OK */
- }
- else if (line_skip_word (L, "EQ"))
- {
- /* OK */
- }
- else if (line_skip_word (L, ".EQ."))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
-
- /* evaluate the expression */
- if (line_read_expression (L, X)) /* bwb_LET */
- {
- /* save the value */
- if (line_is_eol (L) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
-
- /* for each variable, assign the value */
- L->position = L->Startpos;
- do
- {
- /* read a variable */
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- assert (v != NULL);
- assert (X != NULL);
- if (var_set (v, X) == FALSE)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
- /* we are now at the equals sign */
-
- /* for each variable, mark as constant */
- L->position = L->Startpos;
- do
- {
- /* read a variable */
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- assert (v != NULL);
- v->VariableFlags |= VARIABLE_CONSTANT;
- }
- while (line_skip_seperator (L));
- /* we are now at the equals sign */
-
- line_skip_eol (L);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- }
- EXIT:
- RELEASE_VARIANT (X);
- return L;
- }
-
- LineType *
- bwb_DEC (LineType * L)
- {
- /*
- SYNTAX: DEC variable [,...]
- */
- VariableType *v;
- VariantType x;
- VariantType *X;
-
- assert (L != NULL);
-
- X = &x;
- CLEAR_VARIANT (X);
- /* read the list of variables */
- do
- {
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- if (v->VariableTypeCode == StringTypeCode)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
- /* we are now at the end of the line */
-
- if (line_is_eol (L) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
- L->position = L->Startpos;
-
- /* for each variable, assign the value */
- do
- {
- /* read a variable */
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- assert (v != NULL);
- assert (X != NULL);
- if (var_get (v, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- X->Number--;
- if (var_set (v, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
- /* we are now at the end of the line */
- EXIT:
- RELEASE_VARIANT (X);
- return L;
- }
-
- LineType *
- bwb_INC (LineType * L)
- {
- /*
- SYNTAX: INC variable [,...]
- */
- VariableType *v;
- VariantType x;
- VariantType *X;
-
- assert (L != NULL);
-
- X = &x;
- CLEAR_VARIANT (X);
- /* read the list of variables */
- do
- {
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- if (v->VariableTypeCode == StringTypeCode)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
- /* we are now at the end of the line */
-
- if (line_is_eol (L) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
- L->position = L->Startpos;
-
- /* for each variable, assign the value */
- do
- {
- /* read a variable */
- if ((v = line_read_scalar (L)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- assert (v != NULL);
- assert (X != NULL);
- if (var_get (v, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- X->Number++;
- if (var_set (v, X) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- }
- while (line_skip_seperator (L));
- /* we are now at the end of the line */
- EXIT:
- RELEASE_VARIANT (X);
- return L;
- }
-
-
-
- /*
- --------------------------------------------------------------------------------------------
- GO
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_GO (LineType * L)
- {
-
- assert (L != NULL);
- WARN_SYNTAX_ERROR;
- return L;
- }
-
- LineType *
- bwb_THEN (LineType * L)
- {
-
- assert (L != NULL);
- WARN_SYNTAX_ERROR;
- return L;
- }
-
- LineType *
- bwb_TO (LineType * L)
- {
-
- assert (L != NULL);
- WARN_SYNTAX_ERROR;
- return L;
- }
-
- LineType *
- bwb_STEP (LineType * L)
- {
-
- assert (L != NULL);
- WARN_SYNTAX_ERROR;
- return L;
- }
-
- LineType *
- bwb_OF (LineType * L)
- {
-
- assert (L != NULL);
- WARN_SYNTAX_ERROR;
- return L;
- }
-
- LineType *
- bwb_AS (LineType * L)
- {
-
- assert (L != NULL);
- WARN_SYNTAX_ERROR;
- return L;
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- AUTO
- --------------------------------------------------------------------------------------------
- */
-
-
- LineType *
- bwb_BUILD (LineType * L)
- {
- /*
- SYNTAX: BUILD
- SYNTAX: BUILD start
- SYNTAX: BUILD start, increment
- */
-
- assert (L != NULL);
- return bwb_AUTO (L);
- }
-
- LineType *
- bwb_AUTO (LineType * L)
- {
- /*
- SYNTAX: AUTO
- SYNTAX: AUTO start
- SYNTAX: AUTO start , increment
- */
-
- assert (L != NULL);
- assert( My != NULL );
-
- My->AutomaticLineNumber = 0;
- My->AutomaticLineIncrement = 0;
-
- if (line_is_eol (L))
- {
- /* AUTO */
- My->AutomaticLineNumber = 10;
- My->AutomaticLineIncrement = 10;
- return L;
- }
- if (line_read_line_number (L, &My->AutomaticLineNumber))
- {
- /* AUTO ### ... */
- if (My->AutomaticLineNumber < MINLIN || My->AutomaticLineNumber > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return L;
- }
- if (line_is_eol (L))
- {
- /* AUTO start */
- My->AutomaticLineIncrement = 10;
- return L;
- }
- else if (line_skip_seperator (L))
- {
- /* AUTO ### , ... */
- if (line_read_line_number (L, &My->AutomaticLineIncrement))
- {
- /* AUTO start , increment */
- if (My->AutomaticLineIncrement < MINLIN
- || My->AutomaticLineIncrement > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return L;
- }
- return L;
- }
- }
- }
- My->AutomaticLineNumber = 0;
- My->AutomaticLineIncrement = 0;
- WARN_SYNTAX_ERROR;
- return L;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- BREAK
- --------------------------------------------------------------------------------------------
- */
-
-
- LineType *
- bwb_BREAK (LineType * l)
- {
- /*
- SYNTAX: BREAK
- SYNTAX: BREAK line [,...]
- SYNTAX: BREAK line - line
- */
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->StartMarker != NULL );
- assert( My->EndMarker != NULL );
-
- if (line_is_eol (l))
- {
- /* BREAK */
- /* remove all line breaks */
- LineType *x;
- for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
- {
- x->LineFlags &= ~LINE_BREAK;
- }
- return (l);
- }
- else
- {
- do
- {
- int head;
- int tail;
-
- if (line_read_line_sequence (l, &head, &tail))
- {
- /* BREAK 's' - 'e' */
- LineType *x;
- if (head < MINLIN || head > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- if (tail < MINLIN || tail > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- if (head > tail)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* valid range */
- /* now go through and list appropriate lines */
- for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
- {
- if (head <= x->number && x->number <= tail)
- {
- if (x->LineFlags & LINE_NUMBERED)
- {
- x->LineFlags |= LINE_BREAK;
- }
- }
- }
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- while (line_skip_seperator (l));
- }
- return (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- DSP
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_DSP (LineType * l)
- {
- /*
- SYNTAX: DSP
- SYNTAX: DSP variablename [,...]
- */
- VariableType *v;
-
- assert (l != NULL);
- assert( My != NULL );
-
-
- if (line_is_eol (l))
- {
- /* DSP */
- /* remove all variable displays */
- for (v = My->VariableHead; v != NULL; v = v->next)
- {
- v->VariableFlags &= ~VARIABLE_DISPLAY; /* bwb_DSP() */
- }
- return (l);
- }
- /* DSP variablename [,...] */
- do
- {
- char varname[NameLengthMax + 1];
-
- if (line_read_varname (l, varname))
- {
- /* mark the variable */
- for (v = My->VariableHead; v != NULL; v = v->next)
- {
- if (bwb_stricmp (v->name, varname) == 0)
- {
- v->VariableFlags |= VARIABLE_DISPLAY; /* bwb_DSP() */
- }
- }
- }
- }
- while (line_skip_seperator (l));
- return (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- GOTO
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_GO_TO (LineType * l)
- {
-
- assert (l != NULL);
- return bwb_GOTO (l);
- }
-
- LineType *
- bwb_GOTO (LineType * l)
- {
- /*
- SYNTAX: GOTO line ' standard GOTO
- SYNTAX: GOTO expression ' calculated GOTO
- SYNTAX: GOTO expression OF line,... ' indexed GOTO, same as ON expression GOTO line,...
- SYNTAX: GOTO line [,...] ON expression ' indexed GOTO, same as ON expression GOTO line,...
- */
- int Value;
- int LineNumber;
- LineType *x;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->CurrentVersion != NULL );
-
- Value = 0;
- LineNumber = 0;
- if (l->LineFlags & (LINE_USER))
- {
- WARN_ILLEGAL_DIRECT;
- return (l);
- }
-
- if (line_is_eol (l))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if (line_is_eol (l))
- {
- /* GOTO linenumber */
- /* 'Value' is the line number */
- LineNumber = Value;
- }
- else if (line_skip_word (l, "OF"))
- {
- /* GOTO expression OF line, ... */
- /* 'Value' is an index into a list of line numbers */
- if (line_read_index_item (l, Value, &LineNumber))
- {
- /* found 'LineNumber' */
- }
- else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* GOTO X OF ... */
- {
- /* silently fall-thru to the following line */
- line_skip_eol (l);
- return (l);
- }
- else
- {
- /* ERROR */
- WARN_UNDEFINED_LINE;
- return (l);
- }
- }
- else if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* GOTO line [,...] ON expression */
- while (line_skip_seperator (l))
- {
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- if (line_skip_word (l, "ON") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* 'Value' is an index into a list of line numbers */
- l->position = l->Startpos;
- if (line_read_index_item (l, Value, &LineNumber))
- {
- /* found 'LineNumber' */
- }
- else
- {
- /* silently fall-thru to the following line */
- line_skip_eol (l);
- return (l);
- }
- line_skip_eol (l);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if (LineNumber < MINLIN || LineNumber > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- /* valid range */
- x = NULL;
- #if THE_PRICE_IS_RIGHT
- if (l->OtherLine != NULL)
- {
- /* look in the cache */
- if (l->OtherLine->number == LineNumber)
- {
- x = l->OtherLine; /* found in cache */
- }
- }
- #endif /* THE_PRICE_IS_RIGHT */
- if (x == NULL)
- {
- x = find_line_number (LineNumber); /* not found in the cache */
- }
- if (x != NULL)
- {
- /* FOUND */
- line_skip_eol (l);
- x->position = 0;
- #if THE_PRICE_IS_RIGHT
- l->OtherLine = x; /* save in cache */
- #endif /* THE_PRICE_IS_RIGHT */
- return x;
- }
- /* NOT FOUND */
- WARN_UNDEFINED_LINE;
- return (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- GOSUB
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_GO_SUB (LineType * l)
- {
-
- assert (l != NULL);
- return bwb_GOSUB (l);
- }
-
- LineType *
- bwb_GOSUB (LineType * l)
- {
- /*
- SYNTAX: GOSUB line ' standard GOSUB
- SYNTAX: GOSUB expression ' calculated GOSUB
- SYNTAX: GOSUB expression OF line,... ' indexed GOSUB, same as ON expression GOSUB line,...
- SYNTAX: GOSUB line [,...] ON expression ' indexed GOSUB, same as ON expression GOSUB line,...
- */
- int Value;
- int LineNumber;
- LineType *x;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->CurrentVersion != NULL );
-
- Value = 0;
- LineNumber = 0;
- x = NULL;
- if (l->LineFlags & (LINE_USER))
- {
- WARN_ILLEGAL_DIRECT;
- return (l);
- }
-
- if (line_is_eol (l))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if (line_is_eol (l))
- {
- /* GOSUB linenumber */
- /* 'Value' is the line number */
- LineNumber = Value;
- }
- else if (line_skip_word (l, "OF"))
- {
- /* GOSUB linenumber [,...] OF expression */
- /* 'Value' is an index into a list of line numbers */
- if (line_read_index_item (l, Value, &LineNumber))
- {
- /* found 'LineNumber' */
- }
- else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* GOSUB X OF ... */
- {
- /* silently fall-thru to the following line */
- line_skip_eol (l);
- return (l);
- }
- else
- {
- /* ERROR */
- WARN_UNDEFINED_LINE;
- return (l);
- }
- }
- else if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* GOSUB line [,...] ON expression */
- while (line_skip_seperator (l))
- {
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- if (line_skip_word (l, "ON") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* 'Value' is an index into a list of line numbers */
- l->position = l->Startpos;
- if (line_read_index_item (l, Value, &LineNumber))
- {
- /* found 'LineNumber' */
- }
- else
- {
- /* silently fall-thru to the following line */
- line_skip_eol (l);
- return (l);
- }
- line_skip_eol (l);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if (LineNumber < MINLIN || LineNumber > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- /* valid range */
- x = NULL;
- #if THE_PRICE_IS_RIGHT
- if (l->OtherLine != NULL)
- {
- /* look in the cache */
- if (l->OtherLine->number == LineNumber)
- {
- x = l->OtherLine; /* found in cache */
- }
- }
- #endif /* THE_PRICE_IS_RIGHT */
- if (x == NULL)
- {
- x = find_line_number (LineNumber); /* not found in the cache */
- }
- if (x != NULL)
- {
- /* FOUND */
- line_skip_eol (l);
- /* save current stack level */
- My->StackHead->line = l;
- /* increment exec stack */
- if (bwb_incexec ())
- {
- /* set the new position to x and return x */
- x->position = 0;
- My->StackHead->line = x;
- My->StackHead->ExecCode = EXEC_GOSUB;
- #if THE_PRICE_IS_RIGHT
- l->OtherLine = x; /* save in cache */
- #endif /* THE_PRICE_IS_RIGHT */
- return x;
- }
- else
- {
- /* ERROR */
- WARN_OUT_OF_MEMORY;
- return My->EndMarker;
- }
- }
- /* NOT FOUND */
- WARN_UNDEFINED_LINE;
- return (l);
- }
-
-
-
- /*
- --------------------------------------------------------------------------------------------
- RETURN
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_RETURN (LineType * l)
- {
- /*
- SYNTAX: RETURN
- */
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
- assert (My->StackHead != NULL);
-
- if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* RETURN [comment] */
- line_skip_eol (l);
- }
-
- if (My->CurrentVersion->OptionVersionValue & (C77))
- {
- /* CBASIC-II: RETURN exits the first FUNCTION or GOSUB */
-
- while (My->StackHead->ExecCode != EXEC_GOSUB
- && My->StackHead->ExecCode != EXEC_FUNCTION)
- {
- bwb_decexec ();
- if (My->StackHead == NULL)
- {
- WARN_RETURN_WITHOUT_GOSUB;
- return (l);
- }
- if (My->StackHead->ExecCode == EXEC_NORM) /* End of the line? */
- {
- WARN_RETURN_WITHOUT_GOSUB;
- return (l);
- }
- }
- }
- else
- {
- /* RETURN exits the first GOSUB */
-
- while (My->StackHead->ExecCode != EXEC_GOSUB)
- {
- bwb_decexec ();
- if (My->StackHead == NULL)
- {
- WARN_RETURN_WITHOUT_GOSUB;
- return (l);
- }
- if (My->StackHead->ExecCode == EXEC_NORM) /* End of the line? */
- {
- WARN_RETURN_WITHOUT_GOSUB;
- return (l);
- }
- }
- }
-
-
- /* decrement the EXEC stack counter */
-
- bwb_decexec ();
- assert (My->StackHead != NULL);
- return My->StackHead->line;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- POP
- --------------------------------------------------------------------------------------------
- */
-
-
- LineType *
- bwb_POP (LineType * l)
- {
- /*
- SYNTAX: POP
- */
- StackType *StackItem;
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
- assert (My->StackHead != NULL);
-
- StackItem = My->StackHead;
- while (StackItem->ExecCode != EXEC_GOSUB)
- {
- StackItem = StackItem->next;
- if (StackItem == NULL)
- {
- WARN_RETURN_WITHOUT_GOSUB;
- return (l);
- }
- if (StackItem->ExecCode == EXEC_NORM)
- {
- /* End of the line */
- WARN_RETURN_WITHOUT_GOSUB;
- return (l);
- }
- }
- /* hide the GOSUB */
- StackItem->ExecCode = EXEC_POPPED;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_ON (LineType * l)
- {
- /*
- SYNTAX: ON expression GOTO line,... ' expression evaluates to an index
- SYNTAX: ON expression GOSUB line,... ' expression evaluates to an index
- */
- int Value;
- int command;
- int LineNumber;
- LineType *x;
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
-
- Value = 0;
- command = 0;
- LineNumber = 0;
- x = NULL;
- if (l->LineFlags & (LINE_USER))
- {
- WARN_ILLEGAL_DIRECT;
- return (l);
- }
-
- if (line_is_eol (l))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- if (line_skip_word (l, "GO"))
- {
- if (line_skip_word (l, "TO"))
- {
- command = C_GOTO;
- }
- else if (line_skip_word (l, "SUB"))
- {
- command = C_GOSUB;
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else if (line_skip_word (l, "GOTO"))
- {
- command = C_GOTO;
- }
- else if (line_skip_word (l, "GOSUB"))
- {
- command = C_GOSUB;
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /* 'Value' is an index into a list of line numbers */
- if (line_read_index_item (l, Value, &LineNumber))
- {
- /* found 'LineNumber' */
- }
- else if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON) ) /* ON X GOTO|GOSUB ... */
- {
- /* silently fall-thru to the following line */
- line_skip_eol (l);
- return (l);
- }
- else
- {
- /* ERROR */
- WARN_UNDEFINED_LINE;
- return (l);
- }
-
- if (LineNumber < MINLIN || LineNumber > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- /* valid range */
- x = NULL;
- #if THE_PRICE_IS_RIGHT
- if (l->OtherLine != NULL)
- {
- /* look in the cache */
- if (l->OtherLine->number == LineNumber)
- {
- x = l->OtherLine; /* found in cache */
- }
- }
- #endif /* THE_PRICE_IS_RIGHT */
- if (x == NULL)
- {
- x = find_line_number (LineNumber); /* not found in the cache */
- }
- if (x != NULL)
- {
- /* FOUND */
- if (command == C_GOTO)
- {
- /* ON ... GOTO ... */
- line_skip_eol (l);
- x->position = 0;
- #if THE_PRICE_IS_RIGHT
- l->OtherLine = x; /* save in cache */
- #endif /* THE_PRICE_IS_RIGHT */
- return x;
- }
- else if (command == C_GOSUB)
- {
- /* ON ... GOSUB ... */
- line_skip_eol (l);
- /* save current stack level */
- My->StackHead->line = l;
- /* increment exec stack */
- if (bwb_incexec ())
- {
- /* set the new position to x and return x */
- x->position = 0;
- My->StackHead->line = x;
- My->StackHead->ExecCode = EXEC_GOSUB;
- #if THE_PRICE_IS_RIGHT
- l->OtherLine = x; /* save in cache */
- #endif /* THE_PRICE_IS_RIGHT */
- return x;
- }
- else
- {
- /* ERROR */
- WARN_OUT_OF_MEMORY;
- return My->EndMarker;
- }
- }
- else
- {
- /* ERROR */
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- /* NOT FOUND */
- WARN_UNDEFINED_LINE;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- PAUSE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_PAUSE (LineType * l)
- {
- /*
- SYNTAX: PAUSE
- */
- char *pstring;
- char *tbuf;
- int tlen;
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
- assert (My->ConsoleOutput != NULL);
- assert (My->ConsoleInput != NULL);
-
- pstring = My->ConsoleOutput;
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* PAUSE [comment] */
- line_skip_eol (l);
- }
- sprintf (pstring, "PAUSE AT %d\n", l->number);
- bwx_input (pstring, FALSE, tbuf, tlen);
- return (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- STOP
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_STOP (LineType * l)
- {
- /*
- SYNTAX: STOP
- */
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
-
- if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* STOP [comment] */
- line_skip_eol (l);
- }
- My->ContinueLine = l->next;
- bwx_STOP (TRUE);
- return bwb_END (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- END
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_END (LineType * l)
- {
- /*
- SYNTAX: END
- */
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
-
- if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* END [comment] */
- line_skip_eol (l);
- }
- My->ContinueLine = l->next;
- bwx_STOP (FALSE);
- return My->EndMarker;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- RUN
- --------------------------------------------------------------------------------------------
- */
-
- static LineType *
- bwb_run_filename_or_linenumber (LineType * L)
- {
- LineType *current = NULL;
- VariantType x;
- VariantType *X;
-
- assert (L != NULL);
- assert (My != NULL);
- assert (My->StartMarker != NULL);
-
- X = &x;
- CLEAR_VARIANT (X);
- if (line_read_expression (L, X) == FALSE) /* bwb_run_filename_or_linenumber */
- {
- WARN_SYNTAX_ERROR;
- return L;
- }
- if (X->VariantTypeCode == StringTypeCode)
- {
- /* RUN "filename" */
- /* RUN A$ */
- if (is_empty_string (X->Buffer))
- {
- WARN_BAD_FILE_NAME;
- return L;
- }
- /* open the file and execute it */
- bwb_new (); /* clear memory */
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = bwb_strdup (X->Buffer);
- if (bwb_fload (NULL) == FALSE)
- {
- WARN_BAD_FILE_NAME;
- return L;
- }
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- WARN_CANT_CONTINUE;
- return L;
- }
- current = My->StartMarker->next;
- }
- else
- {
- /* RUN 100 */
- /* RUN N */
- /* execute the line */
- int LineNumber;
-
-
- LineNumber = (int) bwb_rint (X->Number);
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- WARN_CANT_CONTINUE;
- goto EXIT;
- }
- current = find_line_number (LineNumber); /* RUN 100 */
- if (current == NULL)
- {
- WARN_CANT_CONTINUE;
- return L;
- }
- }
- EXIT:
- RELEASE_VARIANT (X);
- return current;
- }
-
- LineType *
- bwb_RUNNH (LineType * L)
- {
-
- assert (L != NULL);
- return bwb_RUN (L);
- }
-
- LineType *
- bwb_RUN (LineType * L)
- {
- /*
- SYNTAX: RUN
- SYNTAX: RUN filename$
- SYNTAX: RUN linenumber
- */
- LineType *current;
-
- assert (L != NULL);
- assert (My != NULL);
- assert (My->EndMarker != NULL);
- assert (My->DefaultVariableType != NULL);
-
- /* clear the STACK */
- bwb_clrexec ();
- if (bwb_incexec ())
- {
- /* OK */
- }
- else
- {
- /* ERROR */
- WARN_OUT_OF_MEMORY;
- return My->EndMarker;
- }
-
- if (line_is_eol (L))
- {
- /* RUN */
-
- var_CLEAR ();
-
- /* if( TRUE ) */
- {
- int n;
- for (n = 0; n < 26; n++)
- {
- My->DefaultVariableType[n] = DoubleTypeCode;
- }
- }
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- WARN_CANT_CONTINUE;
- return My->EndMarker;
- }
- current = My->StartMarker->next;
- }
- else
- {
- /* RUN 100 : RUN filename$ */
- current = bwb_run_filename_or_linenumber (L);
- if (current == NULL)
- {
- WARN_UNDEFINED_LINE;
- return My->EndMarker;
- }
- }
- current->position = 0;
-
- assert (My->StackHead != NULL);
- My->StackHead->line = current;
- My->StackHead->ExecCode = EXEC_NORM;
-
- /* RUN */
- WARN_CLEAR; /* bwb_RUN */
- My->ContinueLine = NULL;
- SetOnError (0);
-
- /* if( TRUE ) */
- {
- time_t t;
- struct tm *lt;
-
- time (&t);
- lt = localtime (&t);
- My->StartTimeInteger = lt->tm_hour;
- My->StartTimeInteger *= 60;
- My->StartTimeInteger += lt->tm_min;
- My->StartTimeInteger *= 60;
- My->StartTimeInteger += lt->tm_sec;
- /* number of seconds since midnight */
- }
-
- return current;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CONT
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_CONTINUE (LineType * l)
- {
- /*
- SYNTAX: CONTINUE
- */
-
- assert (l != NULL);
- return bwb_CONT (l);
- }
-
- LineType *
- bwb_CONT (LineType * l)
- {
- /*
- SYNTAX: CONT
- */
- LineType *current;
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->EndMarker != NULL);
- assert (My->StartMarker != NULL);
-
- current = NULL;
- /* see if there is an element */
- if (line_is_eol (l))
- {
- /* CONT */
- current = My->ContinueLine;
- }
- else
- {
- /* CONT 100 */
- int LineNumber;
-
- LineNumber = 0;
- if (line_read_line_number (l, &LineNumber))
- {
- current = find_line_number (LineNumber); /* CONT 100 */
- }
- }
-
-
- if (current == NULL || current == My->EndMarker)
- {
- /* same as RUN */
- current = My->StartMarker->next;
- }
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- WARN_CANT_CONTINUE;
- return (l);
- }
- current->position = 0;
- bwb_clrexec ();
- if (bwb_incexec ())
- {
- /* OK */
- My->StackHead->line = current;
- My->StackHead->ExecCode = EXEC_NORM;
- }
- else
- {
- /* ERROR */
- WARN_OUT_OF_MEMORY;
- return My->EndMarker;
- }
-
-
- /* CONT */
- My->ContinueLine = NULL;
- return current;
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- NEW
- --------------------------------------------------------------------------------------------
- */
-
- void
- bwb_xnew (LineType * l)
- {
- LineType *current;
- LineType *previous;
- int wait;
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->EndMarker != NULL);
-
- previous = NULL; /* JBV */
- wait = TRUE;
- for (current = l->next; current != My->EndMarker; current = current->next)
- {
- assert (current != NULL);
- if (wait == FALSE)
- {
- free (previous);
- previous = NULL;
- }
- wait = FALSE;
- previous = current;
- }
- l->next = My->EndMarker;
- }
-
- static void
- bwb_new ()
- {
- assert (My != NULL);
- assert (My->StartMarker != NULL);
- assert (My->DefaultVariableType != NULL);
-
-
- /* clear program in memory */
- bwb_xnew (My->StartMarker);
-
- /* clear all variables */
- var_CLEAR ();
- /* if( TRUE ) */
- {
- int n;
- for (n = 0; n < 26; n++)
- {
- My->DefaultVariableType[n] = DoubleTypeCode;
- }
- }
-
- /* NEW */
- WARN_CLEAR; /* bwb_new */
- My->ContinueLine = NULL;
- SetOnError (0);
- }
-
- LineType *
- bwb_NEW (LineType * l)
- {
- /*
- SYNTAX: NEW
- */
-
- assert (l != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
-
- bwb_new ();
- if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74))
- {
- if (line_is_eol (l))
- {
- /* NEW */
- char *tbuf;
- int tlen;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- /* prompt for the program name */
- bwx_input ("NEW PROBLEM NAME:", FALSE, tbuf, tlen);
- if (is_empty_string (tbuf))
- {
- WARN_BAD_FILE_NAME;
- return l;
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = bwb_strdup (tbuf);
- }
- else
- {
- /* NEW filename$ */
- /* the parameter is the program name */
-
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (is_empty_string (Value))
- {
- WARN_BAD_FILE_NAME;
- return l;
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = Value;
- }
- }
- else
- {
- /* ignore any parameters */
- line_skip_eol (l);
- }
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- SCRATCH
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_SCRATCH (LineType * l)
- {
- /*
- SYNTAX: SCRATCH -- same as NEW
- SYNTAX: SCRATCH # filenumber -- close file and re-open for output
- */
-
- assert (l != NULL);
-
- if (line_is_eol (l))
- {
- /* SCRATCH */
- bwb_new ();
- return (l);
- }
- if (line_skip_FilenumChar (l))
- {
- /* SCRATCH # X */
- int FileNumber;
-
- if (line_read_integer_expression (l, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (FileNumber < 0)
- {
- /* SCRATCH # -1 is silently ignored */
- return (l);
- }
- if (FileNumber == 0)
- {
- /* SCRATCH # 0 is silently ignored */
- return (l);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
- {
- My->CurrentFile->DevMode = DEVMODE_CLOSED;
- }
- if (My->CurrentFile->cfp != NULL)
- {
- bwb_fclose (My->CurrentFile->cfp);
- My->CurrentFile->cfp = NULL;
- }
- if (My->CurrentFile->buffer != NULL)
- {
- free (My->CurrentFile->buffer);
- My->CurrentFile->buffer = NULL;
- }
- My->CurrentFile->width = 0;
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- if (is_empty_string (My->CurrentFile->FileName))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
- {
- if ((My->CurrentFile->cfp =
- fopen (My->CurrentFile->FileName, "w")) == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- My->CurrentFile->DevMode = DEVMODE_OUTPUT;
- }
- /* OK */
- return (l);
- }
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- ============================================================================================
- SYSTEM and so on
- ============================================================================================
- */
- static LineType *
- bwb_system (LineType * l)
- {
- /*
- SYNTAX: SYSTEM
- */
- assert (l != NULL);
- assert (My != NULL);
- assert (My->SYSOUT != NULL);
- assert (My->SYSOUT->cfp != NULL);
-
- fprintf (My->SYSOUT->cfp, "\n");
- fflush (My->SYSOUT->cfp);
- bwx_terminate ();
- return (l); /* never reached */
- }
-
- /*
- --------------------------------------------------------------------------------------------
- BYE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_BYE (LineType * l)
- {
- /*
- SYNTAX: BYE
- */
-
- assert (l != NULL);
- return bwb_system (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- DOS
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_DOS (LineType * l)
- {
- /*
- SYNTAX: DOS
- */
-
- assert (l != NULL);
- return bwb_system (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- FLEX
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_FLEX (LineType * l)
- {
- /*
- SYNTAX: FLEX
- */
-
- assert (l != NULL);
- return bwb_system (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- GOODBYE
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_GOODBYE (LineType * l)
- {
- /*
- SYNTAX: GOODBYE
- */
-
- assert (l != NULL);
- return bwb_system (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- MON
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_MON (LineType * l)
- {
- /*
- SYNTAX: MON
- */
-
- assert (l != NULL);
- return bwb_system (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- QUIT
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_QUIT (LineType * l)
- {
- /*
- SYNTAX: QUIT
- */
-
- assert (l != NULL);
- return bwb_system (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- SYSTEM
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_SYSTEM (LineType * l)
- {
- /*
- SYNTAX: SYSTEM
- */
-
- assert (l != NULL);
- return bwb_system (l);
- }
-
-
- /*
- ============================================================================================
- LOAD and so on
- ============================================================================================
- */
-
- static LineType *
- bwb_load (LineType * Line, char *Prompt, int IsNew)
- {
- /*
- **
- ** load a BASIC program from a file
- **
- */
- /*
- SYNTAX: ... [filename$]
- */
-
- assert (Line != NULL);
- assert (Prompt != NULL);
- assert (My != NULL);
- assert (My->CurrentVersion != NULL);
-
- if (IsNew)
- {
- /* TRUE == LOAD */
- bwb_new ();
- }
- else
- {
- /* FALSE == MERGE */
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- }
- if (line_is_eol (Line))
- {
- /* default is the last filename used by LOAD or SAVE */
- /* if( My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74) ) */
- if (is_empty_string (My->ProgramFilename))
- {
- /* prompt for the program name */
- char *tbuf;
- int tlen;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- bwx_input (Prompt, FALSE, tbuf, tlen);
- if (is_empty_string (tbuf))
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = bwb_strdup (tbuf);
- }
- fprintf (My->SYSOUT->cfp, "Loading %s\n", My->ProgramFilename);
- ResetConsoleColumn ();
- }
- else
- {
- /* Get an argument for filename */
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (Line, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (is_empty_string (Value))
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = Value;
- }
- if (bwb_fload (NULL) == FALSE)
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- if (IsNew)
- {
- /* TRUE == LOAD */
- }
- else
- {
- /* FALSE == MERGE */
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- }
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- WARN_CANT_CONTINUE;
- }
- return (Line);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CLOAD
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_CLOAD (LineType * Line)
- {
- /*
- SYNTAX: CLOAD [filename$]
- */
-
- assert (Line != NULL);
- return bwb_load (Line, "CLOAD FILE NAME:", TRUE);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- LOAD
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_LOAD (LineType * Line)
- {
- /*
- SYNTAX: LOAD [filename$]
- */
-
- assert (Line != NULL);
- return bwb_load (Line, "LOAD FILE NAME:", TRUE);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- MERGE
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_MERGE (LineType * l)
- {
- /*
- SYNTAX: MERGE [filename$]
- */
-
- assert (l != NULL);
- return bwb_load (l, "MERGE FILE NAME:", FALSE);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- OLD
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_OLD (LineType * Line)
- {
- /*
- SYNTAX: OLD [filename$]
- */
-
- assert (Line != NULL);
- return bwb_load (Line, "OLD PROBLEM NAME:", TRUE);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- TLOAD
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_TLOAD (LineType * Line)
- {
- /*
- SYNTAX: TLOAD [filename$]
- */
-
- assert (Line != NULL);
- return bwb_load (Line, "TLOAD FILE NAME:", TRUE);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- RENAME
- --------------------------------------------------------------------------------------------
- */
- static LineType *
- H14_RENAME (LineType * l)
- {
- /*
- SYNTAX: RENAME from$ TO to$
- */
- char *From;
- char *To;
-
- assert (l != NULL);
-
- From = NULL;
- To = NULL;
- if (line_read_string_expression (l, &From) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (is_empty_string (From))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (line_skip_word (l, "TO") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_string_expression (l, &To) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (is_empty_string (To))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (rename (From, To))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- return (l);
- }
-
- LineType *
- bwb_RENAME (LineType * l)
- {
- /*
- SYNTAX: RENAME filename$
- */
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->CurrentVersion != NULL );
- assert( My->ConsoleInput != NULL );
-
- if (My->CurrentVersion->OptionVersionValue & (H14))
- {
- /* RENAME == change an exisiting file's name */
- return H14_RENAME (l);
- }
- /* RENAME == change the BASIC program's name for a later SAVE */
- if (line_is_eol (l))
- {
- /* RENAME */
- if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74))
- {
- /* prompt for the program name */
- char *tbuf;
- int tlen;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- bwx_input ("RENAME PROBLEM NAME:", FALSE, tbuf, tlen);
- if (is_empty_string (tbuf))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = bwb_strdup (tbuf);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else
- {
- /* RENAME value$ */
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (is_empty_string (Value))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = Value;
- }
- return (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- MAT
- --------------------------------------------------------------------------------------------
- */
-
- extern void
- Determinant (VariableType * v)
- {
- /* http://easy-learn-c-language.blogspot.com/search/label/Numerical%20Methods */
- /* Numerical Methods: Determinant of nxn matrix using C */
-
- DoubleType **matrix;
- DoubleType ratio;
-
- int i;
- int j;
- int k;
- int n;
-
- assert (v != NULL);
- assert( My != NULL );
-
-
- My->LastDeterminant = 0; /* default */
-
- n = v->UBOUND[0] - v->LBOUND[0] + 1;
-
- if ((matrix = (DoubleType **) calloc (n, sizeof (DoubleType *))) == NULL)
- {
- goto EXIT;
- }
- assert( matrix != NULL );
- for (i = 0; i < n; i++)
- {
- if ((matrix[i] = (DoubleType *) calloc (n, sizeof (DoubleType))) == NULL)
- {
- goto EXIT;
- }
- assert( matrix[i] != NULL );
- }
-
- for (i = 0; i < n; i++)
- {
- for (j = 0; j < n; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
- v->VINDEX[0] = v->LBOUND[0] + i;
- v->VINDEX[1] = v->LBOUND[1] + j;
- if (var_get (v, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- if (variant.VariantTypeCode == StringTypeCode)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- matrix[i][j] = variant.Number;
- }
- }
-
- /* Conversion of matrix to upper triangular */
-
- for (i = 0; i < n; i++)
- {
- for (j = 0; j < n; j++)
- {
- if (j > i)
- {
- if (matrix[i][i] == 0)
- {
- /* - Evaluation of an expression results in division
- * by zero (nonfatal, the recommended recovery
- * procedure is to supply machine infinity with the
- * sign of the numerator and continue)
- */
- if (WARN_DIVISION_BY_ZERO)
- {
- /* ERROR */
- goto EXIT;
- }
- /* CONTINUE */
- if (matrix[j][i] < 0)
- {
- ratio = MINDBL;
- }
- else
- {
- ratio = MAXDBL;
- }
- }
- else
- {
- ratio = matrix[j][i] / matrix[i][i];
- }
- for (k = 0; k < n; k++)
- {
- matrix[j][k] -= ratio * matrix[i][k];
- }
- }
- }
- }
-
-
- My->LastDeterminant = 1; /* storage for determinant */
-
- for (i = 0; i < n; i++)
- {
- DoubleType Value;
-
- Value = matrix[i][i];
- My->LastDeterminant *= Value;
- }
-
- EXIT:
- if( matrix != NULL )
- {
- for (i = 0; i < n; i++)
- {
- if( matrix[i] != NULL )
- {
- free (matrix[i]);
- /* matrix[i] = NULL; */
- }
- }
- free (matrix);
- /* matrix = NULL; */
- }
- }
-
- int
- InvertMatrix (VariableType * vOut, VariableType * vIn)
- {
- /* http://easy-learn-c-language.blogspot.com/search/label/Numerical%20Methods */
- /* Numerical Methods: Inverse of nxn matrix using C */
-
- int Result;
- DoubleType **matrix;
- DoubleType ratio;
-
- int i;
- int j;
- int k;
- int n;
-
- assert (vOut != NULL);
- assert (vIn != NULL);
-
- Result = FALSE;
- n = vIn->UBOUND[0] - vIn->LBOUND[0] + 1;
-
- if ((matrix = (DoubleType **) calloc (n, sizeof (DoubleType *))) == NULL)
- {
- goto EXIT;
- }
- assert( matrix != NULL );
-
- for (i = 0; i < n; i++)
- {
- if ((matrix[i] =
- (DoubleType *) calloc (n + n, sizeof (DoubleType))) == NULL)
- {
- goto EXIT;
- }
- assert( matrix[i] != NULL );
- }
-
- for (i = 0; i < n; i++)
- {
- for (j = 0; j < n; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- vIn->VINDEX[0] = vIn->LBOUND[0] + i;
- vIn->VINDEX[1] = vIn->LBOUND[1] + j;
- if (var_get (vIn, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- if (variant.VariantTypeCode == StringTypeCode)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- matrix[i][j] = variant.Number;
- }
- }
-
- for (i = 0; i < n; i++)
- {
- for (j = n; j < 2 * n; j++)
- {
- if (i == (j - n))
- {
- matrix[i][j] = 1.0;
- }
- else
- {
- matrix[i][j] = 0.0;
- }
- }
- }
-
- for (i = 0; i < n; i++)
- {
- for (j = 0; j < n; j++)
- {
- if (i != j)
- {
- if (matrix[i][i] == 0)
- {
- /* - Evaluation of an expression results in division
- * by zero (nonfatal, the recommended recovery
- * procedure is to supply machine infinity with the
- * sign of the numerator and continue)
- */
- if (WARN_DIVISION_BY_ZERO)
- {
- /* ERROR */
- goto EXIT;
- }
- /* CONTINUE */
- if (matrix[j][i] < 0)
- {
- ratio = MINDBL;
- }
- else
- {
- ratio = MAXDBL;
- }
- }
- else
- {
- ratio = matrix[j][i] / matrix[i][i];
- }
- for (k = 0; k < 2 * n; k++)
- {
- matrix[j][k] -= ratio * matrix[i][k];
- }
- }
- }
- }
-
- for (i = 0; i < n; i++)
- {
- DoubleType a;
-
- a = matrix[i][i];
- if (a == 0)
- {
- /* - Evaluation of an expression results in division
- * by zero (nonfatal, the recommended recovery
- * procedure is to supply machine infinity with the
- * sign of the numerator and continue)
- */
- if (WARN_DIVISION_BY_ZERO)
- {
- /* ERROR */
- goto EXIT;
- }
- /* CONTINUE */
- for (j = 0; j < 2 * n; j++)
- {
- if (matrix[i][j] < 0)
- {
- matrix[i][j] = MINDBL;
- }
- else
- {
- matrix[i][j] = MAXDBL;
- }
- }
- }
- else
- {
- for (j = 0; j < 2 * n; j++)
- {
- matrix[i][j] /= a;
- }
- }
- }
-
- for (i = 0; i < n; i++)
- {
- for (j = 0; j < n; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- vOut->VINDEX[0] = vOut->LBOUND[0] + i;
- vOut->VINDEX[1] = vOut->LBOUND[0] + j;
- variant.VariantTypeCode = vOut->VariableTypeCode;
- variant.Number = matrix[i][j + n];
- if (var_set (vOut, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- goto EXIT;
- }
- }
- }
- /*
- **
- ** Everything is OK
- **
- */
- Result = TRUE;
-
-
- EXIT:
- if (matrix != NULL)
- {
- for (i = 0; i < n; i++)
- {
- if (matrix[i] != NULL)
- {
- free (matrix[i]);
- /* matrix[i] = NULL; */
- }
- }
- free (matrix);
- /* matrix = NULL; */
- }
- return Result;
- }
-
- static int
- line_read_matrix_redim (LineType * l, VariableType * v)
- {
- /* get OPTIONAL parameters if the variable is dimensioned */
-
- assert (l != NULL);
- assert (v != NULL);
-
- if (line_peek_LparenChar (l))
- {
- /* get requested size, which is <= original array size */
- size_t array_units;
- int n;
- int dimensions;
- int LBOUND[MAX_DIMS];
- int UBOUND[MAX_DIMS];
-
- if (line_read_array_redim (l, &dimensions, LBOUND, UBOUND) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return FALSE;
- }
- /* update array dimensions */
- array_units = 1;
- for (n = 0; n < dimensions; n++)
- {
- if (UBOUND[n] < LBOUND[n])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return FALSE;
- }
- array_units *= UBOUND[n] - LBOUND[n] + 1;
- }
- if (array_units > v->array_units)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return FALSE;
- }
- v->dimensions = dimensions;
- for (n = 0; n < dimensions; n++)
- {
- v->LBOUND[n] = LBOUND[n];
- v->UBOUND[n] = UBOUND[n];
- }
- }
- return TRUE;
- }
-
- LineType *
- bwb_MAT (LineType * l)
- {
- /*
- SYNTAX: MAT A = CON
- SYNTAX: MAT A = IDN
- SYNTAX: MAT A = ZER
- SYNTAX: MAT A = INV B
- SYNTAX: MAT A = TRN B
- SYNTAX: MAT A = (k) * B
- SYNTAX: MAT A = B
- SYNTAX: MAT A = B + C
- SYNTAX: MAT A = B - C
- SYNTAX: MAT A = B * C
- */
- VariableType *v_A;
- char varname_A[NameLengthMax + 1];
-
- assert (l != NULL);
-
- /* just a placeholder for now. this will grow. */
-
- if (line_read_varname (l, varname_A) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- v_A = mat_find (varname_A);
- if (v_A == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_A))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v_A) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_skip_EqualChar (l) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* MAT A = ... */
- if (line_skip_word (l, "CON"))
- {
- /* MAT A = CON */
- /* MAT A = CON(I) */
- /* MAT A = CON(I,J) */
- /* MAT A = CON(I,J,K) */
- /* OK */
- int i;
- int j;
- int k;
-
- if (line_read_matrix_redim (l, v_A) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /* both arrays are of the same size */
- switch (v_A->dimensions)
- {
- case 1:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = v_A->VariableTypeCode;
- variant.Number = 1;
- v_A->VINDEX[0] = i;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- break;
- case 2:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = v_A->VariableTypeCode;
- variant.Number = 1;
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- break;
- case 3:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = v_A->VariableTypeCode;
- variant.Number = 1;
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- v_A->VINDEX[2] = k;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- break;
- default:
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else if (line_skip_word (l, "IDN"))
- {
- /* MAT A = IDN */
- /* MAT A = IDN(I,J) */
- /* OK */
- int i;
- int j;
-
- if (line_read_matrix_redim (l, v_A) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if (v_A->dimensions != 2)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_A->LBOUND[0] != v_A->LBOUND[1])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_A->UBOUND[0] != v_A->UBOUND[1])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- /* square matrix */
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = v_A->VariableTypeCode;
- if (i == j)
- {
- variant.Number = 1;
- }
- else
- {
- variant.Number = 0;
- }
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- else if (line_skip_word (l, "ZER"))
- {
- /* MAT A = ZER */
- /* MAT A = ZER(I) */
- /* MAT A = ZER(I,J) */
- /* MAT A = ZER(I,J,K) */
- /* OK */
- int i;
- int j;
- int k;
-
- if (line_read_matrix_redim (l, v_A) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* both arrays are of the same size */
- switch (v_A->dimensions)
- {
- case 1:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = v_A->VariableTypeCode;
- variant.Number = 0;
- v_A->VINDEX[0] = i;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- break;
- case 2:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = v_A->VariableTypeCode;
- variant.Number = 0;
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- break;
- case 3:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = v_A->VariableTypeCode;
- variant.Number = 0;
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- v_A->VINDEX[2] = k;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- break;
- default:
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else if (line_skip_word (l, "INV"))
- {
- /* MAT A = INV B */
- /* MAT A = INV( B ) */
- /* OK */
- VariableType *v_B;
- char varname_B[NameLengthMax + 1];
-
- if (v_A->dimensions != 2)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v_A->LBOUND[0] != v_A->LBOUND[1] || v_A->UBOUND[0] != v_A->UBOUND[1])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (line_skip_LparenChar (l))
- {
- /* optional */
- }
- if (line_read_varname (l, varname_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if ((v_B = mat_find (varname_B)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_B))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_skip_RparenChar (l))
- {
- /* optional */
- }
- if (v_B->dimensions != 2)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v_B->LBOUND[0] != v_B->LBOUND[1] || v_B->UBOUND[0] != v_B->UBOUND[1])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_A->LBOUND[0] != v_B->LBOUND[0] || v_A->UBOUND[0] != v_B->UBOUND[0])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- /* square matrix */
- Determinant (v_B);
- if (My->LastDeterminant == 0)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- if (InvertMatrix (v_A, v_B) == FALSE)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- }
- else if (line_skip_word (l, "TRN"))
- {
- /* MAT A = TRN B */
- /* MAT A = TRN( B ) */
- /* OK */
- int i;
- int j;
- VariableType *v_B;
- char varname_B[NameLengthMax + 1];
-
- if (v_A->dimensions != 2)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_skip_LparenChar (l))
- {
- /* optional */
- }
- if (line_read_varname (l, varname_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if ((v_B = mat_find (varname_B)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_B))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_skip_RparenChar (l))
- {
- /* optional */
- }
- if (v_B->dimensions != 2)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* MxN */
- if (v_A->LBOUND[0] != v_B->LBOUND[1] || v_A->UBOUND[0] != v_B->UBOUND[1])
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v_A->LBOUND[1] != v_B->LBOUND[0] || v_A->UBOUND[1] != v_B->UBOUND[0])
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* transpose matrix */
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- v_B->VINDEX[1] = i;
- v_B->VINDEX[0] = j;
- if (var_get (v_B, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- else if (line_peek_LparenChar (l))
- {
- /* MAT A = (k) * B */
- DoubleType Multiplier;
- VariableType *v_B;
- int i;
- int j;
- int k;
- char *E;
- int p;
- char varname_B[NameLengthMax + 1];
- char *tbuf;
-
- tbuf = My->ConsoleInput;
- bwb_strcpy (tbuf, &(l->buffer[l->position]));
- E = bwb_strrchr (tbuf, '*');
- if (E == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- *E = NulChar;
- p = 0;
- if (buff_read_numeric_expression (tbuf, &p, &Multiplier) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- l->position += p;
- if (line_skip_StarChar (l) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_varname (l, varname_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if ((v_B = mat_find (varname_B)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_B))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v_A->dimensions != v_B->dimensions)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* both arrays are of the same size */
- switch (v_A->dimensions)
- {
- case 1:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- v_B->VINDEX[0] = i;
- if (var_get (v_B, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant.Number *= Multiplier;
-
- v_A->VINDEX[0] = i;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- break;
- case 2:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- if (var_get (v_B, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant.Number *= Multiplier;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- break;
- case 3:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- v_B->VINDEX[2] = k;
- if (var_get (v_B, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant.Number *= Multiplier;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- v_A->VINDEX[2] = k;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- break;
- default:
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else
- {
- /* MAT A = B */
- /* MAT A = B + C */
- /* MAT A = B - C */
- /* MAT A = B * C */
- VariableType *v_B;
- char varname_B[NameLengthMax + 1];
-
- if (line_read_varname (l, varname_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if ((v_B = mat_find (varname_B)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_B))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v_B) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_is_eol (l))
- {
- /* MAT A = B */
- /* OK */
- int i;
- int j;
- int k;
-
- if (v_A->dimensions != v_B->dimensions)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* both arrays are of the same size */
- switch (v_A->dimensions)
- {
- case 1:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- v_B->VINDEX[0] = i;
- if (var_get (v_B, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_A->VINDEX[0] = i;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- break;
- case 2:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- if (var_get (v_B, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- break;
- case 3:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- v_B->VINDEX[2] = k;
- if (var_get (v_B, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- v_A->VINDEX[2] = k;
- if (var_set (v_A, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- break;
- default:
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else if (line_skip_PlusChar (l))
- {
- /* MAT A = B + C */
- /* OK */
- int i;
- int j;
- int k;
- VariableType *v_C;
- char varname_C[NameLengthMax + 1];
-
- if (v_A->dimensions != v_B->dimensions)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* both arrays are of the same size */
-
- if (line_read_varname (l, varname_C) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if ((v_C = mat_find (varname_C)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_C))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v_C) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v_B->dimensions != v_C->dimensions)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* both arrays are of the same size */
- switch (v_A->dimensions)
- {
- case 1:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- VariantType variant_L;
- VariantType variant_R;
- CLEAR_VARIANT (&variant_L);
- CLEAR_VARIANT (&variant_R);
-
- v_B->VINDEX[0] = i;
- if (var_get (v_B, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_C->VINDEX[0] = i;
- if (var_get (v_C, &variant_R) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant_L.Number += variant_R.Number;
-
- v_A->VINDEX[0] = i;
- if (var_set (v_A, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- break;
- case 2:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant_L;
- VariantType variant_R;
- CLEAR_VARIANT (&variant_L);
- CLEAR_VARIANT (&variant_R);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- if (var_get (v_B, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_C->VINDEX[0] = i;
- v_C->VINDEX[1] = j;
- if (var_get (v_C, &variant_R) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant_L.Number += variant_R.Number;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- break;
- case 3:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
- {
- VariantType variant_L;
- VariantType variant_R;
- CLEAR_VARIANT (&variant_L);
- CLEAR_VARIANT (&variant_R);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- v_B->VINDEX[2] = k;
- if (var_get (v_B, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_C->VINDEX[0] = i;
- v_C->VINDEX[1] = j;
- v_C->VINDEX[2] = k;
- if (var_get (v_C, &variant_R) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant_L.Number += variant_R.Number;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- v_A->VINDEX[2] = k;
- if (var_set (v_A, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- break;
- default:
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else if (line_skip_MinusChar (l))
- {
- /* MAT A = B - C */
- /* OK */
- int i;
- int j;
- int k;
- VariableType *v_C;
- char varname_C[NameLengthMax + 1];
-
- if (v_A->dimensions != v_B->dimensions)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* both arrays are of the same size */
-
- if (line_read_varname (l, varname_C) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if ((v_C = mat_find (varname_C)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_C))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v_C) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v_B->dimensions != v_C->dimensions)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* both arrays are of the same dimension */
- switch (v_A->dimensions)
- {
- case 1:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- VariantType variant_L;
- VariantType variant_R;
- CLEAR_VARIANT (&variant_L);
- CLEAR_VARIANT (&variant_R);
-
- v_B->VINDEX[0] = i;
- if (var_get (v_B, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_C->VINDEX[0] = i;
- if (var_get (v_C, &variant_R) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant_L.Number -= variant_R.Number;
-
- v_A->VINDEX[0] = i;
- if (var_set (v_A, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- break;
- case 2:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant_L;
- VariantType variant_R;
- CLEAR_VARIANT (&variant_L);
- CLEAR_VARIANT (&variant_R);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- if (var_get (v_B, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_C->VINDEX[0] = i;
- v_C->VINDEX[1] = j;
- if (var_get (v_C, &variant_R) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant_L.Number -= variant_R.Number;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- break;
- case 3:
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- for (k = v_A->LBOUND[2]; k <= v_A->UBOUND[2]; k++)
- {
- VariantType variant_L;
- VariantType variant_R;
- CLEAR_VARIANT (&variant_L);
- CLEAR_VARIANT (&variant_R);
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = j;
- v_B->VINDEX[2] = k;
- if (var_get (v_B, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_C->VINDEX[0] = i;
- v_C->VINDEX[1] = j;
- v_C->VINDEX[2] = k;
- if (var_get (v_C, &variant_R) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant_L.Number -= variant_R.Number;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- v_A->VINDEX[2] = k;
- if (var_set (v_A, &variant_L) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- break;
- default:
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- else if (line_skip_StarChar (l))
- {
- /* MAT A = B * C */
- int i;
- int j;
- int k;
- VariableType *v_C;
- char varname_C[NameLengthMax + 1];
-
-
- if (v_A->dimensions != 2)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_B->dimensions != 2)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (line_read_varname (l, varname_C) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if ((v_C = mat_find (varname_C)) == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v_C))
- {
- WARN_TYPE_MISMATCH;
- return (l);
- }
- if (line_read_matrix_redim (l, v_C) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v_C->dimensions != 2)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_A->LBOUND[0] != v_B->LBOUND[0])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_A->UBOUND[0] != v_B->UBOUND[0])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_A->LBOUND[1] != v_C->LBOUND[1])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_A->UBOUND[1] != v_C->UBOUND[1])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_B->LBOUND[1] != v_C->LBOUND[0])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (v_B->UBOUND[1] != v_C->UBOUND[0])
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- for (i = v_A->LBOUND[0]; i <= v_A->UBOUND[0]; i++)
- {
- for (j = v_A->LBOUND[1]; j <= v_A->UBOUND[1]; j++)
- {
- VariantType variant_A;
- CLEAR_VARIANT (&variant_A);
-
- variant_A.VariantTypeCode = v_A->VariableTypeCode;
- variant_A.Number = 0;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant_A) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- for (k = v_C->LBOUND[0]; k <= v_C->UBOUND[0]; k++)
- {
- VariantType variant_B;
- VariantType variant_C;
- CLEAR_VARIANT (&variant_B);
- CLEAR_VARIANT (&variant_C);
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_get (v_A, &variant_A) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_B->VINDEX[0] = i;
- v_B->VINDEX[1] = k;
- if (var_get (v_B, &variant_B) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- v_C->VINDEX[0] = k;
- v_C->VINDEX[1] = j;
- if (var_get (v_C, &variant_C) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- variant_A.Number += variant_B.Number * variant_C.Number;
-
- v_A->VINDEX[0] = i;
- v_A->VINDEX[1] = j;
- if (var_set (v_A, &variant_A) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- }
- }
- }
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- return (l);
- }
-
-
-
- /*
- --------------------------------------------------------------------------------------------
- STORE
- --------------------------------------------------------------------------------------------
- */
-
-
- LineType *
- bwb_STORE (LineType * l)
- {
- /*
- SYNTAX: STORE NumericArrayName
- */
-
- assert (l != NULL);
- return bwb_CSAVE8 (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- CSAVE*
- --------------------------------------------------------------------------------------------
- */
-
- #define CSAVE_VERSION_1 0x20150218L
-
- LineType *
- bwb_CSAVE8 (LineType * l)
- {
- /*
- SYNTAX: CSAVE* NumericArrayName
- */
- VariableType *v = NULL;
- FILE *f;
- unsigned long n;
- size_t t;
- char varname[NameLengthMax + 1];
-
- assert (l != NULL);
-
- if (line_read_varname (l, varname) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- v = mat_find (varname);
- if (v == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* variable MUST be an array */
- if (v->dimensions == 0)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* variable storage is a mess, we bypass that tradition here. */
- t = v->array_units;
- if (t <= 1)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* open file */
- f = fopen (v->name, "w");
- if (f == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* write version number */
- n = CSAVE_VERSION_1;
- fwrite (&n, sizeof (long), 1, f);
- /* write total number of elements */
- fwrite (&t, sizeof (long), 1, f);
- /* write data */
- fwrite (v->Value.Number, sizeof (DoubleType), t, f);
- /* OK */
- bwb_fclose (f);
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- RECALL
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_RECALL (LineType * l)
- {
- /*
- SYNTAX: RECALL NumericArrayName
- */
-
- assert (l != NULL);
- return bwb_CLOAD8 (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CLOAD*
- --------------------------------------------------------------------------------------------
- */
-
-
- LineType *
- bwb_CLOAD8 (LineType * l)
- {
- /*
- SYNTAX: CLOAD* NumericArrayName
- */
- VariableType *v = NULL;
- FILE *f;
- unsigned long n;
- size_t t;
- char varname[NameLengthMax + 1];
-
- assert (l != NULL);
-
- if (line_read_varname (l, varname) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- v = mat_find (varname);
- if (v == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- /* variable MUST be numeric */
- if (VAR_IS_STRING (v))
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* variable MUST be an array */
- if (v->dimensions == 0)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_matrix_redim (l, v) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* variable storage is a mess, we bypass that tradition here. */
- t = v->array_units;
- if (t <= 1)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* open file */
- f = fopen (v->name, "r");
- if (f == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- /* read version number */
- n = 0;
- fread (&n, sizeof (long), 1, f);
- if (n != CSAVE_VERSION_1)
- {
- bwb_fclose (f);
- WARN_BAD_FILE_NAME;
- return (l);
- }
- /* read total number of elements */
- n = 0;
- fread (&n, sizeof (long), 1, f);
- if (n != t)
- {
- bwb_fclose (f);
- WARN_BAD_FILE_NAME;
- return (l);
- }
- /* read data */
- fread (v->Value.Number, sizeof (DoubleType), t, f);
- /* OK */
- bwb_fclose (f);
- return (l);
- }
-
-
-
-
- /*
- ============================================================================================
- SAVE and so on
- ============================================================================================
- */
-
- static LineType *
- bwb_save (LineType * Line, char *Prompt)
- {
- /*
- SYNTAX: SAVE [filename$]
- */
- FILE *outfile;
-
- assert (Line != NULL);
- assert (Prompt != NULL);
- assert( My != NULL );
- assert( My->ConsoleInput != NULL );
- assert( My->SYSOUT != NULL );
- assert( My->SYSOUT->cfp != NULL );
-
-
- /* Get an argument for filename */
- if (line_is_eol (Line))
- {
- /* default is the last filename used by LOAD or SAVE */
- if (is_empty_string (My->ProgramFilename) && Prompt != NULL)
- {
- /* prompt for the program name */
- char *tbuf;
- int tlen;
-
- tbuf = My->ConsoleInput;
- tlen = MAX_LINE_LENGTH;
- bwx_input (Prompt, FALSE, tbuf, tlen);
- if (is_empty_string (tbuf))
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = bwb_strdup (tbuf);
- }
- assert( My->ProgramFilename != NULL );
- fprintf (My->SYSOUT->cfp, "Saving %s\n", My->ProgramFilename);
- ResetConsoleColumn ();
- }
- else
- {
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (Line, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (Line);
- }
- if (is_empty_string (Value))
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- }
- My->ProgramFilename = Value;
- }
- assert( My->ProgramFilename != NULL );
- if ((outfile = fopen (My->ProgramFilename, "w")) == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (Line);
- }
- bwb_xlist (Line, outfile);
- bwb_fclose (outfile);
- return (Line);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CSAVE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_CSAVE (LineType * Line)
- {
- /*
- SYNTAX: CSAVE [filename$]
- */
-
- assert (Line != NULL);
- return bwb_save (Line, "CSAVE FILE NAME:");
- }
-
- /*
- --------------------------------------------------------------------------------------------
- REPLACE
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_REPLACE (LineType * Line)
- {
- /*
- SYNTAX: REPLACE [filename$]
- */
-
- assert (Line != NULL);
- return bwb_save (Line, "REPLACE FILE NAME:");
- }
-
- /*
- --------------------------------------------------------------------------------------------
- SAVE
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_SAVE (LineType * l)
- {
- /*
- SYNTAX: SAVE [filename$]
- */
-
- assert (l != NULL);
- return bwb_save (l, "SAVE FILE NAME:");
- }
-
- /*
- --------------------------------------------------------------------------------------------
- TSAVE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_TSAVE (LineType * Line)
- {
- /*
- SYNTAX: TSAVE [filename$]
- */
-
- assert (Line != NULL);
- return bwb_save (Line, "TSAVE FILE NAME:");
- }
-
-
- /*
- ============================================================================================
- LIST and so on
- ============================================================================================
- */
- static int
- xl_line (FILE * file, LineType * l)
- {
- char LineExecuted;
- char *C; /* start of comment text */
- char *buffer; /* 0...99999 */
-
- assert (file != NULL);
- assert (l != NULL);
- assert( My != NULL );
- assert( My->NumLenBuffer != NULL );
- assert( My->CurrentVersion != NULL );
- assert( My->SYSOUT != NULL );
- assert( My->SYSOUT->cfp != NULL );
- assert( My->SYSPRN != NULL );
- assert( My->SYSPRN->cfp != NULL );
-
- /*
- ** The only difference between LIST, LLIST and SAVE is:
- ** LIST and LLIST display an '*'
- ** when a line has been executed
- ** and OPTION COVERAGE ON is enabled.
- */
-
- buffer = My->NumLenBuffer;
- LineExecuted = ' ';
- if (My->CurrentVersion->OptionFlags & (OPTION_COVERAGE_ON))
- {
- if (l->LineFlags & LINE_EXECUTED)
- {
- if (file == My->SYSOUT->cfp || file == My->SYSPRN->cfp)
- {
- /* LIST */
- /* LLIST */
- LineExecuted = '*';
- }
- else
- {
- /* SAVE */
- /* EDIT implies SAVE */
- }
- }
- }
-
- C = l->buffer;
- if (l->LineFlags & LINE_NUMBERED)
- {
- /* explicitly numbered */
- sprintf (buffer, "%*d", LineNumberDigits, l->number);
- /* ##### xxx */
- }
- else
- {
- /* implicitly numbered */
- if (My->LastLineNumber == l->number)
- {
- /* multi-statement line */
- if (l->cmdnum == C_REM
- && IS_CHAR (l->buffer[0], My->CurrentVersion->OptionCommentChar))
- {
- /* trailing comment */
- sprintf (buffer, "%*s%c", LineNumberDigits - 1, "",
- My->CurrentVersion->OptionCommentChar);
- C++; /* skip comment char */
- while (*C == ' ')
- {
- /* skip spaces */
- C++;
- }
- /* ____' xxx */
- }
- else if (My->CurrentVersion->OptionStatementChar)
- {
- /* all other commands, add a colon */
- sprintf (buffer, "%*s%c", LineNumberDigits - 1, "",
- My->CurrentVersion->OptionStatementChar);
- /* ____: xxx */
- }
- else
- {
- /*
- The user is trying to list a multi-line statement
- in a dialect that does NOT support multi-line statements.
- This could occur when LOADing in one dialect and then SAVEing as another dialect, such as:
- OPTION VERSION BASIC-80
- LOAD "TEST1.BAS"
- 100 REM TEST
- 110 PRINT:PRINT:PRINT
- OPTION VERSION MARK-I
- EDIT
- 100 REM TEST
- 110 PRINT
- PRINT
- PRINT
- The only thing we can reasonably do is put spaces for the line number,
- since the user will have to edit the results manually anyways.
- */
- sprintf (buffer, "%*s", LineNumberDigits, "");
- /* _____ xxx */
- }
- }
- else
- {
- /* single-statement line */
- sprintf (buffer, "%*s", LineNumberDigits, "");
- /* _____ xxx */
- }
- }
-
- fprintf (file, "%s", buffer);
- fprintf (file, "%c", LineExecuted);
-
- /* if( TRUE ) */
- {
- /* %INCLUDE */
- int i;
- for (i = 0; i < l->IncludeLevel; i++)
- {
- fputc (' ', file);
- }
- }
- if (My->OptionIndentInteger > 0)
- {
- int i;
-
- for (i = 0; i < l->Indention; i++)
- {
- int j;
- for (j = 0; j < My->OptionIndentInteger; j++)
- {
- fputc (' ', file);
- }
- }
- }
- fprintf (file, "%s\n", C);
-
- My->LastLineNumber = l->number;
-
- return TRUE;
- }
-
- static LineType *
- bwb_xlist (LineType * l, FILE * file)
- {
-
- assert (l != NULL);
- assert (file != NULL);
- assert( My != NULL );
- assert( My->StartMarker != NULL );
- assert( My->EndMarker != NULL );
-
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- /*
- **
- ** we are used by bwb_SAVE and bwb_EDIT
- **
- WARN_CANT_CONTINUE;
- return (l);
- */
- }
-
- if (line_is_eol (l))
- {
- /* LIST */
- LineType *x;
- /* now go through and list appropriate lines */
- My->LastLineNumber = -1;
- for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
- {
- xl_line (file, x);
- }
- fprintf (file, "\n");
- }
- else
- {
- do
- {
- int head;
- int tail;
-
- if (line_read_line_sequence (l, &head, &tail))
- {
- /* LIST 's' - 'e' */
- LineType *x;
- if (head < MINLIN || head > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- if (tail < MINLIN || tail > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- if (head > tail)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- /* valid range */
- /* now go through and list appropriate lines */
- My->LastLineNumber = -1;
- for (x = My->StartMarker->next; x != My->EndMarker; x = x->next)
- {
- if (head <= x->number && x->number <= tail)
- {
- xl_line (file, x);
- }
- }
- fprintf (file, "\n");
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- while (line_skip_seperator (l));
- }
- if (file == My->SYSOUT->cfp)
- {
- ResetConsoleColumn ();
- }
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- LIST
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_LIST (LineType * l)
- {
- /*
- SYNTAX: LIST
- SYNTAX: LIST line [,...]
- SYNTAX: LIST line - line
- */
-
- assert (l != NULL);
-
- return bwb_xlist (l, My->SYSOUT->cfp);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- LISTNH
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_LISTNH (LineType * l)
- {
- /*
- SYNTAX: LISTNH
- SYNTAX: LISTNH line [,...]
- SYNTAX: LISTNH line - line
- */
-
- assert (l != NULL);
-
- return bwb_xlist (l, My->SYSOUT->cfp);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- LLIST
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_LLIST (LineType * l)
- {
- /*
- SYNTAX: LLIST
- SYNTAX: LLIST line [,...]
- SYNTAX: LLIST line - line
- */
-
- assert (l != NULL);
-
- return bwb_xlist (l, My->SYSPRN->cfp);
- }
-
-
-
- /*
- ============================================================================================
- DELETE and so on
- ============================================================================================
- */
-
- static LineType *
- bwb_delete (LineType * l)
- {
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->CurrentVersion != NULL );
- assert( My->StartMarker != NULL );
- assert( My->EndMarker != NULL );
-
- if (line_is_eol (l))
- {
- /* DELETE */
- WARN_SYNTAX_ERROR;
- return (l);
- }
- else if (My->CurrentVersion->OptionVersionValue & (C77))
- {
- /*
- SYNTAX: DELETE filenum [,...]
- */
- do
- {
- int FileNumber;
-
- FileNumber = 0;
- if (line_read_integer_expression (l, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (FileNumber <= 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
-
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (My->CurrentFile->DevMode == DEVMODE_CLOSED)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (My->CurrentFile->cfp != NULL)
- {
- bwb_fclose (My->CurrentFile->cfp);
- My->CurrentFile->cfp = NULL;
- }
- if (My->CurrentFile->buffer != NULL)
- {
- free (My->CurrentFile->buffer);
- My->CurrentFile->buffer = NULL;
- }
- My->CurrentFile->width = 0;
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- My->CurrentFile->DevMode = DEVMODE_CLOSED;
- if (My->CurrentFile->FileName == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- remove (My->CurrentFile->FileName);
- free (My->CurrentFile->FileName);
- My->CurrentFile->FileName = NULL;
- }
- while (line_skip_seperator (l));
- /* OK */
- return (l);
- }
- else
- {
- /*
- SYNTAX: DELETE line [,...]
- SYNTAX: DELETE line - line
- */
-
- do
- {
- int head;
- int tail;
-
- if (line_read_line_sequence (l, &head, &tail))
- {
- /* DELETE 's' - 'e' */
- LineType *x;
- LineType *previous;
- if (head < MINLIN || head > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- if (tail < MINLIN || tail > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- if (head > tail)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- /* valid range */
-
- /* avoid deleting ourself */
-
- if (l->LineFlags & (LINE_USER))
- {
- /* console line (immediate mode) */
- }
- else if (head <= l->number && l->number <= tail)
- {
- /* 100 DELETE 100 */
- WARN_CANT_CONTINUE;
- return (l);
- }
- /* now go through and list appropriate lines */
- previous = My->StartMarker;
- for (x = My->StartMarker->next; x != My->EndMarker;)
- {
- LineType *next;
-
- next = x->next;
- if (x->number < head)
- {
- previous = x;
- }
- else if (head <= x->number && x->number <= tail)
- {
- if (x == l)
- {
- /* 100 DELETE 100 */
- WARN_CANT_CONTINUE;
- return (l);
- }
- bwb_freeline (x);
- previous->next = next;
- }
- x = next;
- }
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- }
- while (line_skip_seperator (l));
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- WARN_CANT_CONTINUE;
- return (l);
- }
- }
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- DELETE
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_DELETE (LineType * l)
- {
-
- assert (l != NULL);
-
- return bwb_delete (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- PDEL
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_PDEL (LineType * l)
- {
-
- assert (l != NULL);
-
- return bwb_delete (l);
- }
-
- #if FALSE /* keep the source to DONUM and DOUNNUM */
-
- /*
- --------------------------------------------------------------------------------------------
- DONUM
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_donum (LineType * l)
- {
- /*
- SYNTAX: DONUM
- */
- LineType *current;
- int lnumber;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->StartMarker != NULL );
- assert( My->EndMarker != NULL );
-
- lnumber = 10;
- for (current = My->StartMarker->next; current != My->EndMarker;
- current = current->next)
- {
- current->number = lnumber;
-
- lnumber += 10;
- if (lnumber > MAXLIN)
- {
- return (l);
- }
- }
-
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- DOUNUM
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_dounnum (LineType * l)
- {
- /*
- SYNTAX: DOUNNUM
- */
- LineType *current;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->StartMarker != NULL );
- assert( My->EndMarker != NULL );
-
- for (current = My->StartMarker->next; current != My->EndMarker;
- current = current->next)
- {
- current->number = 0;
- }
-
- return (l);
- }
-
- #endif /* FALSE */
-
-
-
- /*
- --------------------------------------------------------------------------------------------
- FILES
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_FILES (LineType * l)
- {
- /*
- SYNTAX: FILES A$ [, ...]
- */
- /* open a list of files in READ mode */
-
- assert (l != NULL);
- assert( My != NULL );
-
- do
- {
- int FileNumber;
-
- FileNumber = My->LastFileNumber;
- FileNumber++;
- if (FileNumber < 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (FileNumber == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- My->CurrentFile = file_new ();
- My->CurrentFile->FileNumber = FileNumber;
- }
- {
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (Value == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (My->CurrentFile->FileName != NULL)
- {
- free (My->CurrentFile->FileName);
- My->CurrentFile->FileName = NULL;
- }
- My->CurrentFile->FileName = Value;
- Value = NULL;
- }
- if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
- {
- My->CurrentFile->DevMode = DEVMODE_CLOSED;
- }
- if (My->CurrentFile->cfp != NULL)
- {
- bwb_fclose (My->CurrentFile->cfp);
- My->CurrentFile->cfp = NULL;
- }
- if (My->CurrentFile->buffer != NULL)
- {
- free (My->CurrentFile->buffer);
- My->CurrentFile->buffer = NULL;
- }
- My->CurrentFile->width = 0;
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- if (is_empty_string (My->CurrentFile->FileName))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
- {
- if ((My->CurrentFile->cfp =
- fopen (My->CurrentFile->FileName, "r")) == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- My->CurrentFile->DevMode = DEVMODE_INPUT;
- }
- My->LastFileNumber = FileNumber;
- /* OK */
- }
- while (line_skip_seperator (l));
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- FILE
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_FILE (LineType * l)
- {
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->CurrentVersion != NULL );
-
- if (My->CurrentVersion->OptionVersionValue & (C77))
- {
- /*
- CBASIC-II:
- FILE file_name$ ' filename$ must be a simple string scalar (no arrays)
- FILE file_name$ ( record_length% ) ' filename$ must be a simple string scalar (no arrays)
- -- if the file exists,
- then it is used,
- else it is created.
- -- Does not trigger IF END #
- */
- do
- {
- int FileNumber;
- VariableType *v;
- char varname[NameLengthMax + 1];
-
- if (line_read_varname (l, varname) == FALSE)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (is_empty_string (varname))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- v = find_variable_by_type (varname, 0, StringTypeCode);
- if (v == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- if (VAR_IS_STRING (v))
- {
- /* OK */
- }
- else
- {
- WARN_TYPE_MISMATCH;
- return (l);
- }
-
- FileNumber = My->LastFileNumber;
- FileNumber++;
- if (FileNumber < 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (FileNumber == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- My->CurrentFile = file_new ();
- My->CurrentFile->FileNumber = FileNumber;
- }
- if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
- {
- My->CurrentFile->DevMode = DEVMODE_CLOSED;
- }
- if (My->CurrentFile->cfp != NULL)
- {
- bwb_fclose (My->CurrentFile->cfp);
- My->CurrentFile->cfp = NULL;
- }
- if (My->CurrentFile->buffer != NULL)
- {
- free (My->CurrentFile->buffer);
- My->CurrentFile->buffer = NULL;
- }
- My->CurrentFile->width = 0;
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- /* OK */
- if (line_skip_LparenChar (l))
- {
- /* RANDOM file */
- int RecLen;
-
- if (line_read_integer_expression (l, &RecLen) == FALSE)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- if (RecLen <= 0)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- if (line_skip_RparenChar (l) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if ((My->CurrentFile->buffer =
- (char *) calloc (RecLen + 1 /* NulChar */ ,
- sizeof (char))) == NULL)
- {
- WARN_OUT_OF_MEMORY;
- return (l);
- }
- My->CurrentFile->width = RecLen;
- }
-
- /* if( TRUE ) */
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- if (var_get (v, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- if (variant.VariantTypeCode == StringTypeCode)
- {
- if (My->CurrentFile->FileName != NULL)
- {
- free (My->CurrentFile->FileName);
- My->CurrentFile->FileName = NULL;
- }
- My->CurrentFile->FileName = variant.Buffer;
- variant.Buffer = NULL;
- }
- else
- {
- WARN_TYPE_MISMATCH;
- return (l);
- }
- }
- if (is_empty_string (My->CurrentFile->FileName))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "r+");
- if (My->CurrentFile->cfp == NULL)
- {
- My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "w");
- if (My->CurrentFile->cfp != NULL)
- {
- bwb_fclose (My->CurrentFile->cfp);
- My->CurrentFile->cfp = fopen (My->CurrentFile->FileName, "r+");
- }
- }
- if (My->CurrentFile->cfp == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (My->CurrentFile->width > 0)
- {
- /* RANDOM file */
- My->CurrentFile->DevMode = DEVMODE_RANDOM;
- }
- else
- {
- /* SERIAL file */
- My->CurrentFile->DevMode = DEVMODE_INPUT | DEVMODE_OUTPUT;
- }
- /* OK */
- My->LastFileNumber = FileNumber;
- }
- while (line_skip_seperator (l));
- /* OK */
- return (l);
- }
- if (line_skip_FilenumChar (l))
- {
- /*
- SYNTAX: FILE # X, A$
- */
- int FileNumber;
-
- if (line_read_integer_expression (l, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (line_skip_seperator (l))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (FileNumber < 0)
- {
- /* "FILE # -1" is an ERROR */
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (FileNumber == 0)
- {
- /* "FILE # 0" is an ERROR */
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- My->CurrentFile = file_new ();
- My->CurrentFile->FileNumber = FileNumber;
- }
- {
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (Value == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (My->CurrentFile->FileName != NULL)
- {
- free (My->CurrentFile->FileName);
- My->CurrentFile->FileName = NULL;
- }
- My->CurrentFile->FileName = Value;
- Value = NULL;
- }
- if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
- {
- My->CurrentFile->DevMode = DEVMODE_CLOSED;
- }
- if (My->CurrentFile->cfp != NULL)
- {
- bwb_fclose (My->CurrentFile->cfp);
- My->CurrentFile->cfp = NULL;
- }
- if (My->CurrentFile->buffer != NULL)
- {
- free (My->CurrentFile->buffer);
- My->CurrentFile->buffer = NULL;
- }
- My->CurrentFile->width = 0;
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- if (is_empty_string (My->CurrentFile->FileName))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (bwb_strcmp (My->CurrentFile->FileName, "*") != 0)
- {
- if ((My->CurrentFile->cfp =
- fopen (My->CurrentFile->FileName, "r")) == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- My->CurrentFile->DevMode = DEVMODE_INPUT;
- }
- /* OK */
- return (l);
- }
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- DELIMIT
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_DELIMIT (LineType * l)
- {
- /*
- SYNTAX: DELIMIT # X, A$
- */
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->SYSIN != NULL );
-
- if (line_skip_FilenumChar (l))
- {
- /* DELIMIT # */
- int FileNumber;
- char delimit;
-
- My->CurrentFile = My->SYSIN;
-
- if (line_read_integer_expression (l, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (line_skip_seperator (l))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- {
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (Value == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- delimit = Value[0];
- free (Value);
- Value = NULL;
- if (bwb_ispunct (delimit))
- {
- /* OK */
- }
- else
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- }
- if (FileNumber < 0)
- {
- /* "DELIMIT # -1" is SYSPRN */
- My->SYSPRN->delimit = delimit;
- return (l);
- }
- if (FileNumber == 0)
- {
- /* "DELIMIT # 0" is SYSOUT */
- My->SYSOUT->delimit = delimit;
- return (l);
- }
- /* normal file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- My->CurrentFile->delimit = delimit;
- /* OK */
- return (l);
- }
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- MARGIN
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_MARGIN (LineType * l)
- {
- /*
- SYNTAX: MARGIN # X, Y
- */
- /* set width for OUTPUT */
- int FileNumber;
- int Value;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->SYSIN != NULL );
-
- if (line_skip_FilenumChar (l))
- {
- /* MARGIN # */
- My->CurrentFile = My->SYSIN;
-
- if (line_read_integer_expression (l, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (line_skip_seperator (l))
- {
- /* OK */
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_integer_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (Value < 0)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- if (FileNumber < 0)
- {
- /* "MARGIN # -1" is SYSPRN */
- My->SYSPRN->width = Value;
- return (l);
- }
- if (FileNumber == 0)
- {
- /* "MARGIN # 0" is SYSOUT */
- My->SYSOUT->width = Value;
- return (l);
- }
- /* normal file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if ((My->CurrentFile->DevMode & DEVMODE_WRITE) == 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- My->CurrentFile->width = Value;
- /* OK */
- return (l);
- }
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- USE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_USE (LineType * l)
- {
- /*
- SYNTAX: USE parameter$ ' CALL/360, System/360, System/370
- */
- VariableType *v;
-
- assert (l != NULL);
- assert( My != NULL );
-
- if ((v = line_read_scalar (l)) == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (v->VariableTypeCode != StringTypeCode)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* OK */
- if (My->UseParameterString)
- {
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- variant.VariantTypeCode = StringTypeCode;
- variant.Buffer = My->UseParameterString;
- variant.Length = bwb_strlen (My->UseParameterString);
- var_set (v, &variant);
- }
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CHAIN
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_CHAIN (LineType * l)
- {
- /*
- SYNTAX: CHAIN file-name$ [, linenumber] ' most dialects
- SYNTAX: CHAIN file-name$ [, parameter$] ' CALL/360, System/360, System/370
- */
- /* originally based upon bwb_load() */
- int LineNumber;
- LineType *x;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->CurrentVersion != NULL );
- assert( My->StartMarker != NULL );
- assert( My->EndMarker != NULL );
-
- /* Get an argument for filename */
- if (line_is_eol (l))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- else
- {
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (is_empty_string (Value))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (My->ProgramFilename != NULL)
- {
- free (My->ProgramFilename);
- My->ProgramFilename = NULL;
- }
- My->ProgramFilename = Value;
- }
- /* optional linenumber */
- LineNumber = 0;
- if (line_skip_seperator (l))
- {
- if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73))
- {
- /* CHAIN filename$, parameter$ */
- {
- char *Value;
-
- Value = NULL;
- if (line_read_string_expression (l, &Value) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (Value == NULL)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (My->UseParameterString)
- {
- free (My->UseParameterString);
- My->UseParameterString = NULL;
- }
- My->UseParameterString = Value;
- }
- }
- else
- {
- /* CHAIN filename$, linenumber */
- if (line_read_integer_expression (l, &LineNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (LineNumber < MINLIN || LineNumber > MAXLIN)
- {
- WARN_UNDEFINED_LINE;
- return (l);
- }
- }
- }
-
- /* deallocate all variables except common ones */
- var_delcvars ();
-
- /* remove old program from memory */
- bwb_xnew (My->StartMarker);
-
- /* load new program in memory */
- if (bwb_fload (NULL) == FALSE)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- /* FIXME */
- x = My->StartMarker;
- if (MINLIN <= LineNumber && LineNumber <= MAXLIN)
- {
- /* search for a matching line number */
- while (x->number != LineNumber && x != My->EndMarker)
- {
- x = x->next;
- }
- if (x == My->EndMarker)
- {
- /* NOT FOUND */
- x = My->StartMarker;
- }
- }
- x->position = 0;
- /*
- **
- ** FORCE SCAN
- **
- */
- if (bwb_scan () == FALSE)
- {
- WARN_CANT_CONTINUE;
- return (l);
- }
- /* reset all stack counters */
- bwb_clrexec ();
- if (bwb_incexec ())
- {
- /* OK */
- My->StackHead->line = x;
- My->StackHead->ExecCode = EXEC_NORM;
- }
- else
- {
- /* ERROR */
- WARN_OUT_OF_MEMORY;
- return My->EndMarker;
- }
-
- /* run the program */
-
- /* CHAIN */
- WARN_CLEAR; /* bwb_CHAIN */
- My->ContinueLine = NULL;
- SetOnError (0);
- return x;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- APPEND
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_APPEND (LineType * l)
- {
- /*
- SYNTAX: APPEND # filenumber ' Dartmouth, Mark-I, Mark-II, GCOS
- SYNTAX: APPEND [filename$] ' all others
- */
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->CurrentVersion != NULL );
-
- if (My->CurrentVersion->OptionVersionValue & (D64 | G65 | G67 | G74))
- {
- if (line_skip_FilenumChar (l))
- {
- /* APPEND # filenumber */
- int FileNumber;
-
- if (line_read_integer_expression (l, &FileNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (FileNumber < 0)
- {
- /* "APPEND # -1" is silently ignored */
- return (l);
- }
- if (FileNumber == 0)
- {
- /* "APPEND # 0" is silently ignored */
- return (l);
- }
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- /* normal file */
- fseek (My->CurrentFile->cfp, 0, SEEK_END);
- My->CurrentFile->DevMode = DEVMODE_APPEND;
- /* OK */
- return (l);
- }
- }
- /* APPEND filename$ */
- return bwb_load (l, "APPEND FILE NAME:", FALSE);
- }
-
-
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR and so on
- --------------------------------------------------------------------------------------------
- */
-
- extern void
- SetOnError (int LineNumber)
- {
- /* scan the stack looking for a FUNCTION/SUB */
- StackType *StackItem;
- assert( My != NULL );
-
-
- if (My->StackHead == NULL)
- {
- return;
- }
-
- for (StackItem = My->StackHead; StackItem->next != NULL;
- StackItem = StackItem->next)
- {
- LineType *current;
-
- current = StackItem->LoopTopLine;
- if (current != NULL)
- {
- switch (current->cmdnum)
- {
- case C_FUNCTION:
- case C_SUB:
- /* FOUND */
- /* we are in a FUNCTION/SUB, so this is LOCAL */
- StackItem->OnErrorGoto = LineNumber;
- return;
- /* break; */
- }
- }
- }
- /* StackItem->next == NULL */
- /* NOT FOUND */
- /* we are NOT in a FUNCTION/SUB */
- assert (StackItem != NULL);
- StackItem->OnErrorGoto = LineNumber;
- }
-
-
- extern int
- GetOnError (void)
- {
- /* scan the stack looking for an active "ON ERROR GOTO linenumber" */
- StackType *StackItem;
- assert( My != NULL );
-
-
- for (StackItem = My->StackHead; StackItem != NULL;
- StackItem = StackItem->next)
- {
- if (StackItem->OnErrorGoto != 0)
- {
- /* FOUND */
- return StackItem->OnErrorGoto;
- }
- }
- /* NOT FOUND */
- return 0;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_ERROR (LineType * l)
- {
-
- assert (l != NULL);
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR GOTO
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_ERROR_GOTO (LineType * l)
- {
- /* ON ERROR GOTO line */
- int LineNumber;
-
- assert (l != NULL);
-
- WARN_CLEAR; /* bwb_ON_ERROR_GOTO */
-
- /* get the line number */
- LineNumber = 0;
- if (line_is_eol (l))
- {
- /* ON ERROR GOTO */
- SetOnError (0);
- return (l);
- }
- if (line_read_integer_expression (l, &LineNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* ON ERORR GOTO linenumber */
- if (LineNumber == 0)
- {
- /* ON ERROR GOTO 0 */
- SetOnError (0);
- return (l);
- }
- if (LineNumber < MINLIN || LineNumber > MAXLIN)
- {
- /* ERROR */
- WARN_UNDEFINED_LINE;
- return (l);
- }
- /* OK */
- SetOnError (LineNumber);
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR GOSUB
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_ERROR_GOSUB (LineType * l)
- {
- /* ON ERROR GOSUB line */
-
- assert (l != NULL);
- return bwb_ON_ERROR_GOTO (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR RESUME
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_ERROR_RESUME (LineType * l)
- {
-
- assert (l != NULL);
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR RESUME NEXT
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_ERROR_RESUME_NEXT (LineType * l)
- {
-
- assert (l != NULL);
- WARN_CLEAR; /* bwb_ON_ERROR_RESUME_NEXT */
- SetOnError (-1);
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR RETURN
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_ERROR_RETURN (LineType * l)
- {
-
- assert (l != NULL);
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON ERROR RETURN NEXT
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_ERROR_RETURN_NEXT (LineType * l)
- {
-
- assert (l != NULL);
- return bwb_ON_ERROR_RESUME_NEXT (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- ON TIMER
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_ON_TIMER (LineType * l)
- {
- /* ON TIMER(...) GOSUB ... */
- DoubleType v;
- DoubleType minv;
- int LineNumber;
-
- assert (l != NULL);
- assert( My != NULL );
-
- My->IsTimerOn = FALSE; /* bwb_ON_TIMER */
- My->OnTimerLineNumber = 0;
- My->OnTimerCount = 0;
-
-
- /* get the SECOMDS parameter */
- if (line_read_numeric_expression (l, &v) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- minv = 1;
- assert (CLOCKS_PER_SEC > 0);
- minv /= CLOCKS_PER_SEC;
- if (v < minv)
- {
- /* ERROR */
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
-
- /* get the GOSUB keyword */
- if (line_skip_word (l, "GOSUB") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* ON TIMER(X) GOSUB line */
- if (line_read_integer_expression (l, &LineNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (LineNumber < MINLIN || LineNumber > MAXLIN)
- {
- /* ERROR */
- WARN_UNDEFINED_LINE;
- return (l);
- }
- /* OK */
- My->OnTimerLineNumber = LineNumber;
- My->OnTimerCount = v;
- return (l);
- }
-
-
- /*
- --------------------------------------------------------------------------------------------
- TIMER
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_TIMER (LineType * l)
- {
-
- assert (l != NULL);
- assert( My != NULL );
-
- My->IsTimerOn = FALSE; /* bwb_TIMER */
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- TIMER OFF
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_TIMER_OFF (LineType * l)
- {
-
- assert (l != NULL);
- assert( My != NULL );
-
- /* TIMER OFF */
- My->IsTimerOn = FALSE; /* bwb_TIMER_OFF */
- My->OnTimerLineNumber = 0;
- My->OnTimerCount = 0;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- TIMER ON
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_TIMER_ON (LineType * l)
- {
-
- assert (l != NULL);
- assert( My != NULL );
-
- My->IsTimerOn = FALSE; /* bwb_TIMER_ON */
- /* TIMER ON */
- if (My->OnTimerCount > 0 && My->OnTimerLineNumber > 0)
- {
- My->OnTimerExpires = bwx_TIMER (My->OnTimerCount);
- My->IsTimerOn = TRUE; /* bwb_TIMER_ON */
- }
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- TIMER STOP
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_TIMER_STOP (LineType * l)
- {
-
- assert (l != NULL);
- assert( My != NULL );
-
- My->IsTimerOn = FALSE; /* bwb_TIMER_STOP */
-
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- RESUME
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_RESUME (LineType * l)
- {
- int LineNumber;
- LineType *x;
-
- assert (l != NULL);
- assert( My != NULL );
-
- LineNumber = 0;
- x = My->ERL; /* bwb_RESUME */
- WARN_CLEAR; /* bwb_RESUME */
-
- if (l->LineFlags & (LINE_USER))
- {
- WARN_ILLEGAL_DIRECT;
- return (l);
- }
-
- if (x == NULL)
- {
- WARN_RESUME_WITHOUT_ERROR;
- return (l);
- }
- /* Get optional argument for RESUME */
- if (line_is_eol (l))
- {
- /* RESUME */
- /*
- Execution resumes at the statement which caused the error
- For structured commands, this is the top line of the structure.
- */
- x->position = 0;
- return x;
- }
- if (line_skip_word (l, "NEXT"))
- {
- /* RESUME NEXT */
- /*
- Execution resumes at the statement immediately following the one which caused the error.
- For structured commands, this is the bottom line of the structure.
- */
- switch (x->cmdnum)
- {
- case C_IF8THEN:
- /* skip to END_IF */
- assert (x->OtherLine != NULL);
- for (x = x->OtherLine; x->cmdnum != C_END_IF; x = x->OtherLine);
- break;
- case C_SELECT_CASE:
- /* skip to END_SELECT */
- assert (x->OtherLine != NULL);
- for (x = x->OtherLine; x->cmdnum != C_END_SELECT; x = x->OtherLine);
- break;
- default:
- x = x->next;
- }
- x->position = 0;
- return x;
- }
- /* RESUME ### */
- if (line_read_integer_expression (l, &LineNumber) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (LineNumber == 0)
- {
- /* SPECIAL CASE */
- /* RESUME 0 */
- /* Execution resumes at the statement which caused the error */
- x->position = 0;
- return x;
- }
- /* VERIFY LINE EXISTS */
- x = find_line_number (LineNumber); /* RESUME 100 */
- if (x != NULL)
- {
- /* FOUND */
- x->position = 0;
- return x;
- }
- /* NOT FOUND */
- WARN_UNDEFINED_LINE;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CMDS
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_CMDS (LineType * l)
- {
- int n;
- int t;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->SYSOUT != NULL );
- assert( My->SYSOUT->cfp != NULL );
-
- My->CurrentFile = My->SYSOUT;
- fprintf (My->SYSOUT->cfp, "BWBASIC COMMANDS AVAILABLE:\n");
-
- /* run through the command table and print comand names */
-
- t = 0;
- for (n = 0; n < NUM_COMMANDS; n++)
- {
- fprintf (My->SYSOUT->cfp, "%s", IntrinsicCommandTable[n].name);
- if (t < 4)
- {
- fprintf (My->SYSOUT->cfp, "\t");
- t++;
- }
- else
- {
- fprintf (My->SYSOUT->cfp, "\n");
- t = 0;
- }
- }
- if (t > 0)
- {
- fprintf (My->SYSOUT->cfp, "\n");
- }
- ResetConsoleColumn ();
- return (l);
- }
-
- static void
- FixUp (char *Name)
- {
- char *C;
-
- assert (Name != NULL);
-
- C = Name;
- while (*C)
- {
- if (bwb_isalnum (*C))
- {
- /* OK */
- }
- else
- {
- /* FIX */
- switch (*C)
- {
- case '!':
- *C = '1';
- break;
- case '@':
- *C = '2';
- break;
- case '#':
- *C = '3';
- break;
- case '$':
- *C = '4';
- break;
- case '%':
- *C = '5';
- break;
- case '^':
- *C = '6';
- break;
- case '&':
- *C = '7';
- break;
- case '*':
- *C = '8';
- break;
- case '(':
- *C = '9';
- break;
- case ')':
- *C = '0';
- break;
- default:
- *C = '_';
- }
- }
- C++;
- }
- }
-
-
- static void
- CommandUniqueID (int i, char *UniqueID)
- {
-
- assert (UniqueID != NULL);
-
- bwb_strcpy (UniqueID, "C_");
- bwb_strcat (UniqueID, IntrinsicCommandTable[i].name);
- FixUp (UniqueID);
- }
-
- static void
- CommandVector (int i, char *Vector)
- {
-
- assert (Vector != NULL);
-
- bwb_strcpy (Vector, "bwb_");
- bwb_strcat (Vector, IntrinsicCommandTable[i].name);
- FixUp (Vector);
- }
-
- static void
- CommandOptionVersion (int n, char *OutputLine)
- {
- int i;
- int j;
-
- assert (OutputLine != NULL);
-
- bwb_strcpy (OutputLine, "");
- j = 0;
- for (i = 0; i < NUM_VERSIONS; i++)
- {
- if (IntrinsicCommandTable[n].OptionVersionBitmask & bwb_vertable[i].
- OptionVersionValue)
- {
- if (j > 0)
- {
- bwb_strcat (OutputLine, " | ");
- }
- bwb_strcat (OutputLine, bwb_vertable[i].ID);
- j++;
- }
- }
- }
-
-
- void
- SortAllCommands (void)
- {
- /* sort by name */
- int i;
- assert( My != NULL );
-
-
- for (i = 0; i < NUM_COMMANDS - 1; i++)
- {
- int j;
- int k;
- k = i;
- for (j = i + 1; j < NUM_COMMANDS; j++)
- {
- if (bwb_stricmp
- (IntrinsicCommandTable[j].name, IntrinsicCommandTable[k].name) < 0)
- {
- k = j;
- }
- }
- if (k > i)
- {
- CommandType t;
- bwb_memcpy (&t, &(IntrinsicCommandTable[i]), sizeof (CommandType));
- bwb_memcpy (&(IntrinsicCommandTable[i]), &(IntrinsicCommandTable[k]),
- sizeof (CommandType));
- bwb_memcpy (&(IntrinsicCommandTable[k]), &t, sizeof (CommandType));
- }
- }
- #if THE_PRICE_IS_RIGHT
- for (i = 0; i < 26; i++)
- {
- My->CommandStart[i] = -1;
- }
- for (i = 0; i < NUM_COMMANDS; i++)
- {
- int j;
- j = VarTypeIndex (IntrinsicCommandTable[i].name[0]);
- if (j < 0)
- {
- /* non-alpha */
- }
- else if (My->CommandStart[j] < 0)
- {
- /* this is the first command starting with this letter */
- My->CommandStart[j] = i;
- }
- }
- #endif /* THE_PRICE_IS_RIGHT */
- }
-
- void
- SortAllFunctions (void)
- {
- /* sort by name then number of parameters */
- int i;
- assert( My != NULL );
-
-
- for (i = 0; i < NUM_FUNCTIONS - 1; i++)
- {
- int j;
- int k;
- k = i;
- for (j = i + 1; j < NUM_FUNCTIONS; j++)
- {
- int n;
- n =
- bwb_stricmp (IntrinsicFunctionTable[j].Name,
- IntrinsicFunctionTable[k].Name);
- if (n < 0)
- {
- k = j;
- }
- else if (n == 0)
- {
- if (IntrinsicFunctionTable[j].ParameterCount <
- IntrinsicFunctionTable[k].ParameterCount)
- {
- k = j;
- }
- }
- }
- if (k > i)
- {
- IntrinsicFunctionType t;
- bwb_memcpy (&t, &(IntrinsicFunctionTable[i]),
- sizeof (IntrinsicFunctionType));
- bwb_memcpy (&(IntrinsicFunctionTable[i]), &(IntrinsicFunctionTable[k]),
- sizeof (IntrinsicFunctionType));
- bwb_memcpy (&(IntrinsicFunctionTable[k]), &t,
- sizeof (IntrinsicFunctionType));
- }
- }
- #if THE_PRICE_IS_RIGHT
- for (i = 0; i < 26; i++)
- {
- My->IntrinsicFunctionStart[i] = -1;
- }
- for (i = 0; i < NUM_FUNCTIONS; i++)
- {
- int j;
- j = VarTypeIndex (IntrinsicFunctionTable[i].Name[0]);
- if (j < 0)
- {
- /* non-alpha */
- }
- else if (My->IntrinsicFunctionStart[j] < 0)
- {
- /* this is the first command starting with this letter */
- My->IntrinsicFunctionStart[j] = i;
- }
- }
- #endif /* THE_PRICE_IS_RIGHT */
- }
-
-
- void
- DumpAllCommandUniqueID (FILE * file)
- {
- int i;
- int j;
- char LastUniqueID[NameLengthMax + 1];
-
- assert (file != NULL);
-
- j = 0;
- LastUniqueID[0] = NulChar;
-
- fprintf (file, "/* COMMANDS */\n");
-
- /* run through the command table and print comand #define */
-
- for (i = 0; i < NUM_COMMANDS; i++)
- {
- char UniqueID[NameLengthMax + 1];
-
- CommandUniqueID (i, UniqueID);
- if (bwb_stricmp (LastUniqueID, UniqueID) != 0)
- {
- /* not a duplicate */
- bwb_strcpy (LastUniqueID, UniqueID);
- j = j + 1;
- fprintf (file, "#define %-30s %3d /* %-30s */\n", UniqueID, j,
- IntrinsicCommandTable[i].name);
- }
- }
- fprintf (file, "#define NUM_COMMANDS %d\n", j);
- fflush (file);
- }
-
- static void
- ProcessEscapeChars (const char *Input, char *Output)
- {
- int n;
-
- assert (Input != NULL);
- assert (Output != NULL);
-
- n = 0;
-
- while (*Input)
- {
- /* \a \b \f \n \r \t \v \" \\ */
- switch (*Input)
- {
- case '\a':
- *Output = '\\';
- Output++;
- *Output = 'a';
- Output++;
- break;
- case '\b':
- *Output = '\\';
- Output++;
- *Output = 'b';
- Output++;
- break;
- case '\f':
- *Output = '\\';
- Output++;
- *Output = 'f';
- Output++;
- break;
- case '\n':
- *Output = '\\';
- Output++;
- *Output = 'n';
- Output++;
- break;
- case '\r':
- *Output = '\\';
- Output++;
- *Output = 'r';
- Output++;
- break;
- case '\t':
- *Output = '\\';
- Output++;
- *Output = 't';
- Output++;
- break;
- case '\v':
- *Output = '\\';
- Output++;
- *Output = 'n';
- Output++;
- break;
- case '\"':
- *Output = '\\';
- Output++;
- *Output = '"';
- Output++;
- break;
- case '\\':
- *Output = '\\';
- Output++;
- *Output = '\\';
- Output++;
- break;
- default:
- *Output = *Input;
- Output++;
- break;
- }
- *Output = NulChar;
- n++;
- if (n > 60 && *Input == ' ')
- {
- *Output = '\"';
- Output++;
- *Output = '\n';
- Output++;
- *Output = ' ';
- Output++;
- *Output = ' ';
- Output++;
- *Output = '\"';
- Output++;
- *Output = NulChar;
- n = 0;
- }
- Input++;
- }
- }
-
- void
- DumpAllCommandTableDefinitions (FILE * file)
- {
- /* generate bwd_cmd.c */
-
- int i;
-
- assert (file != NULL);
-
- fprintf (file, "/* COMMAND TABLE */\n\n");
- fprintf (file, "#include \"bwbasic.h\"\n\n");
- fprintf (file,
- "CommandType IntrinsicCommandTable[ /* NUM_COMMANDS */ ] =\n");
- fprintf (file, "{\n");
-
- /* run through the command table and print comand #define */
-
- for (i = 0; i < NUM_COMMANDS; i++)
- {
- char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllCommandTableDefinitions */
-
-
- fprintf (file, "{\n");
-
- fprintf (file, " ");
- CommandUniqueID (i, tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, ", /* UniqueID */\n");
-
- fprintf (file, " ");
- fprintf (file, "\"");
- ProcessEscapeChars (IntrinsicCommandTable[i].Syntax, tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, "\"");
- fprintf (file, ", /* Syntax */\n");
-
- fprintf (file, " ");
- fprintf (file, "\"");
- ProcessEscapeChars (IntrinsicCommandTable[i].Description, tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, "\"");
- fprintf (file, ", /* Description */\n");
-
- fprintf (file, " ");
- fprintf (file, "\"");
- fprintf (file, "%s", IntrinsicCommandTable[i].name);
- fprintf (file, "\"");
- fprintf (file, ", /* Name */\n");
-
- fprintf (file, " ");
- CommandOptionVersion (i, tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, " /* OptionVersionBitmask */\n");
-
- fprintf (file, "},\n");
- }
- fprintf (file, "};\n");
- fprintf (file, "\n");
- fprintf (file,
- "const size_t NUM_COMMANDS = sizeof( IntrinsicCommandTable ) / sizeof( CommandType );\n");
- fprintf (file, "\n");
- fflush (file);
- }
-
- void
- DumpAllCommandSwitchStatement (FILE * file)
- {
- int i;
- char LastUniqueID[NameLengthMax + 1];
-
- assert (file != NULL);
-
- LastUniqueID[0] = NulChar;
-
- /* run through the command table and print comand #define */
- fprintf (file, "/* SWITCH */\n");
- fprintf (file, "LineType *bwb_vector( LineType *l )\n");
- fprintf (file, "{\n");
-
- fprintf (file, " ");
- fprintf (file, "LineType *r;\n");
-
- fprintf (file, " ");
- fprintf (file, "switch( l->cmdnum )\n");
-
- fprintf (file, " ");
- fprintf (file, "{\n");
-
- for (i = 0; i < NUM_COMMANDS; i++)
- {
- char tbuf[NameLengthMax + 1];
-
- CommandUniqueID (i, tbuf);
- if (bwb_stricmp (LastUniqueID, tbuf) != 0)
- {
- /* not a duplicate */
- bwb_strcpy (LastUniqueID, tbuf);
-
- fprintf (file, " ");
- fprintf (file, "case ");
- CommandUniqueID (i, tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, ":\n");
-
- fprintf (file, " ");
- fprintf (file, " ");
- fprintf (file, "r = ");
- CommandVector (i, tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, "( l );\n");
-
- fprintf (file, " ");
- fprintf (file, " ");
- fprintf (file, "break;\n");
- }
- }
-
- fprintf (file, " ");
- fprintf (file, "default:\n");
-
- fprintf (file, " ");
- fprintf (file, " ");
- fprintf (file, "WARN_INTERNAL_ERROR;\n");
-
- fprintf (file, " ");
- fprintf (file, " ");
- fprintf (file, "r = l;\n");
-
- fprintf (file, " ");
- fprintf (file, " ");
- fprintf (file, "break;\n");
-
-
- fprintf (file, " ");
- fprintf (file, "}\n");
-
- fprintf (file, " ");
- fprintf (file, "return r;\n");
-
- fprintf (file, "}\n");
-
- fflush (file);
- }
-
- void
- FixDescription (FILE * file, const char *left, const char *right)
- {
- char buffer[MAINTAINER_BUFFER_LENGTH + 1]; /* FixDescription */
- int l; /* length of left side */
- int p; /* current position */
- int n; /* position of the last space character, zero means none yet seen */
- int i; /* number of characters since last '\n' */
-
- assert (left != NULL);
- assert (right != NULL);
-
- l = bwb_strlen (left);
- p = 0;
- n = 0;
- i = 0;
- bwb_strcpy (buffer, right);
-
- while (buffer[p])
- {
- if (buffer[p] == '\n')
- {
- n = p;
- i = 0;
- }
- if (buffer[p] == ' ')
- {
- n = p;
- }
- if (i > 45 && n > 0)
- {
- buffer[n] = '\n';
- i = p - n;
- }
- p++;
- i++;
- }
- fputs (left, file);
- p = 0;
- while (buffer[p])
- {
- if (buffer[p] == '\n')
- {
- fputc (buffer[p], file);
- p++;
- while (buffer[p] == ' ')
- {
- p++;
- }
- for (i = 0; i < l; i++)
- {
- fputc (' ', file);
- }
- }
- else
- {
- fputc (buffer[p], file);
- p++;
- }
- }
- fputc ('\n', file);
-
- }
-
- void
- DumpOneCommandSyntax (FILE * file, int IsXref, int n)
- {
-
- assert (file != NULL);
-
- if (n < 0 || n >= NUM_COMMANDS)
- {
- return;
- }
- /* NAME */
- {
- FixDescription (file, " SYNTAX: ", IntrinsicCommandTable[n].Syntax);
- }
- /* DESCRIPTION */
- {
- FixDescription (file, "DESCRIPTION: ",
- IntrinsicCommandTable[n].Description);
- }
- /* COMPATIBILITY */
- if (IsXref)
- {
- int i;
- fprintf (file, " VERSIONS:\n");
- for (i = 0; i < NUM_VERSIONS; i++)
- {
- char X;
- if (IntrinsicCommandTable[n].OptionVersionBitmask & bwb_vertable[i].
- OptionVersionValue)
- {
- /* SUPPORTED */
- X = 'X';
- }
- else
- {
- /* NOT SUPPORTED */
- X = '_';
- }
- fprintf (file, " [%c] %s\n", X, bwb_vertable[i].Name);
- }
- }
-
- fflush (file);
- }
-
- void
- DumpAllCommandSyntax (FILE * file, int IsXref,
- OptionVersionType OptionVersionValue)
- {
- /* for the C maintainer */
- int i;
-
- assert (file != NULL);
-
- fprintf (file,
- "============================================================\n");
- fprintf (file,
- " COMMANDS \n");
- fprintf (file,
- "============================================================\n");
- fprintf (file, "\n");
- fprintf (file, "\n");
- for (i = 0; i < NUM_COMMANDS; i++)
- {
- if (IntrinsicCommandTable[i].OptionVersionBitmask & OptionVersionValue)
- {
- fprintf (file,
- "------------------------------------------------------------\n");
- DumpOneCommandSyntax (file, IsXref, i);
- }
-
- }
- fprintf (file,
- "------------------------------------------------------------\n");
-
-
- fprintf (file, "\n");
- fprintf (file, "\n");
- fflush (file);
- }
-
-
- void
- DumpAllCommandHtmlTable (FILE * file)
- {
- /* generate bwd_cmd.htm */
-
- int i;
- int j;
-
- assert (file != NULL);
-
-
- /* LEGEND */
- fprintf (file, "<html><head><title>CMDS</title></head><body>\n");
- fprintf (file, "<h1>LEGEND</h1><br>\n");
- fprintf (file, "<table>\n");
-
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "ID");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "NAME");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "DESCRIPTION");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- fprintf (file, "</tr>\n");
-
- for (j = 0; j < NUM_VERSIONS; j++)
- {
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "%s", bwb_vertable[j].ID);
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "%s", bwb_vertable[j].Name);
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "%s", bwb_vertable[j].Description);
- fprintf (file, "</td>");
- fprintf (file, "</tr>\n");
- }
- fprintf (file, "</table>\n");
- fprintf (file, "<hr>\n");
-
-
- /* DETAILS */
- fprintf (file, "<h1>DETAILS</h1><br>\n");
- fprintf (file, "<table>\n");
-
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "COMMAND");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- for (j = 0; j < NUM_VERSIONS; j++)
- {
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "%s", bwb_vertable[j].ID);
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- }
- fprintf (file, "</tr>\n");
-
-
- /* run through the command table and print comand -vs- OPTION VERSION */
-
- for (i = 0; i < NUM_COMMANDS; i++)
- {
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "%s", (char *) IntrinsicCommandTable[i].Syntax);
- fprintf (file, "</td>");
-
- for (j = 0; j < NUM_VERSIONS; j++)
- {
- fprintf (file, "<td>");
- if (IntrinsicCommandTable[i].OptionVersionBitmask & bwb_vertable[j].
- OptionVersionValue)
- {
- fprintf (file, "X");
- }
- else
- {
- fprintf (file, " ");
- }
- fprintf (file, "</td>");
- }
- fprintf (file, "</tr>\n");
- }
- fprintf (file, "</table>\n");
- fprintf (file, "</body></html>\n");
- fprintf (file, "\n");
-
- fflush (file);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- HELP
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_HELP (LineType * l)
- {
- /* HELP ... */
- int n;
- int Found;
- char *C;
- char *tbuf;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->ConsoleInput != NULL );
- assert( My->SYSOUT != NULL );
- assert( My->SYSOUT->cfp != NULL );
-
- tbuf = My->ConsoleInput;
- Found = FALSE;
-
- C = l->buffer;
- C += l->position;
- bwb_strcpy (tbuf, C);
-
- /* RTRIM$ */
- C = tbuf;
- if (*C != 0)
- {
- /* not an empty line, so remove one (or more) trailing spaces */
- char *E;
-
- E = bwb_strchr (tbuf, 0);
- E--;
- while (E >= tbuf && *E == ' ')
- {
- *E = 0;
- E--;
- }
- }
-
-
- /* EXACT match */
- for (n = 0; n < NUM_COMMANDS; n++)
- {
- if (bwb_stricmp (IntrinsicCommandTable[n].name, tbuf) == 0)
- {
- fprintf (My->SYSOUT->cfp,
- "------------------------------------------------------------\n");
- DumpOneCommandSyntax (My->SYSOUT->cfp, FALSE, n);
- Found = TRUE;
- }
- }
-
- for (n = 0; n < NUM_FUNCTIONS; n++)
- {
- if (bwb_stricmp (IntrinsicFunctionTable[n].Name, tbuf) == 0)
- {
- fprintf (My->SYSOUT->cfp,
- "------------------------------------------------------------\n");
- DumpOneFunctionSyntax (My->SYSOUT->cfp, FALSE, n);
- Found = TRUE;
- }
- }
-
- if (Found == FALSE)
- {
- /* PARTIAL match */
- int Length;
- Length = bwb_strlen (tbuf);
-
- for (n = 0; n < NUM_COMMANDS; n++)
- {
- if (bwb_strnicmp (IntrinsicCommandTable[n].name, tbuf, Length) == 0)
- {
- if (Found == FALSE)
- {
- fprintf (My->SYSOUT->cfp,
- "The following topics are a partial match:\n");
- }
- fprintf (My->SYSOUT->cfp, "%s", IntrinsicCommandTable[n].name);
- fprintf (My->SYSOUT->cfp, "\t");
- Found = TRUE;
- }
- }
-
- for (n = 0; n < NUM_FUNCTIONS; n++)
- {
- if (bwb_strnicmp (IntrinsicFunctionTable[n].Name, tbuf, Length) == 0)
- {
- if (Found == FALSE)
- {
- fprintf (My->SYSOUT->cfp,
- "The following topics are a partial match:\n");
- }
- fprintf (My->SYSOUT->cfp, "%s", IntrinsicFunctionTable[n].Name);
- fprintf (My->SYSOUT->cfp, "\t");
- Found = TRUE;
- }
- }
- if (Found == TRUE)
- {
- /* match */
- fprintf (My->SYSOUT->cfp, "\n");
- }
- }
- if (Found == FALSE)
- {
- /* NO match */
- fprintf (My->SYSOUT->cfp, "No help found.\n");
- }
- ResetConsoleColumn ();
- line_skip_eol (l);
- return (l);
-
- }
-
- int
- NumberValueCheck (ParamTestType ParameterTests, DoubleType X)
- {
- DoubleType XR; /* rounded value */
- unsigned char TestNibble;
-
-
-
- /* VerifyNumeric */
- if (isnan (X))
- {
- /* INTERNAL ERROR */
- return -1;
- }
- if (isinf (X))
- {
- /* - Evaluation of an expression results in an overflow
- * (nonfatal, the recommended recovery procedure is to supply
- * machine in- finity with the algebraically correct sign and
- * continue). */
- if (X < 0)
- {
- X = MINDBL;
- }
- else
- {
- X = MAXDBL;
- }
- if (WARN_OVERFLOW)
- {
- /* ERROR */
- return -1;
- }
- /* CONTINUE */
- }
- /* OK */
- /* VALID NUMERIC VALUE */
- XR = bwb_rint (X);
- ParameterTests &= 0x0000000F;
- TestNibble = (unsigned char) ParameterTests;
- switch (TestNibble)
- {
- case P1ERR:
- /* INTERNAL ERROR */
- return -1;
- /* break; */
- case P1ANY:
- if (X < MINDBL || X > MAXDBL)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1BYT:
- if (XR < MINBYT || XR > MAXBYT)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1INT:
- if (XR < MININT || XR > MAXINT)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1LNG:
- if (XR < MINLNG || XR > MAXLNG)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1CUR:
- if (XR < MINCUR || XR > MAXCUR)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1FLT:
- if (X < MINSNG || X > MAXSNG)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1DBL:
- if (X < MINDBL || X > MAXDBL)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1DEV:
- /* ERROR */
- return -1;
- /* break; */
- case P1LEN:
- if (XR < MINLEN || XR > MAXLEN)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1POS:
- if (XR < 1 || XR > MAXLEN)
- {
- /* ERROR */
- return -1;
- }
- /* OK */
- return 0;
- /* break; */
- case P1COM:
- /* ERROR */
- return -1;
- /* break; */
- case P1LPT:
- /* ERROR */
- return -1;
- /* break; */
- case P1GTZ:
- if (X > 0)
- {
- /* OK */
- return 0;
- }
- break;
- case P1GEZ:
- if (X >= 0)
- {
- /* OK */
- return 0;
- }
- break;
- case P1NEZ:
- if (X != 0)
- {
- /* OK */
- return 0;
- }
- break;
- }
- /* ERROR */
- return -1;
- }
-
- int
- StringLengthCheck (ParamTestType ParameterTests, int s)
- {
- unsigned char TestNibble;
-
-
- /* check for invalid string length */
- if (s < 0 || s > MAXLEN)
- {
- /* INTERNAL ERROR */
- return -1;
- }
- /* VALID STRING LENGTH */
- ParameterTests &= 0x0000000F;
- TestNibble = (unsigned char) ParameterTests;
- switch (TestNibble)
- {
- case P1ERR:
- /* INTERNAL ERROR */
- return -1;
- /* break; */
- case P1ANY:
- /* OK */
- return 0;
- /* break; */
- case P1BYT:
- if (s >= sizeof (ByteType))
- {
- /* OK */
- return 0;
- }
- break;
- case P1INT:
- if (s >= sizeof (IntegerType))
- {
- /* OK */
- return 0;
- }
- break;
- case P1LNG:
- if (s >= sizeof (LongType))
- {
- /* OK */
- return 0;
- }
- break;
- case P1CUR:
- if (s >= sizeof (CurrencyType))
- {
- /* OK */
- return 0;
- }
- break;
- case P1FLT:
- if (s >= sizeof (SingleType))
- {
- /* OK */
- return 0;
- }
- break;
- case P1DBL:
- if (s >= sizeof (DoubleType))
- {
- /* OK */
- return 0;
- }
- break;
- case P1DEV:
- /* ERROR */
- return -1;
- /* break; */
- case P1LEN:
- /* ERROR */
- return -1;
- /* break; */
- case P1POS:
- /* ERROR */
- return -1;
- /* break; */
- case P1GEZ:
- /* ERROR */
- return -1;
- /* break; */
- case P1GTZ:
- /* ERROR */
- return -1;
- /* break; */
- case P1NEZ:
- /* ERROR */
- return -1;
- /* break; */
- }
- /* ERROR */
- return -1;
- }
-
- void
- IntrinsicFunctionDefinitionCheck (IntrinsicFunctionType * f)
- {
- /* function definition check -- look for obvious errors */
-
- assert (f != NULL);
- assert( My != NULL );
- assert( My->SYSOUT != NULL );
- assert( My->SYSOUT->cfp != NULL );
-
-
- /* sanity check */
- if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF)
- {
- /* function has NO explicit parameters */
- if (f->ParameterTypes == PNONE)
- {
- /* OK */
- }
- else
- {
- /* oops */
- fprintf (My->SYSOUT->cfp, "invalid ParameterTypes <%s>\n", f->Name);
- }
- if (f->ParameterTests == PNONE)
- {
- /* OK */
- }
- else
- {
- /* oops */
- fprintf (My->SYSOUT->cfp, "invalid ParameterTests <%s>\n", f->Name);
- }
- }
- else
- {
- /* function HAS an explicit number of parameters */
- int i;
- ParamTestType ParameterTests;
-
- ParameterTests = f->ParameterTests;
- for (i = 0; i < f->ParameterCount; i++)
- {
- /* sanity check this parameter */
- ParamTestType thischeck;
- thischeck = ParameterTests & 0x0000000F;
- /* verify parameter check */
- if (f->ParameterTypes & (1 << i))
- {
- /* STRING */
- if (thischeck >= P1ANY && thischeck <= P1DBL)
- {
- /* OK */
- }
- else
- {
- /* oops */
- fprintf (My->SYSOUT->cfp,
- "invalid ParameterTests <%s> parameter %d\n", f->Name,
- i + 1);
- }
- }
- else
- {
- /* NUMBER */
- if (thischeck >= P1ANY && thischeck <= P1NEZ)
- {
- /* OK */
- }
- else
- {
- /* oops */
- fprintf (My->SYSOUT->cfp,
- "invalid ParameterTests <%s> parameter %d\n", f->Name,
- i + 1);
- }
- }
- ParameterTests = ParameterTests >> 4;
- }
- if (ParameterTests != 0)
- {
- /* oops */
- fprintf (My->SYSOUT->cfp, "invalid ParameterTests <%s> parameter %d\n",
- f->Name, i + 1);
- }
- }
- }
-
- void
- IntrinsicFunctionUniqueID (IntrinsicFunctionType * f, char *UniqueID)
- {
- /* generate the function's UniqueID */
- /* manual fixup required for duplicates */
- char NumVar;
- char StrVar;
-
- assert (f != NULL);
- assert (UniqueID != NULL);
-
-
- NumVar = 'X';
- StrVar = 'A';
-
- /* F_ */
- bwb_strcpy (UniqueID, "F_");
- /* NAME */
- bwb_strcat (UniqueID, f->Name);
- /* PARAMETERS */
- if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF)
- {
- /* function has NO explicit parameters */
- }
- else
- {
- /* function HAS explicit parameters */
- int i;
- ParamBitsType ParameterTypes;
- ParameterTypes = f->ParameterTypes;
- for (i = 0; i < f->ParameterCount; i++)
- {
- char VarName[NameLengthMax + 1];
- if (ParameterTypes & 1)
- {
- /* STRING */
- sprintf (VarName, "_%c", StrVar);
- StrVar++;
- }
- else
- {
- /* NUMBER */
- sprintf (VarName, "_%c", NumVar);
- NumVar++;
- }
- bwb_strcat (UniqueID, VarName);
- ParameterTypes = ParameterTypes >> 1;
- }
- }
- /* RETURN TYPE */
- if (f->ReturnTypeCode == StringTypeCode)
- {
- bwb_strcat (UniqueID, "_S");
- }
- else
- {
- bwb_strcat (UniqueID, "_N");
- }
- /* fixup illegal characters, "DEF FN" "BLOAD:", "CLOAD*" */
- FixUp (UniqueID);
- }
-
-
- void
- IntrinsicFunctionSyntax (IntrinsicFunctionType * f, char *Syntax)
- {
- /* generate the function's Syntax */
- char NumVar;
- char StrVar;
-
- assert (f != NULL);
- assert (Syntax != NULL);
-
-
- NumVar = 'X';
- StrVar = 'A';
-
- /* RETURN TYPE */
- if (f->ReturnTypeCode == StringTypeCode)
- {
- bwb_strcpy (Syntax, "S$ = ");
- }
- else
- {
- bwb_strcpy (Syntax, "N = ");
- }
- /* NAME */
- bwb_strcat (Syntax, f->Name);
- /* PARAMETERS */
- if (f->ParameterCount == PNONE)
- {
- /* function has NO explicit parameters */
- }
- else if (f->ParameterCount == 0xFF)
- {
- /* function has a variable number of parameters */
- bwb_strcat (Syntax, "( ... )");
- }
- else
- {
- /* function HAS explicit parameters */
- int i;
- ParamBitsType ParameterTypes;
- ParameterTypes = f->ParameterTypes;
-
- if (f->ReturnTypeCode == StringTypeCode)
- {
- bwb_strcat (Syntax, "( ");
- }
- else
- {
- bwb_strcat (Syntax, "( ");
- }
-
- for (i = 0; i < f->ParameterCount; i++)
- {
- char VarName[NameLengthMax + 1];
- if (i > 0)
- {
- bwb_strcat (Syntax, ", ");
- }
- /* verify parameter check */
- if (ParameterTypes & 1)
- {
- /* STRING */
- sprintf (VarName, "%c$", StrVar);
- StrVar++;
- }
- else
- {
- /* NUMBER */
- sprintf (VarName, "%c", NumVar);
- NumVar++;
- }
- bwb_strcat (Syntax, VarName);
- ParameterTypes = ParameterTypes >> 1;
- }
- if (f->ReturnTypeCode == StringTypeCode)
- {
- bwb_strcat (Syntax, " )");
- }
- else
- {
- bwb_strcat (Syntax, " )");
- }
- }
- }
-
- void
- DumpAllFunctionUniqueID (FILE * file)
- {
- /* for the C maintainer */
- int i;
- int j;
- char LastUniqueID[NameLengthMax + 1];
-
- assert (file != NULL);
-
- j = 0;
- LastUniqueID[0] = NulChar;
-
- fprintf (file, "/* FUNCTIONS */\n");
- for (i = 0; i < NUM_FUNCTIONS; i++)
- {
- char UniqueID[NameLengthMax + 1];
-
- IntrinsicFunctionUniqueID (&(IntrinsicFunctionTable[i]), UniqueID);
- if (bwb_stricmp (LastUniqueID, UniqueID) != 0)
- {
- /* not a duplicate */
- char Syntax[NameLengthMax + 1];
-
- bwb_strcpy (LastUniqueID, UniqueID);
- j = j + 1;
- IntrinsicFunctionSyntax (&(IntrinsicFunctionTable[i]), Syntax);
- fprintf (file, "#define %-30s %3d /* %-30s */\n", UniqueID, j, Syntax);
- }
- }
- fprintf (file, "#define NUM_FUNCTIONS %d\n", j);
- fflush (file);
- }
-
- void
- DumpAllFunctionSwitch (FILE * file)
- {
- /* for the C maintainer */
- int i;
-
- assert (file != NULL);
-
-
- fprintf (file, "/* SWITCH */\n");
- fprintf (file, "switch( UniqueID )\n");
- fprintf (file, "{\n");
- for (i = 0; i < NUM_FUNCTIONS; i++)
- {
- char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFunctionSwitch */
-
- fprintf (file, "case ");
- IntrinsicFunctionUniqueID (&(IntrinsicFunctionTable[i]), tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, ":\n");
- fprintf (file, " break;\n");
- }
- fprintf (file, "}\n");
- fflush (file);
- }
-
- static const char *ParameterRangeID[16] = {
- "P%dERR",
- "P%dANY",
- "P%dBYT",
- "P%dINT",
- "P%dLNG",
- "P%dCUR",
- "P%dFLT",
- "P%dDBL",
- "P%dDEV",
- "P%dLEN",
- "P%dPOS",
- "P%dCOM",
- "P%dLPT",
- "P%dGTZ",
- "P%dGEZ",
- "P%dNEZ",
- };
-
- static const char *NumberVariableRange[16] = {
- /* P1ERR */ " PARAMETER: %c is a number, INTERNAL ERROR",
- /* P1ANY */ " PARAMETER: %c is a number",
- /* P1BYT */ " PARAMETER: %c is a number, [0,255]",
- /* P1INT */ " PARAMETER: %c is a number, [MININT,MAXINT]",
- /* P1LNG */ " PARAMETER: %c is a number, [MINLNG,MAXLNG]",
- /* P1CUR */ " PARAMETER: %c is a number, [MINCUR,MAXCUR]",
- /* P1FLT */ " PARAMETER: %c is a number, [MINFLT,MAXFLT]",
- /* P1DBL */ " PARAMETER: %c is a number, [MINDBL,MAXDBL]",
- /* P1DEV */ " PARAMETER: %c is a number, RESERVED",
- /* P1LEN */ " PARAMETER: %c is a number, [0,MAXLEN]",
- /* P1POS */ " PARAMETER: %c is a number, [1,MAXLEN]",
- /* P1COM */ " PARAMETER: %c is a number, RESERVED",
- /* P1LPT */ " PARAMETER: %c is a number, RESERVED",
- /* P1GTZ */ " PARAMETER: %c is a number, > 0",
- /* P1GEZ */ " PARAMETER: %c is a number, >= 0",
- /* P1NEZ */ " PARAMETER: %c is a number, <> 0",
- };
-
- static const char *StringVariableRange[16] = {
- /* P1ERR */ " PARAMETER: %c$ is a string, INTERNAL ERROR",
- /* P1ANY */ " PARAMETER: %c$ is a string, LEN >= 0",
- /* P1BYT */ " PARAMETER: %c$ is a string, LEN >= 1",
- /* P1INT */ " PARAMETER: %c$ is a string, LEN >= sizeof(INT)",
- /* P1LNG */ " PARAMETER: %c$ is a string, LEN >= sizeof(LNG)",
- /* P1CUR */ " PARAMETER: %c$ is a string, LEN >= sizeof(CUR)",
- /* P1FLT */ " PARAMETER: %c$ is a string, LEN >= sizeof(FLT)",
- /* P1DBL */ " PARAMETER: %c$ is a string, LEN >= sizeof(DBL)",
- /* P1DEV */ " PARAMETER: %c$ is a string, RESERVED",
- /* P1LEN */ " PARAMETER: %c$ is a string, RESERVED",
- /* P1POS */ " PARAMETER: %c$ is a string, RESERVED",
- /* P1COM */ " PARAMETER: %c$ is a string, RESERVED",
- /* P1LPT */ " PARAMETER: %c$ is a string, RESERVED",
- /* P1GTZ */ " PARAMETER: %c$ is a string, RESERVED",
- /* P1GEZ */ " PARAMETER: %c$ is a string, RESERVED",
- /* P1NEZ */ " PARAMETER: %c$ is a string, RESERVED",
- };
-
- void
- DumpAllFuctionTableDefinitions (FILE * file)
- {
- /* generate bwd_fun.c */
- int n;
-
- assert (file != NULL);
-
-
- fprintf (file, "/* FUNCTION TABLE */\n");
- fprintf (file, "\n");
- fprintf (file, "#include \"bwbasic.h\"\n");
- fprintf (file, "\n");
- fprintf (file,
- "IntrinsicFunctionType IntrinsicFunctionTable[ /* NUM_FUNCTIONS */ ] =\n");
- fprintf (file, "{\n");
- for (n = 0; n < NUM_FUNCTIONS; n++)
- {
- int i;
- int j;
- char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */
- char UniqueID[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */
- char Syntax[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpAllFuctionTableDefinitions */
- IntrinsicFunctionType *f;
-
- f = &(IntrinsicFunctionTable[n]);
-
- IntrinsicFunctionUniqueID (f, UniqueID);
- IntrinsicFunctionSyntax (f, Syntax);
- fprintf (file, "{\n");
- fprintf (file, " %s, /* UniqueID */\n", UniqueID);
- fprintf (file, " \"%s\", /* Syntax */\n", Syntax);
- fprintf (file, " ");
- fprintf (file, "\"");
- ProcessEscapeChars (f->Description, tbuf);
- fprintf (file, "%s", tbuf);
- fprintf (file, "\"");
- fprintf (file, ", /* Description */\n");
- fprintf (file, " \"%s\", /* Name */\n", f->Name);
- switch (f->ReturnTypeCode)
- {
- case ByteTypeCode:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "ByteTypeCode");
- break;
- case IntegerTypeCode:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "IntegerTypeCode");
- break;
- case LongTypeCode:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "LongTypeCode");
- break;
- case CurrencyTypeCode:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "CurrencyTypeCode");
- break;
- case SingleTypeCode:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "SingleTypeCode");
- break;
- case DoubleTypeCode:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "DoubleTypeCode");
- break;
- case StringTypeCode:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "StringTypeCode");
- break;
- default:
- fprintf (file, " %s, /* ReturnTypeCode */\n", "INTERNAL ERROR");
- break;
- }
- fprintf (file, " %d, /* ParameterCount */\n", f->ParameterCount);
- if (f->ParameterCount == 0 || f->ParameterCount == 0xFF)
- {
- /* function has NO explicit parameters */
- fprintf (file, " %s, /* ParameterTypes */\n", "PNONE");
- fprintf (file, " %s, /* ParameterTests */\n", "PNONE");
- }
- else
- {
- /* function has explicit parameters */
- bwb_strcpy (tbuf, " ");
- for (i = 0; i < f->ParameterCount; i++)
- {
- ParamBitsType ParameterTypes;
- ParameterTypes = f->ParameterTypes >> i;
- ParameterTypes &= 0x1;
- if (i > 0)
- {
- bwb_strcat (tbuf, " | ");
- }
- if (ParameterTypes)
- {
- sprintf (bwb_strchr (tbuf, NulChar), "P%dSTR", i + 1);
- }
- else
- {
- sprintf (bwb_strchr (tbuf, NulChar), "P%dNUM", i + 1);
- }
- }
- bwb_strcat (tbuf, ", /* ParameterTypes */\n");
- fprintf (file, "%s", tbuf);
-
-
- bwb_strcpy (tbuf, " ");
- for (i = 0; i < f->ParameterCount; i++)
- {
- ParamTestType ParameterTests;
- ParameterTests = f->ParameterTests >> (i * 4);
- ParameterTests &= 0xF;
-
- if (i > 0)
- {
- bwb_strcat (tbuf, " | ");
- }
- sprintf (bwb_strchr (tbuf, 0), ParameterRangeID[ParameterTests],
- i + 1);
- /* Conversion may lose significant digits */
- }
- bwb_strcat (tbuf, ", /* ParameterTests */\n");
- fprintf (file, "%s", tbuf);
- }
- bwb_strcpy (tbuf, " ");
- j = 0;
- for (i = 0; i < NUM_VERSIONS; i++)
- {
- if (f->OptionVersionBitmask & bwb_vertable[i].OptionVersionValue)
- {
- if (j > 0)
- {
- bwb_strcat (tbuf, " | ");
- }
- bwb_strcat (tbuf, bwb_vertable[i].ID);
- j++;
- }
- }
- bwb_strcat (tbuf, " /* OptionVersionBitmask */\n");
- fprintf (file, "%s", tbuf);
- fprintf (file, "},\n");
- }
- fprintf (file, "};\n");
- fprintf (file, "\n");
- fprintf (file,
- "const size_t NUM_FUNCTIONS = sizeof( IntrinsicFunctionTable ) / sizeof( IntrinsicFunctionType );\n");
- fprintf (file, "\n");
- fflush (file);
- }
-
- void
- DumpOneFunctionSyntax (FILE * file, int IsXref, int n)
- {
- IntrinsicFunctionType *f;
- assert (file != NULL);
-
-
-
- if (n < 0 || n >= NUM_FUNCTIONS)
- {
- return;
- }
- f = &(IntrinsicFunctionTable[n]);
- /* NAME */
- {
- char UniqueID[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */
- char Syntax[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */
-
- IntrinsicFunctionUniqueID (f, UniqueID);
- IntrinsicFunctionSyntax (f, Syntax);
- fprintf (file, " SYNTAX: %s\n", Syntax);
- }
- /* PARAMETERS */
- if (f->ParameterCount == PNONE || f->ParameterCount == 0xFF)
- {
- /* function has NO explicit parameters */
- }
- else
- {
- /* function HAS explicit parameters */
- int i;
- ParamBitsType ParameterTypes;
- ParamTestType ParameterTests;
- char NumVar;
- char StrVar;
- ParameterTypes = f->ParameterTypes;
- ParameterTests = f->ParameterTests;
- NumVar = 'X';
- StrVar = 'A';
- for (i = 0; i < f->ParameterCount; i++)
- {
- /* sanity check this parameter */
- unsigned long thischeck;
- char tbuf[MAINTAINER_BUFFER_LENGTH + 1]; /* DumpOneFunctionSyntax */
-
- thischeck = ParameterTests & 0x0000000F;
- /* verify parameter check */
- if (ParameterTypes & 1)
- {
- /* STRING */
- sprintf (tbuf, StringVariableRange[thischeck], StrVar);
- /* Conversion may lose significant digits */
- StrVar++;
- }
- else
- {
- /* NUMBER */
- sprintf (tbuf, NumberVariableRange[thischeck], NumVar);
- /* Conversion may lose significant digits */
- NumVar++;
- }
- fprintf (file, "%s", tbuf);
- fprintf (file, "\n");
- ParameterTypes = ParameterTypes >> 1;
- ParameterTests = ParameterTests >> 4;
- }
- }
- /* DESCRIPTION */
- {
- FixDescription (file, "DESCRIPTION: ", f->Description);
- }
- /* COMPATIBILITY */
- if (IsXref)
- {
- int i;
- fprintf (file, " VERSIONS:\n");
- for (i = 0; i < NUM_VERSIONS; i++)
- {
- char X;
- if (f->OptionVersionBitmask & bwb_vertable[i].OptionVersionValue)
- {
- /* SUPPORTED */
- X = 'X';
- }
- else
- {
- /* NOT SUPPORTED */
- X = '_';
- }
- fprintf (file, " [%c] %s\n", X, bwb_vertable[i].Name);
- }
- }
-
- fflush (file);
- }
-
- void
- DumpAllFunctionSyntax (FILE * file, int IsXref,
- OptionVersionType OptionVersionValue)
- {
- /* for the C maintainer */
- int i;
-
- assert (file != NULL);
-
-
- fprintf (file,
- "============================================================\n");
- fprintf (file,
- " FUNCTIONS \n");
- fprintf (file,
- "============================================================\n");
- fprintf (file, "\n");
- fprintf (file, "\n");
- for (i = 0; i < NUM_FUNCTIONS; i++)
- {
- if (IntrinsicFunctionTable[i].OptionVersionBitmask & OptionVersionValue)
- {
- fprintf (file,
- "------------------------------------------------------------\n");
- DumpOneFunctionSyntax (file, IsXref, i);
- }
- }
- fprintf (file,
- "------------------------------------------------------------\n");
- fprintf (file, "\n");
- fprintf (file, "\n");
- fflush (file);
- }
-
- void
- DumpAllFunctionHtmlTable (FILE * file)
- {
- /* generate bwd_cmd.htm */
- int i;
- int j;
-
- assert (file != NULL);
-
-
- /* LEGEND */
- fprintf (file, "<html><head><title>FNCS</title></head><body>\n");
- fprintf (file, "<h1>LEGEND</h1><br>\n");
- fprintf (file, "<table>\n");
-
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "ID");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "NAME");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "DESCRIPTION");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- fprintf (file, "</tr>\n");
-
- for (j = 0; j < NUM_VERSIONS; j++)
- {
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "%s", bwb_vertable[j].ID);
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "%s", bwb_vertable[j].Name);
- fprintf (file, "</td>");
- fprintf (file, "<td>");
- fprintf (file, "%s", bwb_vertable[j].Description);
- fprintf (file, "</td>");
- fprintf (file, "</tr>\n");
- }
- fprintf (file, "</table>\n");
- fprintf (file, "<hr>\n");
-
-
- /* DETAILS */
- fprintf (file, "<h1>DETAILS</h1><br>\n");
- fprintf (file, "<table>\n");
-
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "FUNCTION");
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- for (j = 0; j < NUM_VERSIONS; j++)
- {
- fprintf (file, "<td>");
- fprintf (file, "<b>");
- fprintf (file, "%s", bwb_vertable[j].ID);
- fprintf (file, "</b>");
- fprintf (file, "</td>");
- }
- fprintf (file, "</tr>\n");
-
-
- /* run through the command table and print comand -vs- OPTION VERSION */
-
- for (i = 0; i < NUM_FUNCTIONS; i++)
- {
- fprintf (file, "<tr>");
- fprintf (file, "<td>");
- fprintf (file, "%s", (char *) IntrinsicFunctionTable[i].Syntax);
- fprintf (file, "</td>");
-
- for (j = 0; j < NUM_VERSIONS; j++)
- {
- fprintf (file, "<td>");
- if (IntrinsicFunctionTable[i].OptionVersionBitmask & bwb_vertable[j].
- OptionVersionValue)
- {
- fprintf (file, "X");
- }
- else
- {
- fprintf (file, " ");
- }
- fprintf (file, "</td>");
- }
- fprintf (file, "</tr>\n");
- }
- fprintf (file, "</table>\n");
- fprintf (file, "</body></html>\n");
- fprintf (file, "\n");
-
- fflush (file);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- FNCS
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_FNCS (LineType * l)
- {
- int n;
- int t;
-
- assert (l != NULL);
- assert( My != NULL );
- assert( My->SYSOUT != NULL );
- assert( My->SYSOUT->cfp != NULL );
-
-
- My->CurrentFile = My->SYSOUT;
- fprintf (My->SYSOUT->cfp, "BWBASIC FUNCTIONS AVAILABLE:\n");
-
- /* run through the command table and print comand names */
-
- t = 0;
- for (n = 0; n < NUM_FUNCTIONS; n++)
- {
- fprintf (My->SYSOUT->cfp, "%s", IntrinsicFunctionTable[n].Name);
- if (t < 4)
- {
- fprintf (My->SYSOUT->cfp, "\t");
- t++;
- }
- else
- {
- fprintf (My->SYSOUT->cfp, "\n");
- t = 0;
- }
- }
- if (t > 0)
- {
- fprintf (My->SYSOUT->cfp, "\n");
- }
- ResetConsoleColumn ();
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- MAINTAINER
- --------------------------------------------------------------------------------------------
- */
- LineType *
- bwb_MAINTAINER (LineType * l)
- {
-
- assert (l != NULL);
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_CMDS (LineType * l)
- {
-
- assert (l != NULL);
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_CMDS_HTML (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllCommandHtmlTable (My->SYSPRN->cfp);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_CMDS_ID (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllCommandUniqueID (My->SYSPRN->cfp);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_CMDS_MANUAL (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllCommandSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1));
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_CMDS_SWITCH (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllCommandSwitchStatement (My->SYSPRN->cfp);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_CMDS_TABLE (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllCommandTableDefinitions (My->SYSPRN->cfp);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_DEBUG (LineType * l)
- {
-
- assert (l != NULL);
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_DEBUG_ON (LineType * l)
- {
-
- assert (l != NULL);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_DEBUG_OFF (LineType * l)
- {
-
- assert (l != NULL);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_FNCS (LineType * l)
- {
-
- assert (l != NULL);
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_FNCS_HTML (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllFunctionHtmlTable (My->SYSPRN->cfp);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_FNCS_ID (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllFunctionUniqueID (My->SYSPRN->cfp);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_FNCS_MANUAL (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllFunctionSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1));
- DumpAllOperatorSyntax (My->SYSPRN->cfp, TRUE, (OptionVersionType)(-1));
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_FNCS_SWITCH (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllFunctionSwitch (My->SYSPRN->cfp);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_FNCS_TABLE (LineType * l)
- {
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- DumpAllFuctionTableDefinitions (My->SYSPRN->cfp);
- return (l);
- }
-
- void
- DumpHeader (FILE * file)
- {
- char c;
-
- assert (file != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
-
- fprintf (file,
- "============================================================\n");
- fprintf (file,
- " GENERAL \n");
- fprintf (file,
- "============================================================\n");
- fprintf (file, "\n");
- fprintf (file, "\n");
-
- fprintf (file, "OPTION VERSION \"%s\"\n", My->CurrentVersion->Name);
- fprintf (file, "REM INTERNAL ID: %s\n", My->CurrentVersion->ID);
- fprintf (file, "REM DESCRIPTION: %s\n", My->CurrentVersion->Description);
- fprintf (file, "REM REFERENCE: %s\n", My->CurrentVersion->ReferenceTitle);
- fprintf (file, "REM %s\n",
- My->CurrentVersion->ReferenceAuthor);
- fprintf (file, "REM %s\n",
- My->CurrentVersion->ReferenceCopyright);
- fprintf (file, "REM %s\n", My->CurrentVersion->ReferenceURL1);
- fprintf (file, "REM %s\n", My->CurrentVersion->ReferenceURL2);
- fprintf (file, "REM\n");
-
- if (My->CurrentVersion->OptionFlags & (OPTION_STRICT_ON))
- {
- fprintf (file, "OPTION STRICT ON\n");
- }
- else
- {
- fprintf (file, "OPTION STRICT OFF\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_ANGLE_DEGREES))
- {
- fprintf (file, "OPTION ANGLE DEGREES\n");
- }
- else if (My->CurrentVersion->OptionFlags & (OPTION_ANGLE_GRADIANS))
- {
- fprintf (file, "OPTION ANGLE GRADIANS\n");
- }
- else
- {
- fprintf (file, "OPTION ANGLE RADIANS\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_BUGS_ON))
- {
- fprintf (file, "OPTION BUGS ON\n");
- }
- else
- {
- fprintf (file, "OPTION BUGS OFF\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_LABELS_ON))
- {
- fprintf (file, "OPTION LABELS ON\n");
- }
- else
- {
- fprintf (file, "OPTION LABELS OFF\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_COMPARE_TEXT))
- {
- fprintf (file, "OPTION COMPARE TEXT\n");
- }
- else
- {
- fprintf (file, "OPTION COMPARE BINARY\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_COVERAGE_ON))
- {
- fprintf (file, "OPTION COVERAGE ON\n");
- }
- else
- {
- fprintf (file, "OPTION COVERAGE OFF\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_TRACE_ON))
- {
- fprintf (file, "OPTION TRACE ON\n");
- }
- else
- {
- fprintf (file, "OPTION TRACE OFF\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_ERROR_GOSUB))
- {
- fprintf (file, "OPTION ERROR GOSUB\n");
- }
- else
- {
- fprintf (file, "OPTION ERROR GOTO\n");
- }
-
- if (My->CurrentVersion->OptionFlags & (OPTION_EXPLICIT_ON))
- {
- fprintf (file, "OPTION EXPLICIT\n");
- }
- else
- {
- fprintf (file, "OPTION IMPLICIT\n");
- }
-
- fprintf (file, "OPTION BASE %d\n",
- My->CurrentVersion->OptionBaseInteger);
- fprintf (file, "OPTION RECLEN %d\n",
- My->CurrentVersion->OptionReclenInteger);
- fprintf (file, "OPTION DATE \"%s\"\n",
- My->CurrentVersion->OptionDateFormat);
- fprintf (file, "OPTION TIME \"%s\"\n",
- My->CurrentVersion->OptionTimeFormat);
-
- c = My->CurrentVersion->OptionStringChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT STRING \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionDoubleChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT DOUBLE \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionSingleChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT SINGLE \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionCurrencyChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT CURRENCY \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionLongChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT LONG \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionIntegerChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT INTEGER \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionByteChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT BYTE \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionQuoteChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT QUOTE \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionCommentChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT COMMENT \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionStatementChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT STATEMENT \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionPrintChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT PRINT \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionInputChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT INPUT \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionImageChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT IMAGE \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionLparenChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT LPAREN \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionRparenChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT RPAREN \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionFilenumChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT FILENUM \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionAtChar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION PUNCT AT \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingDigit;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING DIGIT \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingComma;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING COMMA \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingPeriod;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING PERIOD \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingPlus;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING PLUS \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingMinus;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING MINUS \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingExrad;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING EXRAD \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingDollar;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING DOLLAR \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingFiller;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING FILLER \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingLiteral;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING LITERAL \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingFirst;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING FIRST \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingAll;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING ALL \"%c\"\n", c);
-
- c = My->CurrentVersion->OptionUsingLength;
- if (!bwb_isgraph (c))
- {
- c = ' ';
- };
- fprintf (file, "OPTION USING LENGTH \"%c\"\n", c);
-
- fprintf (file, "\n");
- fprintf (file, "\n");
- fflush (file);
- }
-
- LineType *
- bwb_MAINTAINER_MANUAL (LineType * l)
- {
-
- assert (l != NULL);
-
- DumpHeader (My->SYSPRN->cfp);
- DumpAllCommandSyntax (My->SYSPRN->cfp, FALSE,
- My->CurrentVersion->OptionVersionValue);
- DumpAllFunctionSyntax (My->SYSPRN->cfp, FALSE,
- My->CurrentVersion->OptionVersionValue);
- DumpAllOperatorSyntax (My->SYSPRN->cfp, FALSE,
- My->CurrentVersion->OptionVersionValue);
- return (l);
- }
-
- LineType *
- bwb_MAINTAINER_STACK (LineType * l)
- {
- /*
- dump the current execution stack,
- Leftmost is the top,
- Rigthmost is the bottom.
- */
- StackType *StackItem;
-
- assert (l != NULL);
-
- for (StackItem = My->StackHead; StackItem != NULL;
- StackItem = StackItem->next)
- {
- LineType *l;
-
- l = StackItem->line;
- if (l != NULL)
- {
- fprintf (My->SYSOUT->cfp, "%d:", l->number);
- }
- }
- fprintf (My->SYSOUT->cfp, "\n");
- ResetConsoleColumn ();
- return (l);
- }
-
-
- /***************************************************************
-
- FUNCTION: IntrinsicFunction_init()
-
- DESCRIPTION: This command initializes the function
- linked list, placing all predefined functions
- in the list.
-
- ***************************************************************/
-
- int
- IntrinsicFunction_init (void)
- {
- int n;
-
-
- for (n = 0; n < NUM_FUNCTIONS; n++)
- {
- IntrinsicFunctionDefinitionCheck (&(IntrinsicFunctionTable[n]));
- }
- return TRUE;
- }
-
-
-
- VariableType *
- IntrinsicFunction_deffn (int argc, VariableType * argv, UserFunctionType * f)
- {
- /*
- The generic handler for user defined functions.
- When called by exp_function(), f->id will be set to the line number of a specific DEF USR.
- */
- VariableType *v;
- VariableType *argn;
- int i;
- LineType *call_line;
- StackType *save_elevel;
-
- assert (argc >= 0);
- assert (argv != NULL);
- assert (f != NULL);
- assert(My != NULL);
-
- /* initialize the variable if necessary */
-
- /* these errors should not occur */
- if (f == NULL)
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- if (f->line == NULL)
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- if (argv == NULL)
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- if (f->ParameterCount == 0xFF)
- {
- /* VARIANT */
- }
- else if (argc != f->ParameterCount)
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- if (f->ParameterCount == 0xFF)
- {
- /* VARIANT */
- f->local_variable = argv;
- }
- else if (argc > 0)
- {
- v = f->local_variable;
- argn = argv;
- for (i = 0; i < argc; i++)
- {
- argn = argn->next;
- if (v == NULL)
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- if (argn == NULL)
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- if (VAR_IS_STRING (v) != VAR_IS_STRING (argn))
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- if (is_empty_string (v->name) == FALSE)
- {
- int IsError;
- IsError = 0;
- switch (v->VariableTypeCode)
- {
- case ByteTypeCode:
- IsError = NumberValueCheck (P1BYT, PARAM_NUMBER);
- break;
- case IntegerTypeCode:
- IsError = NumberValueCheck (P1INT, PARAM_NUMBER);
- break;
- case LongTypeCode:
- IsError = NumberValueCheck (P1LNG, PARAM_NUMBER);
- break;
- case CurrencyTypeCode:
- IsError = NumberValueCheck (P1CUR, PARAM_NUMBER);
- break;
- case SingleTypeCode:
- IsError = NumberValueCheck (P1FLT, PARAM_NUMBER);
- break;
- case DoubleTypeCode:
- IsError = NumberValueCheck (P1DBL, PARAM_NUMBER);
- break;
- case StringTypeCode:
- IsError = StringLengthCheck (P1ANY, PARAM_LENGTH);
- break;
- default:
- WARN_TYPE_MISMATCH;
- return NULL;
- }
- if (IsError != 0)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return argv;
- }
- }
- v = v->next;
- }
- }
- /* OK */
- call_line = f->line; /* line to call for function */
- call_line->position = f->startpos;
-
- if (call_line->cmdnum == C_DEF)
- {
- if (line_skip_EqualChar (call_line) == FALSE)
- {
- WARN_INTERNAL_ERROR;
- return NULL;
- }
- }
- /* PUSH STACK */
-
- save_elevel = My->StackHead;
- if (bwb_incexec ())
- {
- /* OK */
- My->StackHead->line = call_line;
- My->StackHead->ExecCode = EXEC_FUNCTION;
- }
- else
- {
- /* ERROR */
- WARN_OUT_OF_MEMORY;
- return NULL;
- }
-
-
- /* create variable chain */
- if (f->ParameterCount == 0xFF)
- {
- /* VARIANT */
- }
- else if (argc > 0)
- {
- VariableType *source = NULL; /* source variable */
- source = f->local_variable;
- argn = argv;
- for (i = 0; i < argc; i++)
- {
- argn = argn->next;
- /* copy the name */
- bwb_strcpy (argn->name, source->name);
-
- if (VAR_IS_STRING (source))
- {
- }
- else
- {
- int IsError;
- double Value;
- VariantType variant;
- CLEAR_VARIANT (&variant);
-
- if (var_get (argn, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return NULL;
- }
- if (variant.VariantTypeCode == StringTypeCode)
- {
- WARN_TYPE_MISMATCH;
- return NULL;
- }
- Value = variant.Number;
- IsError = 0;
- switch (source->VariableTypeCode)
- {
- case ByteTypeCode:
- IsError = NumberValueCheck (P1BYT, Value);
- Value = bwb_rint (Value);
- break;
- case IntegerTypeCode:
- IsError = NumberValueCheck (P1INT, Value);
- Value = bwb_rint (Value);
- break;
- case LongTypeCode:
- IsError = NumberValueCheck (P1LNG, Value);
- Value = bwb_rint (Value);
- break;
- case CurrencyTypeCode:
- IsError = NumberValueCheck (P1CUR, Value);
- Value = bwb_rint (Value);
- break;
- case SingleTypeCode:
- IsError = NumberValueCheck (P1FLT, Value);
- break;
- case DoubleTypeCode:
- IsError = NumberValueCheck (P1DBL, Value);
- break;
- case StringTypeCode:
- WARN_TYPE_MISMATCH;
- return NULL;
- /* break; */
- default:
- WARN_TYPE_MISMATCH;
- return NULL;
- }
- if (IsError != 0)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return argv;
- }
- variant.Number = Value;
- if (var_set (argn, &variant) == FALSE)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return NULL;
- }
- }
- source = source->next;
- }
- }
- if (call_line->cmdnum == C_DEF)
- {
- VariantType x;
- VariantType *X;
-
- X = &x;
- CLEAR_VARIANT (X);
- /* the function return variable is hidden */
- My->StackHead->local_variable = argv->next;
- /* var_islocal() uses the LoopTopLine to find local variables */
- My->StackHead->LoopTopLine = call_line; /* FUNCTION, SUB */
-
- /* evaluate the expression */
- if (line_read_expression (call_line, X) == FALSE) /* IntrinsicFunction_deffn */
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
-
- /* save the value */
- switch (X->VariantTypeCode)
- {
- case ByteTypeCode:
- case IntegerTypeCode:
- case LongTypeCode:
- case CurrencyTypeCode:
- case SingleTypeCode:
- case DoubleTypeCode:
- if (argv->VariableTypeCode == StringTypeCode)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- /* OK */
- {
- int IsError;
- double Value;
-
- IsError = 0;
- Value = X->Number;
- /* VerifyNumeric */
- if (isnan (Value))
- {
- /*** FATAL - INTERNAL ERROR - SHOULD NEVER HAPPEN ***/
- WARN_INTERNAL_ERROR;
- return FALSE;
- }
- if (isinf (Value))
- {
- /* - Evaluation of an expression results in an overflow
- * (nonfatal, the recommended recovery procedure is to supply
- * machine in- finity with the algebraically correct sign and
- * continue). */
- if (Value < 0)
- {
- Value = MINDBL;
- }
- else
- {
- Value = MAXDBL;
- }
- if (WARN_OVERFLOW)
- {
- /* ERROR */
- goto EXIT;
- }
- /* CONTINUE */
- }
- /* OK */
- switch (argv->VariableTypeCode)
- {
- case ByteTypeCode:
- IsError = NumberValueCheck (P1BYT, Value);
- Value = bwb_rint (Value);
- break;
- case IntegerTypeCode:
- IsError = NumberValueCheck (P1INT, Value);
- Value = bwb_rint (Value);
- break;
- case LongTypeCode:
- IsError = NumberValueCheck (P1LNG, Value);
- Value = bwb_rint (Value);
- break;
- case CurrencyTypeCode:
- IsError = NumberValueCheck (P1CUR, Value);
- Value = bwb_rint (Value);
- break;
- case SingleTypeCode:
- IsError = NumberValueCheck (P1FLT, Value);
- break;
- case DoubleTypeCode:
- IsError = NumberValueCheck (P1DBL, Value);
- break;
- default:
- WARN_TYPE_MISMATCH;
- goto EXIT;
- /* break; */
- }
- if (IsError != 0)
- {
- if (WARN_OVERFLOW)
- {
- /* ERROR */
- goto EXIT;
- }
- /* CONTINUE */
- }
- /* assign Value */
- RESULT_NUMBER = Value;
- }
- break;
- case StringTypeCode:
- if (argv->VariableTypeCode != StringTypeCode)
- {
- WARN_TYPE_MISMATCH;
- goto EXIT;
- }
- /* OK */
- if (RESULT_BUFFER != My->MaxLenBuffer)
- {
- WARN_INTERNAL_ERROR;
- goto EXIT;
- }
- if (X->Length > MAXLEN)
- {
- WARN_STRING_TOO_LONG; /* IntrinsicFunction_deffn */
- X->Length = MAXLEN;
- }
- bwb_memcpy (RESULT_BUFFER, X->Buffer, X->Length);
- RESULT_LENGTH = X->Length;
- break;
- default:
- WARN_TYPE_MISMATCH;
- goto EXIT;
- /* break; */
- }
- EXIT:
- RELEASE_VARIANT (X);
-
-
- /* break variable chain */
- My->StackHead->local_variable = NULL;
-
-
-
- /* POP STACK */
- bwb_decexec ();
-
- }
- else
- {
- /* the function return variable is visible */
- My->StackHead->local_variable = argv;
- /* var_islocal() uses the LoopTopLine to find local variables */
- My->StackHead->LoopTopLine = call_line; /* FUNCTION, SUB */
- /* execute until function returns */
- while (My->StackHead != save_elevel)
- {
- bwb_execline ();
- }
- }
-
- if (f->ParameterCount == 0xFF)
- {
- /* VARIANT */
- f->local_variable = NULL;
- }
-
- if (is_empty_string (argv->name) == FALSE)
- {
- int IsError;
-
- IsError = 0;
- switch (argv->VariableTypeCode)
- {
- case ByteTypeCode:
- IsError = NumberValueCheck (P1BYT, RESULT_NUMBER);
- break;
- case IntegerTypeCode:
- IsError = NumberValueCheck (P1INT, RESULT_NUMBER);
- break;
- case LongTypeCode:
- IsError = NumberValueCheck (P1LNG, RESULT_NUMBER);
- break;
- case CurrencyTypeCode:
- IsError = NumberValueCheck (P1CUR, RESULT_NUMBER);
- break;
- case SingleTypeCode:
- IsError = NumberValueCheck (P1FLT, RESULT_NUMBER);
- break;
- case DoubleTypeCode:
- IsError = NumberValueCheck (P1DBL, RESULT_NUMBER);
- break;
- case StringTypeCode:
- IsError = StringLengthCheck (P1ANY, RESULT_LENGTH);
- break;
- default:
- /* no check */
- break;
- }
- if (IsError != 0)
- {
- if (WARN_OVERFLOW)
- {
- /* ERROR */
- }
- /* CONTINUE */
- }
- }
- return argv;
- }
-
- /***************************************************************
-
- FUNCTION: IntrinsicFunction_find()
-
- DESCRIPTION: This C function attempts to locate
- a BASIC function with the specified name.
- If successful, it returns a pointer to
- the C structure for the BASIC function,
- if not successful, it returns NULL.
-
- ***************************************************************/
-
- extern int
- IntrinsicFunction_name (char *name)
- {
- /* search INTRINSIC functions */
- IntrinsicFunctionType *f;
- int i;
-
- assert (name != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
-
-
- #if THE_PRICE_IS_RIGHT
- /* start with the closest function, without going over */
- i = VarTypeIndex (name[0]);
- if (i < 0)
- {
- /* non-alpha */
- return FALSE;
- }
- i = My->IntrinsicFunctionStart[i]; /* first function starting with this letter */
- if (i < 0)
- {
- /* NOT FOUND */
- return FALSE;
- }
- #else /* THE_PRICE_IS_RIGHT */
- i = 0;
- #endif /* THE_PRICE_IS_RIGHT */
- for (; i < NUM_FUNCTIONS; i++)
- {
- f = &IntrinsicFunctionTable[i];
- if (My->CurrentVersion->OptionVersionValue & f->OptionVersionBitmask)
- {
- int result;
-
- result = bwb_stricmp (f->Name, name);
-
- if (result == 0)
- {
- /* FOUND */
- return TRUE;
- }
- if (result > 0 /* found > searched */ )
- {
- /* NOT FOUND */
- return FALSE;
- }
- }
- }
- /* NOT FOUND */
- return FALSE;
- }
-
-
- IntrinsicFunctionType *
- IntrinsicFunction_find_exact (char *name, int ParameterCount,
- ParamBitsType ParameterTypes)
- {
- IntrinsicFunctionType *f;
- int i;
-
- assert (name != NULL);
- assert(My != NULL);
- assert(My->CurrentVersion != NULL);
-
- /* search INTRINSIC functions */
- #if THE_PRICE_IS_RIGHT
- /* start with the closest function, without going over */
- i = VarTypeIndex (name[0]);
- if (i < 0)
- {
- /* non-alpha */
- return NULL;
- }
- i = My->IntrinsicFunctionStart[i]; /* first function starting with this letter */
- if (i < 0)
- {
- /* NOT FOUND */
- return NULL;
- }
- #else /* THE_PRICE_IS_RIGHT */
- i = 0;
- #endif /* THE_PRICE_IS_RIGHT */
- for (; i < NUM_FUNCTIONS; i++)
- {
- f = &IntrinsicFunctionTable[i];
- if (My->CurrentVersion->OptionVersionValue & f->OptionVersionBitmask)
- {
- if (f->ParameterCount == ParameterCount)
- {
- if (f->ParameterTypes == ParameterTypes)
- {
- int result;
-
- result = bwb_stricmp (f->Name, name);
-
- if (result == 0)
- {
- /* FOUND */
- return f;
- }
- if (result > 0 /* found > searched */ )
- {
- /* NOT FOUND */
- return NULL;
- }
- }
- }
- }
- }
- /* NOT FOUND */
- return NULL;
- }
-
- static VariableType *
- find_variable_by_type (char *name, int dimensions, char VariableTypeCode)
- {
- VariableType *v = NULL;
-
- assert (name != NULL);
-
- v = var_find (name, dimensions, FALSE);
- if (v)
- {
- if (VAR_IS_STRING (v))
- {
- if (VariableTypeCode == StringTypeCode)
- {
- /* found */
- return v;
- }
- }
- else
- {
- if (VariableTypeCode != StringTypeCode)
- {
- /* found */
- return v;
- }
- }
- }
- /* not found */
- return NULL;
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CHANGE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_CHANGE (LineType * l)
- {
- /* SYNTAX: CHANGE A$ TO X */
- /* SYNTAX: CHANGE X TO A$ */
- char varname[NameLengthMax + 1];
- VariableType *v;
- VariableType *A;
- VariableType *X;
- int IsStringToArray;
-
- assert (l != NULL);
-
- v = NULL;
- A = NULL;
- X = NULL;
- IsStringToArray = FALSE;
-
- /* get 1st variable */
- if (line_read_varname (l, varname) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- v = find_variable_by_type (varname, 0, StringTypeCode);
- if (v)
- {
- /* STRING to ARRAY */
- A = v;
- IsStringToArray = TRUE;
- }
- else
- {
- /* ARRAY to STRING */
- v = find_variable_by_type (varname, 1, DoubleTypeCode);
- if (v)
- {
- X = v;
- IsStringToArray = FALSE;
- }
- }
- if (v == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
-
- /* get "TO" */
- if (line_skip_word (l, "TO") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- /* get 2nd variable */
- if (line_read_varname (l, varname) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
-
- if (IsStringToArray)
- {
- /* STRING to ARRAY */
- v = find_variable_by_type (varname, 1, DoubleTypeCode);
- if (v == NULL)
- {
- v = var_find (varname, 1, TRUE);
- }
- if (v)
- {
- X = v;
- }
- }
- else
- {
- /* ARRAY to STRING */
- v = find_variable_by_type (varname, 0, StringTypeCode);
- if (v == NULL)
- {
- v = var_find (varname, 0, TRUE);
- }
- if (v)
- {
- A = v;
- }
- }
-
- if (v == NULL)
- {
- WARN_VARIABLE_NOT_DECLARED;
- return (l);
- }
- assert(A != NULL);
- assert(X != NULL);
- if (IsStringToArray)
- {
- /* CHANGE A$ TO X */
- int i;
- int n;
- char *a;
- DoubleType *x;
- unsigned long t;
-
- if (A->Value.String == NULL)
- {
- WARN_INTERNAL_ERROR;
- return (l);
- }
- if (A->Value.String->sbuffer == NULL)
- {
- WARN_INTERNAL_ERROR;
- return (l);
- }
- /* variable storage is a mess, we bypass that tradition here. */
- t = 1;
- for (n = 0; n < X->dimensions; n++)
- {
- t *= X->UBOUND[n] - X->LBOUND[n] + 1;
- }
- if (t <= A->Value.String->length)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- n = A->Value.String->length;
- a = A->Value.String->sbuffer;
- x = X->Value.Number;
- *x = n;
- x++;
- for (i = 0; i < n; i++)
- {
- char C;
- DoubleType V;
-
- C = *a;
- V = C;
- *x = V;
- x++;
- a++;
- }
- }
- else
- {
- /* CHANGE X TO A$ */
- int i;
- int n;
- char *a;
- DoubleType *x;
- unsigned long t;
-
- /* variable storage is a mess, we bypass that tradition here. */
- t = 1;
- for (n = 0; n < X->dimensions; n++)
- {
- t *= X->UBOUND[n] - X->LBOUND[n] + 1;
- }
- if (t <= 1)
- {
- WARN_SUBSCRIPT_OUT_OF_RANGE;
- return (l);
- }
- if (t > MAXLEN)
- {
- WARN_STRING_TOO_LONG; /* bwb_CHANGE */
- t = MAXLEN;
- }
- if (A->Value.String == NULL)
- {
- if ((A->Value.String =
- (StringType *) calloc (1, sizeof (StringType))) == NULL)
- {
- WARN_OUT_OF_MEMORY;
- return (l);
- }
- A->Value.String->sbuffer = NULL;
- A->Value.String->length = 0;
- }
- if (A->Value.String->sbuffer != NULL)
- {
- free (A->Value.String->sbuffer);
- A->Value.String->sbuffer = NULL;
- A->Value.String->length = 0;
- }
- if (A->Value.String->sbuffer == NULL)
- {
- A->Value.String->length = 0;
- if ((A->Value.String->sbuffer =
- (char *) calloc (t + 1 /* NulChar */ , sizeof (char))) == NULL)
- {
- WARN_OUT_OF_MEMORY;
- return (l);
- }
- }
- a = A->Value.String->sbuffer;
- x = X->Value.Number;
- n = (int) bwb_rint (*x);
- if (n > MAXLEN)
- {
- WARN_STRING_TOO_LONG; /* bwb_CHANGE */
- n = MAXLEN;
- }
- A->Value.String->length = n;
- x++;
- for (i = 0; i < n; i++)
- {
- char C;
- DoubleType V;
-
- V = *x;
- C = V;
- *a = C;
- x++;
- a++;
- }
- }
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CONSOLE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_CONSOLE (LineType * l)
- {
- /* SYNTAX: CONSOLE */
- /* SYNTAX: CONSOLE WIDTH width */
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- assert(My->SYSOUT != NULL);
- assert(My->SYSOUT->cfp != NULL);
-
-
- if (My->IsPrinter == TRUE)
- {
- /* reset printer column */
- if (My->SYSPRN->col != 1)
- {
- fputc ('\n', My->SYSPRN->cfp);
- My->SYSPRN->col = 1;
- }
- My->IsPrinter = FALSE;
- }
- if (line_skip_word (l, "WIDTH"))
- {
- int width;
-
- width = 0;
- if (line_read_integer_expression (l, &width) == FALSE)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- if (width < 0)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- My->SYSOUT->width = width;
- }
-
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- LPRINTER
- --------------------------------------------------------------------------------------------
- */
-
-
- LineType *
- bwb_LPRINTER (LineType * l)
- {
- /* SYNTAX: LPRINTER */
- /* SYNTAX: LPRINTER WIDTH width */
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSPRN != NULL);
- assert(My->SYSPRN->cfp != NULL);
- assert(My->SYSOUT != NULL);
- assert(My->SYSOUT->cfp != NULL);
-
-
- if (My->IsPrinter == FALSE)
- {
- /* reset console column */
- if (My->SYSOUT->col != 1)
- {
- fputc ('\n', My->SYSOUT->cfp);
- My->SYSOUT->col = 1;
- }
- My->IsPrinter = TRUE;
- }
- if (line_skip_word (l, "WIDTH"))
- {
- int width;
-
- width = 0;
- if (line_read_integer_expression (l, &width) == FALSE)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- if (width < 0)
- {
- WARN_ILLEGAL_FUNCTION_CALL;
- return (l);
- }
- My->SYSPRN->width = width;
- }
- return (l);
- }
-
- extern void
- bwb_fclose (FILE * file)
- {
- if (file == NULL)
- {
- /* don't close */
- }
- else if (file == stdin)
- {
- /* don't close */
- }
- else if (file == stdout)
- {
- /* don't close */
- }
- else if (file == stderr)
- {
- /* don't close */
- }
- else
- {
- fclose (file);
- }
- }
- LineType *
- bwb_LPT (LineType * l)
- {
- /* SYNTAX: LPT */
- /* SYNTAX: LPT filename$ */
- FILE *file;
- char *filename;
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSOUT != NULL);
- assert(My->SYSOUT->cfp != NULL);
-
-
- file = NULL;
- filename = NULL;
- if (line_is_eol (l))
- {
- /* OK */
- file = stderr;
- }
- else if (line_read_string_expression (l, &filename))
- {
- /* OK */
- if (is_empty_string (filename))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- file = fopen (filename, "w");
- free (filename);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (file == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- bwb_fclose (My->SYSOUT->cfp);
- My->SYSOUT->cfp = file;
- return (l);
- }
-
- LineType *
- bwb_PTP (LineType * l)
- {
- /* SYNTAX: PTP */
- /* SYNTAX: PTP filename$ */
- FILE *file;
- char *filename;
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSOUT != NULL);
- assert(My->SYSOUT->cfp != NULL);
-
- file = NULL;
- filename = NULL;
- if (line_is_eol (l))
- {
- /* OK */
- file = fopen ("PTP", "w");
- }
- else if (line_read_string_expression (l, &filename))
- {
- /* OK */
- if (is_empty_string (filename))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- file = fopen (filename, "w");
- free (filename);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (file == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- bwb_fclose (My->SYSOUT->cfp);
- My->SYSOUT->cfp = file;
- return (l);
- }
-
- LineType *
- bwb_PTR (LineType * l)
- {
- /* SYNTAX: PTR */
- /* SYNTAX: PTR filename$ */
- FILE *file;
- char *filename;
-
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- file = NULL;
- filename = NULL;
- if (line_is_eol (l))
- {
- /* OK */
- file = fopen ("PTR", "r");
- }
- else if (line_read_string_expression (l, &filename))
- {
- /* OK */
- if (is_empty_string (filename))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- file = fopen (filename, "r");
- free (filename);
- }
- else
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (file == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- bwb_fclose (My->SYSIN->cfp);
- My->SYSIN->cfp = file;
- return (l);
- }
-
- LineType *
- bwb_TTY (LineType * l)
- {
- /* SYNTAX: TTY */
- assert (l != NULL);
-
- bwb_TTY_IN (l);
- bwb_TTY_OUT (l);
- return (l);
- }
-
- LineType *
- bwb_TTY_IN (LineType * l)
- {
- /* SYNTAX: TTY IN */
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSIN != NULL);
- assert(My->SYSIN->cfp != NULL);
-
- bwb_fclose (My->SYSIN->cfp);
- My->SYSIN->cfp = stdin;
- return (l);
- }
-
- LineType *
- bwb_TTY_OUT (LineType * l)
- {
- /* SYNTAX: TTY OUT */
- assert (l != NULL);
- assert(My != NULL);
- assert(My->SYSOUT != NULL);
- assert(My->SYSOUT->cfp != NULL);
-
- bwb_fclose (My->SYSOUT->cfp);
- My->SYSOUT->cfp = stdout;
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- CREATE
- --------------------------------------------------------------------------------------------
- */
-
- LineType *
- bwb_CREATE (LineType * l)
- {
- /* SYNTAX: CREATE filename$ [ RECL reclen ] AS filenum [ BUFF number ] [ RECS size ] */
- int FileNumber;
- int width;
- int buffnum;
- int recsnum;
- char *filename;
-
- assert (l != NULL);
- assert(My != NULL);
-
-
- FileNumber = 0;
- width = 0;
- buffnum = 0;
- recsnum = 0;
- filename = NULL;
- if (line_read_string_expression (l, &filename) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (is_empty_string (filename))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (line_skip_word (l, "RECL"))
- {
- if (line_read_integer_expression (l, &width) == FALSE)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- if (width <= 0)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- }
- if (line_skip_word (l, "AS") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- return (l);
- }
- if (line_read_integer_expression (l, &FileNumber) == FALSE)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (FileNumber <= 0)
- {
- WARN_BAD_FILE_NUMBER;
- return (l);
- }
- if (line_skip_word (l, "BUFF"))
- {
- if (line_read_integer_expression (l, &buffnum) == FALSE)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- if (buffnum <= 0)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- }
- if (line_skip_word (l, "RECS"))
- {
- if (line_read_integer_expression (l, &recsnum) == FALSE)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- if (recsnum <= 0)
- {
- WARN_FIELD_OVERFLOW;
- return (l);
- }
- }
- /* now, we are ready to create the file */
- My->CurrentFile = find_file_by_number (FileNumber);
- if (My->CurrentFile == NULL)
- {
- My->CurrentFile = file_new ();
- My->CurrentFile->FileNumber = FileNumber;
- }
- if (My->CurrentFile->FileName != NULL)
- {
- free (My->CurrentFile->FileName);
- My->CurrentFile->FileName = NULL;
- }
- My->CurrentFile->FileName = filename;
- filename = NULL;
- if (My->CurrentFile->DevMode != DEVMODE_CLOSED)
- {
- My->CurrentFile->DevMode = DEVMODE_CLOSED;
- }
- if (My->CurrentFile->cfp != NULL)
- {
- bwb_fclose (My->CurrentFile->cfp);
- My->CurrentFile->cfp = NULL;
- }
- if (My->CurrentFile->buffer != NULL)
- {
- free (My->CurrentFile->buffer);
- My->CurrentFile->buffer = NULL;
- }
- My->CurrentFile->width = 0;
- My->CurrentFile->col = 1;
- My->CurrentFile->row = 1;
- My->CurrentFile->delimit = ',';
- /* truncate to zero length or create text file for update (reading and writing) */
- if (is_empty_string (My->CurrentFile->FileName))
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if ((My->CurrentFile->cfp =
- fopen (My->CurrentFile->FileName, "w+")) == NULL)
- {
- WARN_BAD_FILE_NAME;
- return (l);
- }
- if (width > 0)
- {
- My->CurrentFile->width = width;
- My->CurrentFile->DevMode = DEVMODE_RANDOM;
- }
- else
- {
- My->CurrentFile->DevMode = DEVMODE_INPUT | DEVMODE_OUTPUT;
- }
- return (l);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- COPY
- --------------------------------------------------------------------------------------------
- */
-
- static void
- bwb_copy_file (char *Source, char *Target)
- {
- FILE *source;
- FILE *target;
-
- source = NULL;
- target = NULL;
-
- if (is_empty_string (Source))
- {
- WARN_BAD_FILE_NAME;
- goto EXIT;
- }
- if (is_empty_string (Target))
- {
- WARN_BAD_FILE_NAME;
- goto EXIT;
- }
- source = fopen (Source, "rb");
- if (source == NULL)
- {
- WARN_BAD_FILE_NAME;
- goto EXIT;
- }
- target = fopen (Target, "wb");
- if (target == NULL)
- {
- WARN_BAD_FILE_NAME;
- goto EXIT;
- }
- /* OK */
- while (TRUE)
- {
- int C;
-
- C = fgetc (source);
- if (C < 0 /* EOF */ || feof (source) || ferror (source))
- {
- break;
- }
- fputc (C, target);
- if (ferror (target))
- {
- break;
- }
- }
- /* DONE */
- EXIT:
- if (source)
- {
- fclose (source);
- }
- if (target)
- {
- fclose (target);
- }
- }
-
- LineType *
- bwb_COPY (LineType * Line)
- {
- /* SYNTAX: COPY source$ TO target$ */
- char *Source;
- char *Target;
-
- assert (Line != NULL);
-
- Source = NULL;
- Target = NULL;
- if (line_read_string_expression (Line, &Source) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
- if (line_skip_word (Line, "TO") == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
- if (line_read_string_expression (Line, &Target) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
- bwb_copy_file (Source, Target);
- EXIT:
- if (Source)
- {
- free (Source);
- }
- if (Target)
- {
- free (Target);
- }
- return (Line);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- DISPLAY
- --------------------------------------------------------------------------------------------
- */
-
- static void
- bwb_display_file (char *Source)
- {
- FILE *source;
-
- assert (My->SYSOUT != NULL);
- assert (My->SYSOUT->cfp != NULL);
-
- source = NULL;
-
- if (is_empty_string (Source))
- {
- WARN_BAD_FILE_NAME;
- goto EXIT;
- }
- source = fopen (Source, "rb");
- if (source == NULL)
- {
- WARN_BAD_FILE_NAME;
- goto EXIT;
- }
- /* OK */
- while (TRUE)
- {
- int C;
-
- C = fgetc (source);
- if (C < 0 /* EOF */ || feof (source) || ferror (source))
- {
- break;
- }
- fputc (C, My->SYSOUT->cfp);
- }
- /* DONE */
- EXIT:
- if (source)
- {
- fclose (source);
- }
- }
-
- LineType *
- bwb_DISPLAY (LineType * Line)
- {
- /* SYNTAX: DISPLAY source$ */
- char *Source;
-
- assert (Line != NULL);
- Source = NULL;
- if (line_read_string_expression (Line, &Source) == FALSE)
- {
- WARN_SYNTAX_ERROR;
- goto EXIT;
- }
- bwb_display_file (Source);
- EXIT:
- if (Source)
- {
- free (Source);
- }
- return (Line);
- }
-
- /*
- --------------------------------------------------------------------------------------------
- EOF
- --------------------------------------------------------------------------------------------
- */
-
-
-
- /* EOF */
|