1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678 |
- #
- .sect .text
- .sect .rom
- .sect .data
- .sect .bss
- .sect .text
- ! This program is an EM interpreter for the Z80.
- ! Register pair bc is used to hold lb.
- ! Register ix is used to hold the EM program counter.
- ! The interpreter assumes 16-bit words and 16-bit pointers.
- ! #define CPM1 1
- ! Definitions:
- zone = 8 ! size of subroutine call block (address + old lb)
- bdos = 5 ! standard entry into I/O-routines
- boot = 0
- fcb = 0x5c ! file descriptor of EM-1 file (5C hex)
- reset=0
- delete=19
- makefile=22
- close=16
- readconsole = 10
- writeconsole = 2
- open = 15
- read = 20
- write = 21
- setdma = 26
- printstring = 9
- seqread = 20
- randomread = 33
- seqwrite = 21
- randomwrite = 34
- consolein = 1
- diconio = 6
- RAW=0 !0 for cooked,1 for raw io
- timebuf=0xFFDE
- b_lolp = 176
- b_loln = 179
- b_lof = 161
- b_loi = 168
- b_lal = 130
- b_lil = 146
- b_stlm = 227
- b_stf = 214
- b_sti = 218
- b_inl = 112
- b_cal = 63
- b_asp = 44
- b_zrl = 249
- EARRAY = 0
- ERANGE = 1
- EILLINS=18
- EILLSIZE=19
- ECASE=20
- EMON=25
- !--------------------------- Initialization ---------------------------
- jp init ! 3 byte instruction.
- !------------------------- MAIN DISPATCH ------------------------------
- !
- ! must be put in a suitable place in memory to reduce memory usage
- ! must be put on a page boundary
- .data1 0 ! fourth byte
- dispat = . - 4 ! base of dispatch table
- ! .data2 loc.0
- ! .data2 loc.1
- .data2 loc.2
- .data2 loc.3
- .data2 loc.4
- .data2 loc.5
- .data2 loc.6
- .data2 loc.7
- .data2 loc.8
- .data2 loc.9
- .data2 loc.10
- .data2 loc.11
- .data2 loc.12
- .data2 loc.13
- .data2 loc.14
- .data2 loc.15
- .data2 loc.16
- .data2 loc.17
- .data2 loc.18
- .data2 loc.19
- .data2 loc.20
- .data2 loc.21
- .data2 loc.22
- .data2 loc.23
- .data2 loc.24
- .data2 loc.25
- .data2 loc.26
- .data2 loc.27
- .data2 loc.28
- .data2 loc.29
- .data2 loc.30
- .data2 loc.31
- .data2 loc.32
- .data2 loc.33
- .data2 aar.2
- .data2 adf.s0
- .data2 adi.2
- .data2 adi.4
- .data2 adp.l
- .data2 adp.1
- .data2 adp.2
- .data2 adp.s0
- .data2 adp.sm1
- .data2 ads.2
- .data2 and.2
- .data2 asp.2
- .data2 asp.4
- .data2 asp.6
- .data2 asp.8
- .data2 asp.10
- .data2 asp.w0
- .data2 beq.l
- .data2 beq.s0
- .data2 bge.s0
- .data2 bgt.s0
- .data2 ble.s0
- .data2 blm.s0
- .data2 blt.s0
- .data2 bne.s0
- .data2 bra.l
- .data2 bra.sm1
- .data2 bra.sm2
- .data2 bra.s0
- .data2 bra.s1
- .data2 cal.1
- .data2 cal.2
- .data2 cal.3
- .data2 cal.4
- .data2 cal.5
- .data2 cal.6
- .data2 cal.7
- .data2 cal.8
- .data2 cal.9
- .data2 cal.10
- .data2 cal.11
- .data2 cal.12
- .data2 cal.13
- .data2 cal.14
- .data2 cal.15
- .data2 cal.16
- .data2 cal.17
- .data2 cal.18
- .data2 cal.19
- .data2 cal.20
- .data2 cal.21
- .data2 cal.22
- .data2 cal.23
- .data2 cal.24
- .data2 cal.25
- .data2 cal.26
- .data2 cal.27
- .data2 cal.28
- .data2 cal.s0
- .data2 cff.z
- .data2 cif.z
- .data2 cii.z
- .data2 cmf.s0
- .data2 cmi.2
- .data2 cmi.4
- .data2 cmp.z
- .data2 cms.s0
- .data2 csa.2
- .data2 csb.2
- .data2 dec.z
- .data2 dee.w0
- .data2 del.wm1
- .data2 dup.2
- .data2 dvf.s0
- .data2 dvi.2
- .data2 fil.l
- .data2 inc.z
- .data2 ine.l
- .data2 ine.w0
- .data2 inl.m2
- .data2 inl.m4
- .data2 inl.m6
- .data2 inl.wm1
- .data2 inn.s0
- .data2 ior.2
- .data2 ior.s0
- .data2 lae.l
- .data2 lae.w0
- .data2 lae.w1
- .data2 lae.w2
- .data2 lae.w3
- .data2 lae.w4
- .data2 lae.w5
- .data2 lae.w6
- .data2 lal.p
- .data2 lal.n
- .data2 lal.0
- .data2 lal.m1
- .data2 lal.w0
- .data2 lal.wm1
- .data2 lal.wm2
- .data2 lar.2
- .data2 ldc.0
- .data2 lde.l
- .data2 lde.w0
- .data2 ldl.0
- .data2 ldl.wm1
- .data2 lfr.2
- .data2 lfr.4
- .data2 lfr.s0
- .data2 lil.wm1
- .data2 lil.w0
- .data2 lil.0
- .data2 lil.2
- .data2 lin.l
- .data2 lin.s0
- .data2 lni.z
- .data2 loc.l
- .data2 loc.m1
- .data2 loc.s0
- .data2 loc.sm1
- .data2 loe.l
- .data2 loe.w0
- .data2 loe.w1
- .data2 loe.w2
- .data2 loe.w3
- .data2 loe.w4
- .data2 lof.l
- .data2 lof.2
- .data2 lof.4
- .data2 lof.6
- .data2 lof.8
- .data2 lof.s0
- .data2 loi.l
- .data2 loi.1
- .data2 loi.2
- .data2 loi.4
- .data2 loi.6
- .data2 loi.8
- .data2 loi.s0
- .data2 lol.p
- .data2 lol.n
- .data2 lol.0
- .data2 lol.2
- .data2 lol.4
- .data2 lol.6
- .data2 lol.m2
- .data2 lol.m4
- .data2 lol.m6
- .data2 lol.m8
- .data2 lol.m10
- .data2 lol.m12
- .data2 lol.m14
- .data2 lol.m16
- .data2 lol.w0
- .data2 lol.wm1
- .data2 lxa.1
- .data2 lxl.1
- .data2 lxl.2
- .data2 mlf.s0
- .data2 mli.2
- .data2 mli.4
- .data2 rck.2
- .data2 ret.0
- .data2 ret.2
- .data2 ret.s0
- .data2 rmi.2
- .data2 sar.2
- .data2 sbf.s0
- .data2 sbi.2
- .data2 sbi.4
- .data2 sdl.wm1
- .data2 set.s0
- .data2 sil.wm1
- .data2 sil.w0
- .data2 sli.2
- .data2 ste.l
- .data2 ste.w0
- .data2 ste.w1
- .data2 ste.w2
- .data2 stf.l
- .data2 stf.2
- .data2 stf.4
- .data2 stf.s0
- .data2 sti.1
- .data2 sti.2
- .data2 sti.4
- .data2 sti.6
- .data2 sti.8
- .data2 sti.s0
- .data2 stl.p
- .data2 stl.n
- .data2 stl.p0
- .data2 stl.p2
- .data2 stl.m2
- .data2 stl.m4
- .data2 stl.m6
- .data2 stl.m8
- .data2 stl.m10
- .data2 stl.wm1
- .data2 teq.z
- .data2 tgt.z
- .data2 tlt.z
- .data2 tne.z
- .data2 zeq.l
- .data2 zeq.s0
- .data2 zeq.s1
- .data2 zer.s0
- .data2 zge.s0
- .data2 zgt.s0
- .data2 zle.s0
- .data2 zlt.s0
- .data2 zne.s0
- .data2 zne.sm1
- .data2 zre.l
- .data2 zre.w0
- .data2 zrl.m2
- .data2 zrl.m4
- .data2 zrl.wm1
- .data2 zrl.n
- .data2 loop1
- .data2 loop2
- !----------------- END OF MAIN DISPATCH -------------------------------
- xxx:
- .data2 loc.0
- .data2 loc.1
- init:
- ld sp,(bdos+1) ! address of fbase
- ld hl,xxx
- ld de,dispat
- ld bc,4
- ldir
- call uxinit
- warmstart:
- ld sp,(bdos+1) ! address of fbase
- call makeargv
- ld de,0x80
- ld c,setdma
- call bdos
- ld c,open
- ld de,fcb
- call bdos
- inc a
- jr z,bademfile
- ld c,read
- ld de,fcb
- call bdos
- or a
- jr nz,bademfile ! no file
- ld de,header
- ld hl,0x90 ! start of 2nd half of header
- ld bc,10 ! we copy only first 5 words
- ldir
- ld de,(ntext) ! size of program text in bytes
- ld hl,0
- sbc hl,de
- add hl,sp
- ld sp,hl ! save space for program
- ld (pb),hl ! set procedure base
- ld a,0xa0
- ld (nextp),a
- ld de,(ntext)
- xor a
- ld h,a
- ld l,a
- sbc hl,de
- ex de,hl
- ld h,a
- ld l,a
- add hl,sp
- 1: call getb
- ld (hl),c
- inc hl
- inc e
- jr nz,1b
- inc d
- jr nz,1b
- ! now program text has been read,so start read-
- ld iy,0 ! ing data descriptors, (nextp) (was hl) is
- ld ix,eb ! pointer into DMA,ix is pointer into global
- ! data area,iy is #bytes pushed in last instr (used for repeat)
- rddata: ld hl,(ndata)
- ld a,h
- or l
- jr z,prdes ! no data left
- dec hl
- ld (ndata),hl
- call getb ! read 1 byte (here:init type) into register c
- dec c
- jp p,2f
- call getw
- push iy
- pop hl
- ld a,h
- or l
- jr z,5f ! size of block is zero, so no work
- push hl
- push bc
- 3: pop hl ! #repeats
- pop bc ! block size
- push bc
- ld a,h
- or l
- jr z,4f ! ready
- dec hl
- push hl
- push ix
- pop hl
- add ix,bc
- dec hl
- ld d,h
- ld e,l
- add hl,bc
- ex de,hl
- lddr
- jr 3b
- 4: pop bc
- 5: ld iy,0 ! now last instruction = repeat = type 0
- jr rddata
- 2: ld b,c ! here other types come
- jr nz,2f ! Z-flag was (re-)set when decrementing c
- call getb ! uninitialized words, fetch #words
- sla c
- rl b
- ld iy,0
- add iy,bc
- add ix,bc
- 4: jr rddata
- 2: call getb ! remaining types, first fetch #bytes/words
- ld a,b
- cp 7
- jr z,rdflt
- jp p,bademfile ! floats are not accepted,nor are illegal types
- ld b,0
- cp 1
- jr z,2f
- cp 5
- jp m,1f
- 2: ld iy,0 ! initialized bytes, simply copy from EM-1 file
- add iy,bc
- ld b,c ! #bytes
- 3:
- call getb
- ld (ix),c
- inc ix
- djnz 3b
- jr 4b
- 1: cp 2
- jr z,2f
- cp 3
- jr z,3f
- ld hl,(pb)
- jr 4f
- 3: ld hl,eb
- jr 4f
- 2: ld hl,0
- 4: ld (ntext),hl ! ntext is used here to hold base address of
- ld iy,0 ! correct type: data,instr or 0 (plain numbers)
- add iy,bc
- add iy,bc
- ld b,c
- 1:
- push bc
- ex de,hl ! save e into l
- call getw
- ex de,hl
- ld hl,(ntext)
- add hl,bc
- ld (ix),l
- inc ix
- ld (ix),h
- inc ix
- pop bc
- djnz 1b
- 2: jr rddata
- rdflt:
- ld a,c
- cp 4
- jr nz,bademfile
- push ix
- pop hl
- 1: call getb
- ld a,c
- ld (hl),a
- inc hl
- or a
- jr nz,1b
- push ix
- pop hl
- call atof
- ld b,4
- 1: ld a,(hl)
- ld (ix),a
- inc ix
- inc hl
- djnz 1b
- jr rddata
- bademfile:
- ld c,printstring
- ld de,1f
- call bdos
- jp 0
- 1: .ascii 'load file error\r\n$'
- ! now all data has been read,so on with the procedure descriptors
- prdes:
- ld (hp),ix ! initialize heap pointer
- ld de,(nproc)
- ld hl,0
- xor a
- sbc hl,de
- add hl,hl
- add hl,hl ! 4 bytes per proc-descriptor
- add hl,sp
- ld sp,hl ! save space for procedure descriptors
- push hl
- pop ix
- ld (pd),hl ! initialize base
- ld hl,(nproc)
- 1: ld a,h
- or l
- jr z,2f
- dec hl
- call getb
- ld (ix),c
- inc ix
- call getb
- ld (ix),c
- inc ix
- call getw
- ex de,hl
- ld hl,(pb)
- add hl,bc
- ld (ix),l
- inc ix
- ld (ix),h
- inc ix
- ex de,hl
- jr 1b
- 2:
- ld de,(entry) ! get ready for start of program
- ld ix,0 ! reta, jumping here will stop execution
- push ix
- ld hl,argv
- push hl
- ld hl,(argc)
- push hl
- jr cal ! call EM-1 main program
- getw: call getb
- ld b,c
- call getb
- ld a,b
- ld b,c
- ld c,a
- ret
- getb: push hl ! getb reads 1 byte in register c from standard
- push de
- ld a,(nextp) ! DMA buffer and refills if necessary
- or a
- jr nz,1f
- push bc
- ld c,read
- ld de,fcb
- call bdos
- or a
- jr nz,bademfile
- pop bc
- ld a,0x80
- 1: ld l,a
- ld h,0
- ld c,(hl)
- inc a
- ld (nextp),a
- pop de
- pop hl
- ret
- !------------------------- Main loop of the interpreter ---------------
- phl: push hl
- loop: ld e,(ix) ! e = opcode byte
- inc ix ! advance EM program counter to next byte
- ld hl,dispat ! hl = address of dispatching table
- xor a
- ld d,a
- add hl,de ! compute address of routine for this opcode
- add hl,de ! hl = address of routine to dispatch to
- ld d,(hl) ! e = low byte of routine address
- inc hl ! hl now points to 2nd byte of routine address
- ld h,(hl) ! h = high byte of routine address
- ld l,d ! hl = address of routine
- ld d,a
- jp (hl) ! go execute the routine
- loop1: ld e,(ix) ! e = opcode byte
- inc ix ! advance EM program counter to next byte
- ld hl,dispat1 ! hl = address of dispatching table
- xor a
- ld d,a
- add hl,de ! compute address of routine for this opcode
- add hl,de ! hl = address of routine to dispatch to
- ld d,(hl) ! e = low byte of routine address
- inc hl ! hl now points to 2nd byte of routine address
- ld h,(hl) ! h = high byte of routine address
- ld l,d ! hl = address of routine
- ld d,a
- jp (hl) ! go execute the routine
- loop2: ld e,(ix) ! e = opcode byte
- inc ix ! advance EM program counter to next byte
- ld hl,dispat2 ! hl = address of dispatching table
- xor a
- ld d,a
- add hl,de ! compute address of routine for this opcode
- add hl,de ! hl = address of routine to dispatch to
- ld d,(hl) ! e = low byte of routine address
- inc hl ! hl now points to 2nd byte of routine address
- ld h,(hl) ! h = high byte of routine address
- ld l,d ! hl = address of routine
- ld d,a
- jp (hl) ! go execute the routine
- ! Note that d and a are both still 0, and the carry bit is cleared.
- ! The execution routines make heavy use of these properties.
- ! The reason that the carry bit is cleared is a little subtle, since the
- ! two instructions add hl,de affect it. However, since dispat is being
- ! added twice a number < 256, no carry can occur.
- !---------------------- Routines to compute addresses of locals -------
- ! There are four addressing routines, corresponding to four ways the
- ! offset can be represented:
- ! loml: 16-bit offset. Codes 1-32767 mean offsets -2 to -65534 bytes
- ! loms: 8-bit offset. Codes 1-255 mean offsets -2 to -510 bytes
- ! lopl: 16-bit offset. Codes 0-32767 mean offsets 0 to +65534 bytes
- ! lops: 8-bit offset. Codes 0-255 mean offsets 0 to +510 bytes
- loml: ld d,(ix) ! loml is for 16-bit offsets with implied minus
- inc ix
- jr 1f
- loms:
- dec d
- 1: ld e,(ix) ! loms is for 8-bit offsets with implied minus
- inc ix
- ld h,b
- ld l,c ! hl = bc
- add hl,de
- add hl,de ! hl now equals lb - byte offset
- jp (iy)
- lopl: ld d,(ix) ! lopl is for 16-bit offsets >= 0
- inc ix
- lops: ld h,d
- ld l,(ix) ! fetch low order byte of offset
- inc ix
- add hl,hl ! convert offset to bytes
- ld de,zone ! to account of return address zone
- add hl,de
- add hl,bc ! hl now equals lb - byte offset
- jp (iy)
- !---------------------------- LOADS -----------------------------------
- ! LOC, LPI
- loc.l: lpi.l:
- ld d,(ix) ! loc with 16-bit offset
- inc ix
- loc.s0: ld e,(ix) ! loc with 8-bit offset
- inc ix
- loc.0: loc.1: loc.2: loc.3: loc.4: loc.5: loc.6: loc.7:
- loc.8: loc.9: loc.10: loc.11: loc.12: loc.13: loc.14: loc.15:
- loc.16: loc.17: loc.18: loc.19: loc.20: loc.21: loc.22: loc.23:
- loc.24: loc.25: loc.26: loc.27: loc.28: loc.29: loc.30: loc.31:
- loc.32: loc.33:
- push de
- jr loop
- loc.m1: ld hl,-1
- jr phl
- loc.sm1:dec d ! for constants -256...-1
- jr loc.s0
- ! LDC
- ldc.f: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- push hl
- ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- jr phl
- ldc.l: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- ld e,d
- bit 7,h
- jr z,1f
- dec de
- 1:
- push de
- jr phl
- ldc.0: ld e,d
- push de
- push de
- jr loop
- ! LOL
- lol.0: lol.1: lol.2: lol.3: lol.4: lol.5: lol.6:
- ld hl,-b_lolp-b_lolp+zone
- add hl,de
- add hl,de
- add hl,bc
- jr ipsh
- lol.m2: lol.m4: lol.m6: lol.m8: lol.m10: lol.m12: lol.m14: lol.m16:
- ld hl,b_loln+b_loln
- sbc hl,de
- xor a ! clear carry bit
- sbc hl,de
- add hl,bc ! hl = lb - byte offset
- ipsh: ld e,(hl)
- inc hl
- ld d,(hl)
- push de
- jr loop
- lol.wm1:ld iy,ipsh
- jr loms
- lol.n: ld iy,ipsh
- jr loml
- lol.w0: ld iy,ipsh
- jr lops
- lol.p: ld iy,ipsh
- jr lopl
- ! LOE
- loe.w4: inc d
- loe.w3: inc d
- loe.w2: inc d
- loe.w1: inc d
- loe.w0: ld e,(ix)
- inc ix
- ld hl,eb
- add hl,de
- add hl,de
- jr ipsh
- loe.l: ld d,(ix)
- inc ix
- jr loe.w0
- ! LOF
- lof.2: lof.4: lof.6: lof.8:
- ld hl,-b_lof-b_lof ! assume lof 1 means stack +2, not -2
- add hl,de
- add hl,de
- 1: pop de
- add hl,de
- jr ipsh
- lof.s0: ld h,d
- 2: ld l,(ix)
- inc ix
- jr 1b
- lof.l: ld h,(ix)
- inc ix
- jr 2b
- ! LAL
- lal.m1: ld h,b
- ld l,c
- dec hl
- jr phl
- lal.0: ld h,b
- ld l,c
- ld de,zone
- add hl,de
- jr phl
- lal.wm2:dec d
- lal.wm1:ld iy,phl
- jr loms
- lal.w0: ld iy,phl
- jr lops
- lal.n: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- add hl,bc
- jr phl
- lal.p: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- add hl,bc
- ld de,zone
- add hl,de
- jr phl
- ! LAE
- lae.w8: inc d
- lae.w7: inc d
- lae.w6: inc d
- lae.w5: inc d
- lae.w4: inc d
- lae.w3: inc d
- lae.w2: inc d
- lae.w1: inc d
- lae.w0: ld e,(ix)
- inc ix
- ld hl,eb
- add hl,de
- add hl,de
- jr phl
- lae.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- ld hl,eb
- add hl,de
- jr phl
- ! LIL
- lil.0: lil.2:
- ld hl,-b_lil-b_lil+zone
- add hl,de
- add hl,de
- add hl,bc
- 1: ld e,(hl)
- inc hl
- ld h,(hl)
- ld l,e
- jr ipsh
- lil.wm1:ld iy,1b
- jr loms
- lil.n: ld iy,1b
- jr loml
- lil.w0: ld iy,1b
- jr lops
- lil.p: ld iy,1b
- jr lopl
- ! LXL, LXA
- lxl.1:
- ld a,1
- jr 7f
- lxl.2:
- ld a,2
- jr 7f
- lxl.l: ld d,(ix)
- inc ix
- lxl.s: ld a,(ix)
- inc ix
- 7: ld iy,phl
- 5: ld h,b
- ld l,c
- or a
- jr z,3f
- 2: inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- .assert [ .-2b-zone] == 0
- ld e,(hl)
- inc hl
- ld h,(hl)
- ld l,e
- dec a
- jr nz,2b
- 3: cp d
- jr z,4f
- dec d
- jr 2b
- 4: jp (iy)
- lxa.1:
- ld a,1
- jr 7f
- lxa.l: ld d,(ix)
- inc ix
- lxa.s: ld a,(ix)
- inc ix
- 7: ld iy,1f
- jr 5b
- 1: ld de,zone
- add hl,de
- jr phl
- lpb.z:
- pop hl
- .assert [ zone/256] == 0
- ld e,zone
- add hl,de
- jr phl
- dch.z:
- ld e,2
- jr loi
- exg.z:
- pop de
- jr exg
- exg.l:
- ld d,(ix)
- inc ix
- exg.s0:
- ld e,(ix)
- inc ix
- exg:
- push bc
- pop iy
- ld hl,0
- add hl,sp
- ld b,h
- ld c,l
- add hl,de
- 1:
- ld a,(bc)
- ex af,af2
- ld a,(hl)
- ld (bc),a
- ex af,af2
- ld (hl),a
- inc bc
- inc hl
- dec de
- ld a,d
- or e
- jr nz,1b
- push iy
- pop bc
- jr loop
- ! LDL
- ldl.0: ld de,zone
- ld h,b
- ld l,c
- add hl,de
- dipsh: inc hl
- inc hl
- inc hl
- ld d,(hl)
- dec hl
- ld e,(hl)
- dec hl
- push de
- ld d,(hl)
- dec hl
- ld e,(hl)
- push de
- jr loop
- ldl.wm1:ld iy,dipsh
- jr loms
- ldl.n: ld iy,dipsh
- jr loml
- ldl.w0: ld iy,dipsh
- jr lops
- ldl.p: ld iy,dipsh
- jr lopl
- ! LDE
- lde.l: ld d,(ix)
- inc ix
- jr lde.w0
- lde.w3: inc d
- lde.w2: inc d
- lde.w1: inc d
- lde.w0: ld e,(ix)
- inc ix
- ld hl,eb
- add hl,de
- add hl,de
- jr dipsh
- ! LDF
- ldf.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- pop hl
- add hl,de
- jr dipsh
- ! LOI,LOS
- los.z:
- ld iy,los.2
- jr pop2
- los.l: call long2
- los.2: pop de
- loi: pop hl
- add hl,de
- dec hl
- srl d
- rr e
- jr nc,1f
- ld a,e
- or d
- jr nz,eilsize
- ld e,(hl) ! here the 1-byte case is caught
- push de
- jr loop
- 1: push bc
- pop iy
- 2: ld b,(hl)
- dec hl
- ld c,(hl)
- dec hl
- push bc
- dec de
- ld a,d
- or e
- jr nz,2b
- loiend: push iy
- pop bc
- jr loop
- loi.1: loi.2: loi.4: loi.6: loi.8:
- ld hl,-b_loi-b_loi
- add hl,de
- adc hl,de ! again we use that the carry is cleared
- jr nz,1f
- inc hl ! in case loi.0 object size is 1 byte!
- 1: ex de,hl
- jr loi
- loi.l: ld d,(ix)
- inc ix
- loi.s0: ld e,(ix)
- inc ix
- jr loi
- ! ------------------------------ STORES --------------------------------
- ! STL
- stl.p2: ld hl,2
- jr 4f
- stl.p0: ld hl,0
- 4: ld de,zone
- add hl,de
- add hl,bc
- jr ipop
- stl.m2: stl.m4: stl.m6: stl.m8: stl.m10:
- ld hl,b_stlm+b_stlm
- stl.zrl:sbc hl,de
- xor a
- sbc hl,de
- add hl,bc
- ipop: pop de
- ld (hl),e
- inc hl
- ld (hl),d
- jr loop
- stl.wm1:ld iy,ipop
- jr loms
- stl.n: ld iy,ipop
- jr loml
- stl.w0: ld iy,ipop
- jr lops
- stl.p: ld iy,ipop
- jr lopl
- ! STE
- ste.w3: inc d
- ste.w2: inc d
- ste.w1: inc d
- ste.w0: ld e,(ix)
- inc ix
- ld hl,eb
- add hl,de
- add hl,de
- jr ipop
- ste.l: ld d,(ix)
- inc ix
- jr ste.w0
- ! STF
- stf.2: stf.4: stf.6:
- ld hl,-b_stf-b_stf
- add hl,de
- add hl,de
- 1: pop de
- add hl,de
- jr ipop
- stf.s0: ld h,d
- 2: ld l,(ix)
- inc ix
- jr 1b
- stf.l: ld h,(ix)
- inc ix
- jr 2b
- ! SIL
- 1: ld e,(hl)
- inc hl
- ld h,(hl)
- ld l,e
- jr ipop
- sil.wm1:ld iy,1b
- jr loms
- sil.n: ld iy,1b
- jr loml
- sil.w0: ld iy,1b
- jr lops
- sil.p: ld iy,1b
- jr lopl
- ! STI, STS
- sts.z:
- ld iy,sts.2
- jr pop2
- sts.l: call long2
- sts.2: pop de
- sti: pop hl
- srl d
- rr e
- jr nc,1f
- ld a,e
- or d
- jr nz,eilsize
- pop de ! here the 1-byte case is caught
- ld (hl),e
- jr loop
- 1: push bc
- pop iy
- 2: pop bc
- ld (hl),c
- inc hl
- ld (hl),b
- inc hl
- dec de
- ld a,e
- or d
- jr nz,2b
- jr loiend
- sti.1: sti.2: sti.4: sti.6: sti.8:
- ld hl,-b_sti-b_sti
- add hl,de
- adc hl,de ! again we use that the carry is cleared
- jr nz,1f
- inc hl ! in case sti.0 object size is 1 byte!
- 1: ex de,hl
- jr sti
- sti.l: ld d,(ix)
- inc ix
- sti.s0: ld e,(ix)
- inc ix
- jr sti
- ! SDL
- sdl.wm1:ld iy,1f
- jr loms
- sdl.n: ld iy,1f
- jr loml
- sdl.w0: ld iy,1f
- jr lops
- sdl.p: ld iy,1f
- jr lopl
- ! SDE
- sde.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- ld hl,eb
- 2: add hl,de
- 1: pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- jr ipop
- ! SDF
- sdf.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- pop hl
- jr 2b
- !------------------------- SINGLE PRECISION ARITHMETIC ---------------
- ! ADI, ADP, ADS, ADU
- adi.z: adu.z:
- pop de
- 9:
- call chk24
- .data2 adi.2,adi.4
- adi.l: adu.l:
- ld d,(ix) ! I guess a routine chk24.l could do this job
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- ads.z:
- ld iy,adi.2
- jr pop2
- ads.l:
- call long2
- ads.2: adi.2: adu.2:
- pop de
- 1: pop hl
- add hl,de
- jr phl
- adp.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 1b
- adp.sm1:dec d
- adp.s0: ld e,(ix)
- inc ix
- jr 1b
- adp.2: pop hl
- inc hl
- jr 1f
- inc.z:
- adp.1: pop hl
- 1: inc hl
- jr phl
- ! SBI, SBP, SBS, SBU (but what is SBP?)
- sbi.z: sbu.z:
- pop de
- 9:
- call chk24
- .data2 sbi.2,sbi.4
- sbi.l: sbu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- sbs.z:
- ld iy,sbi.2
- jr pop2
- sbs.l:
- call long2
- sbi.2:
- pop de
- pop hl
- sbc hl,de
- jr phl
- ! NGI
- ngi.z:
- pop de
- 9:
- call chk24
- .data2 ngi.2,ngi.4
- ngi.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- ngi.2: ld hl,0
- pop de
- sbc hl,de
- jr phl
- ! MLI, MLU Johan version
- mli.z: mlu.z:
- pop de
- 9:
- call chk24
- .data2 mli.2,mli.4
- mli.l: mlu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- mli.2: mlu.2:
- ld iy,loop
- mliint: pop de
- pop hl
- push bc
- ld b,h
- ld c,l
- ld hl,0
- ld a,16
- 0:
- bit 7,d
- jr z,1f
- add hl,bc
- 1:
- dec a
- jr z,2f
- ex de,hl
- add hl,hl
- ex de,hl
- add hl,hl
- jr 0b
- 2:
- pop bc
- push hl
- jp (iy)
- ! DVI, DVU
- dvi.z:
- pop de
- 9:
- call chk24
- .data2 dvi.2,dvi.4
- dvi.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- dvi.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- xor a
- ld h,a
- ld l,a
- sbc hl,bc
- jp m,1f
- ld b,h
- ld c,l
- cpl
- 1:
- or a
- ld hl,0
- sbc hl,de
- jp m,1f
- ex de,hl
- cpl
- 1:
- push af
- ld hl,0
- ld a,16
- 0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
- 1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
- 2:
- dec a
- jr nz,0b
- pop af
- or a
- jr z,1f
- ld hl,0
- sbc hl,de
- ex de,hl
- 1:
- pop bc
- push de
- jr loop
- dvu.z:
- pop de
- 9:
- call chk24
- .data2 dvu.2,dvu.4
- dvu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- dvu.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- ld hl,0
- ld a,16
- 0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
- 1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
- 2:
- dec a
- jr nz,0b
- pop bc
- push de
- jr loop
- ! RMI, RMU
- rmi.z:
- pop de
- 9:
- call chk24
- .data2 rmi.2,rmi.4
- rmi.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- rmi.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- xor a
- ld h,a
- ld l,a
- sbc hl,bc
- jp m,1f
- ld b,h
- ld c,l
- 1:
- or a
- ld hl,0
- sbc hl,de
- jp m,1f
- ex de,hl
- cpl
- 1:
- push af
- ld hl,0
- ld a,16
- 0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
- 1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
- 2:
- dec a
- jr nz,0b
- ex de,hl
- pop af
- or a
- jr z,1f
- ld hl,0
- sbc hl,de
- ex de,hl
- 1:
- pop bc
- push de
- jr loop
- rmu.4:
- ld iy,.dvu4
- jr 1f
- rmi.4:
- ld iy,.dvi4
- 1:
- ld (retarea),bc
- ld (retarea+2),ix
- ld hl,1f
- push hl
- push iy
- ret
- 1:
- pop hl
- pop hl
- push bc
- push de
- ld bc,(retarea)
- ld ix,(retarea+2)
- jr loop
- rmu.z:
- pop de
- 9:
- call chk24
- .data2 rmu.2,rmu.4
- rmu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- rmu.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- ld hl,0
- ld a,16
- 0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
- 1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
- 2:
- dec a
- jr nz,0b
- pop bc
- jr phl
- ! SLI, SLU
- slu.z: sli.z:
- pop de
- 9:
- call chk24
- .data2 sli.2,sli.4
- slu.l:
- sli.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- sli.2:
- pop de
- pop hl
- ld a,d
- or a
- jr z,1f
- ld e,15
- 2: add hl,hl
- 1: dec e
- jp m,phl
- jr 2b
- sli.4:
- slu.4:
- pop de
- pop iy
- pop hl
- inc d
- dec d
- jr z,1f
- ld e,31
- 1:
- dec e
- jp m,2f
- add iy,iy
- adc hl,hl
- jr 1b
- 2:
- push hl
- push iy
- jr loop
- ! SRI, SRU
- sri.z:
- pop de
- 9:
- call chk24
- .data2 sri.2,sri.4
- sri.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- sri.2: pop de
- pop hl
- ld a,d
- or a
- jr z,1f
- ld e,15
- 2: sra h
- rr l
- 1: dec e
- jp m,phl
- jr 2b
- sri.4:
- pop de
- ld a,e
- inc d
- dec d
- pop de
- pop hl
- jr z,1f
- ld a,31
- 1:
- dec a
- jp m,2f
- sra h
- rr l
- rr d
- rr e
- jr 1b
- 2:
- push hl
- push de
- jr loop
- sru.z:
- pop de
- 9:
- call chk24
- .data2 sru.2,sru.4
- sru.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- sru.2: pop de
- pop hl
- ld a,d
- or a
- jr z,1f
- ld e,15
- 2: srl h
- rr l
- 1: dec e
- jp m,phl
- jr 2b
- sru.4:
- pop de
- ld a,e
- inc d
- dec d
- pop de
- pop hl
- jr z,1f
- ld a,31
- 1:
- dec a
- jp m,2f
- srl h
- rr l
- rr d
- rr e
- jr 1b
- 2:
- push hl
- push de
- jr loop
- ! ROL, ROR
- rol.z:
- pop de
- 9:
- call chk24
- .data2 rol.2,rol.4
- rol.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- rol.2: pop de
- pop hl
- ld a,e
- and 15
- jr z,phl
- ld de,0
- 1: add hl,hl
- adc hl,de
- dec a
- jr nz,1b
- jr phl
- rol.4:
- pop de
- pop iy
- pop hl
- ld a,e
- and 31
- jr z,3f
- 1:
- add iy,iy
- adc hl,hl
- jr nc,2f
- inc iy
- 2:
- dec a
- jr nz,1b
- 3:
- push hl
- push iy
- ror.z:
- pop de
- 9:
- call chk24
- .data2 ror.2,ror.4
- ror.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
- ror.2: pop de
- pop hl
- ld a,e
- and 15
- jr z,phl
- 1: srl h
- rr l
- jr nc,2f
- set 7,h
- 2: dec a
- jr nz,1b
- jr phl
- ror.4:
- pop de
- ld a,e
- pop de
- pop hl
- and 31
- jr z,0f
- 1:
- srl h
- rr l
- rr d
- rr e
- jr nc,2f
- set 7,h
- 2:
- dec a
- jr nz,1b
- 0:
- push hl
- push de
- jr loop
- pop2: ld de,2
- pop hl
- sbc hl,de
- jr nz,eilsize
- xor a
- ld d,a
- jp (iy)
- chk24:
- ! this routine is used to call indirectly
- ! a routine for either 2 or 4 byte operation
- ! ( e.g. mli.2 or mli.4)
- ! de contains 2 or 4
- ! iy points to a descriptor containing
- ! the addresses of both routines
- pop iy ! address of descriptor
- ld a,d ! high byte must be 0
- or a
- jr nz,unimpld
- ld a,e
- cp 2
- jr z,1f
- inc iy
- inc iy ! points to word containing
- ! address of 4 byte routine
- cp 4
- jr nz,unimpld
- 1:
- ld h,(iy+1)
- ld l,(iy)
- xor a
- jp (hl)
- !--------------------- INCREMENT, DECREMENT, ZERO ----------------------
- ! INC
- inl.m2: inl.m4: inl.m6:
- ld hl, b_inl+b_inl
- sbc hl,de
- xor a
- sbc hl,de
- add hl,bc
- 1: inc (hl)
- jr nz,loop
- inc hl
- inc (hl)
- jr loop
- inl.wm1:ld iy,1b
- jr loms
- inl.n: ld iy,1b
- jr loml
- inl.p: ld iy,1b
- jr lopl
- ! INE
- ine.w3: inc d
- ine.w2: inc d
- ine.w1: inc d
- ine.w0: ld e,(ix)
- inc ix
- ld hl,eb
- add hl,de
- add hl,de
- jr 1b
- ine.l: ld d,(ix)
- inc ix
- jr ine.w0
- ! DEC
- dec.z: pop hl
- dec hl
- push hl
- jr loop
- 1: ld e,(hl)
- inc hl
- ld d,(hl)
- dec de
- ld (hl),d
- dec hl
- ld (hl),e
- jr loop
- del.wm1:ld iy,1b
- jr loms
- del.n: ld iy,1b
- jr loml
- del.p: ld iy,1b
- jr lopl
- ! DEE
- dee.w3: inc d
- dee.w2: inc d
- dee.w1: inc d
- dee.w0: ld e,(ix)
- inc ix
- ld hl,eb
- add hl,de
- add hl,de
- jr 1b
- dee.l: ld d,(ix)
- inc ix
- jr dee.w0
- ! ZERO
- zri2: zru2:
- ld h,d
- ld l,d
- jr phl
- zrf.z:
- zer.z: pop de
- 2: ld hl,0
- sra d
- rr e
- 1: push hl
- dec de
- ld a,e
- or d
- jr nz,1b
- jr loop
- zrf.l:
- zer.l: ld d,(ix)
- inc ix
- zer.s0: ld e,(ix)
- inc ix
- jr 2b
- zrl.m2: zrl.m4:
- ld h,d
- ld l,d
- push hl
- ld hl,b_zrl+b_zrl
- jr stl.zrl
- zrl.wm1:
- ld h,d
- ld l,d
- push hl
- jr stl.wm1
- zrl.n:
- ld h,d
- ld l,d
- push hl
- jr stl.n
- zrl.w0:
- ld h,d
- ld l,d
- push hl
- jr stl.w0
- zrl.p:
- ld h,d
- ld l,d
- push hl
- jr stl.p
- zre.w0:
- ld h,d
- ld l,d
- push hl
- jr ste.w0
- zre.l:
- ld h,d
- ld l,d
- push hl
- jr ste.l
- ! ------------------------- CONVERT GROUP ------------------------------
- ! CII, CIU
- cii.z: ciu.z:
- pop hl
- pop de
- sbc hl,de ! hl and de can only have values 2 or 4, that's
- ! why a single subtract can split the 3 cases
- jr z,loop ! equal, so do nothing
- jp p,2f
- 3: pop hl ! smaller, so shrink size from double to single
- pop de
- jr phl
- 2: pop hl ! larger, so expand (for cii with sign extend)
- res 1,e
- bit 7,h
- jr z,1f
- dec de
- 1: push de
- jr phl
- ! CUI, CUU
- cui.z: cuu.z:
- pop hl
- pop de
- sbc hl,de
- jr z,loop
- jp m,3b
- res 1,e
- pop hl
- jr 1b
- ! ------------------------------ SETS ---------------------------------
- ! SET
- set.z: pop hl
- doset: pop de
- push bc
- pop iy
- ld b,h
- ld c,l
- xor a
- 0: push af
- inc sp
- dec c
- jr nz,0b
- dec b
- jp p,0b
- push iy
- pop bc
- ex de,hl
- ld a,l
- sra h
- jp m,unimpld
- rr l
- sra h
- rr l
- sra h
- rr l
- push hl
- or a
- sbc hl,de
- pop hl
- jp p,unimpld
- add hl,sp
- ld (hl),1
- and 7
- jr 1f
- 0: sla (hl)
- dec a
- 1: jr nz,0b
- jr loop
- set.l: ld d,(ix)
- inc ix
- set.s0: ld e,(ix)
- inc ix
- ex de,hl
- jr doset
- ! INN
- inn.z: pop hl
- jr 1f
- inn.l: ld d,(ix)
- inc ix
- inn.s0: ld e,(ix)
- inc ix
- ex de,hl
- 1:
- pop de
- add hl,sp
- push hl
- pop iy
- ex de,hl
- ld a,l
- sra h
- jp m,0f
- rr l
- sra h
- rr l
- sra h
- rr l
- add hl,sp
- push hl
- or a ! clear carry
- sbc hl,de
- pop hl
- jp m,1f
- 0: xor a
- jr 4f
- 1: ld e,(hl)
- and 7
- jr 2f
- 3: rrc e
- dec a
- 2: jr nz,3b
- ld a,e
- and 1
- 4: ld l,a
- ld h,0
- ld sp,iy
- jr phl
- ! ------------------------- LOGICAL GROUP -----------------------------
- ! AND
- and.z: pop de
- doand: ld h,d
- ld l,e
- add hl,sp
- push bc
- ld b,h
- ld c,l
- ex de,hl
- add hl,de
- 1: dec hl
- dec de
- ld a,(de)
- and (hl)
- ld (hl),a
- xor a
- sbc hl,bc
- jr z,2f
- add hl,bc
- jr 1b
- 2: ld h,b
- ld l,c
- pop bc
- ld sp,hl
- jr loop
- and.l: ld d,(ix)
- inc ix
- and.s0: ld e,(ix)
- inc ix
- jr doand
- and.2: ld e,2
- jr doand
- ! IOR
- ior.z: pop de
- ior: ld h,d
- ld l,e
- add hl,sp
- push bc
- ld b,h
- ld c,l
- ex de,hl
- add hl,de
- 1: dec hl
- dec de
- ld a,(de)
- or (hl)
- ld (hl),a
- xor a
- sbc hl,bc
- jr z,2f
- add hl,bc
- jr 1b
- 2: ld h,b
- ld l,c
- pop bc
- ld sp,hl
- jr loop
- ior.l: ld d,(ix)
- inc ix
- ior.s0: ld e,(ix)
- inc ix
- jr ior
- ior.2: ld e,2
- jr ior
- ! XOR
- xor.z: pop de
- exor: ld h,d
- ld l,e
- add hl,sp
- push bc
- ld b,h
- ld c,l
- ex de,hl
- add hl,de
- 1: dec hl
- dec de
- ld a,(de)
- xor (hl)
- ld (hl),a
- xor a
- sbc hl,bc
- jr z,2f
- add hl,bc
- jr 1b
- 2: ld h,b
- ld l,c
- pop bc
- ld sp,hl
- jr loop
- xor.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr exor
- ! COM
- com.z: pop hl
- com: add hl,sp
- 1: dec hl
- ld a,(hl)
- cpl
- ld (hl),a
- xor a
- sbc hl,sp
- jr z,loop
- add hl,sp
- jr 1b
- com.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- ex de,hl
- jr com
- ! ------------------------- COMPARE GROUP ------------------------------
- ! CMI
- cmi.2: pop de
- pop hl
- ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr phl
- 1: xor d ! now a equals (original) h again
- jp m,phl
- set 0,l ! to catch case hl=0>de bit 0 is set explicitly
- jr phl
- ! CMU, CMP
- cmi.4: inc a
- ld de,4
- jr docmu
- cmp.z: ld de,2
- jr docmu
- cmi.z: inc a
- cmu.z:
- pop de
- jr docmu
- cmi.l: inc a
- cmu.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- docmu: push bc
- pop iy
- ld b,d
- ld c,e
- ld hl,0
- add hl,sp
- add hl,bc
- dec hl
- ld d,h
- ld e,l
- add hl,bc
- ld (retarea),hl ! save new sp-1
- or a
- jr z,1f
- ld a,(de)
- cp (hl)
- dec hl
- dec de
- dec bc
- jr z,1f
- jp p,4f
- jp pe,5f
- jr 6f
- 1:
- ld a,(de)
- cp (hl)
- dec de
- dec hl
- dec bc
- jr nz,2f
- ld a,b
- or c
- jr nz,1b
- ld d,a
- ld e,a
- jr 3f
- 2:
- jr nc,5f
- 6:
- ld de,1
- jr 3f
- 4:
- jp pe,6b
- 5:
- ld de,-1
- 3:
- ld hl,(retarea)
- inc hl
- ld sp,hl
- push de
- push iy
- pop bc
- jr loop
- ! CMS
- cms.z: pop hl
- jr 1f
- cms.l: ld d,(ix)
- inc ix
- cms.s0: ld e,(ix)
- inc ix
- ex de,hl
- 1: push bc
- pop iy
- ld b,h
- ld c,l
- add hl,sp
- 0:
- dec sp
- pop af
- cpi
- jr nz,1f
- ld a,b
- or c
- jr nz,0b
- ld de,0
- jr 2f
- 1:
- add hl,bc
- ld de,1
- 2:
- ld sp,hl
- push de
- push iy
- pop bc
- jr loop
- ! TLT, TLE, TEQ, TNE, TGE, TGT
- tlt.z:
- ld h,d
- ld l,d
- pop de
- bit 7,d
- jr z,1f
- inc l
- 1:
- jr phl
- tle.z: ld hl,1
- pop de
- xor a
- add a,d
- jp m,phl
- jr nz,1f
- xor a
- add a,e
- jr z,2f
- 1: dec l
- 2:
- jr phl
- teq.z:
- ld h,d
- ld l,d
- pop de
- ld a,d
- or e
- jr nz,1f
- inc l
- 1:
- jr phl
- tne.z:
- ld h,d
- ld l,d
- pop de
- ld a,d
- or e
- jr z,1f
- inc l
- 1:
- jr phl
- tge.z:
- ld h,d
- ld l,d
- pop de
- bit 7,d
- jr nz,1f
- inc l
- 1:
- jr phl
- tgt.z:
- ld h,d
- ld l,d
- pop de
- xor a
- add a,d
- jp m,phl
- jr nz,1f
- xor a
- add a,e
- jr z,2f
- 1: inc l
- 2:
- jr phl
- ! ------------------------- BRANCH GROUP -------------------------------
- ! BLT, BLE, BEQ, BNE, BGE, BGT, BRA
- b.pl: ld d,(ix)
- inc ix
- b.ps: ld e,(ix)
- inc ix
- push ix
- pop hl
- add hl,de
- pop de
- ex (sp),hl
- xor a
- jp (iy)
- bra.l: ld d,(ix)
- inc ix
- jr bra.s0
- bra.sm2:dec d
- bra.sm1:dec d
- dec d
- bra.s1: inc d
- bra.s0: ld e,(ix)
- inc ix
- add ix,de
- jr loop
- bgo: pop ix ! take branch
- jr loop
- blt.s0: ld iy,blt
- jr b.ps
- blt.l: ld iy,blt
- jr b.pl
- blt: ld a,h
- xor d
- jp m,1f
- sbc hl,de
- jr 2f
- 1: xor d
- 2: jp m,bgo
- pop de
- jr loop
- ble.s0: ld iy,ble
- jr b.ps
- ble.l: ld iy,ble
- jr b.pl
- ble: ex de,hl
- jr bge
- beq.s0: ld iy,beq
- jr b.ps
- beq.l: ld iy,beq
- jr b.pl
- beq: sbc hl,de
- jr z,bgo
- pop de ! keep stack clean, so dump unused jump address
- jr loop
- bne.s0: ld iy,bne
- jr b.ps
- bne.l: ld iy,bne
- jr b.pl
- bne: sbc hl,de
- jr nz,bgo
- pop de ! keep stack clean, so dump unused jump address
- jr loop
- bge.s0: ld iy,bge
- jr b.ps
- bge.l: ld iy,bge
- jr b.pl
- bge: ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr 2f
- 1: xor d ! now a equals (original) h again
- 2: jp p,bgo
- pop de ! keep stack clean, so dump unused jump address
- jr loop
- bgt.s0: ld iy,bgt
- jr b.ps
- bgt.l: ld iy,bgt
- jr b.pl
- bgt: ex de,hl
- jr blt
- ! ZLT, ZLE, ZEQ, ZNE, ZGE, ZGT
- z.pl: ld d,(ix)
- inc ix
- z.ps: ld e,(ix)
- inc ix
- push ix
- pop hl
- add hl,de
- ex de,hl
- pop hl
- xor a
- add a,h
- jp (iy)
- zlt.l: ld iy,zlt
- jr z.pl
- zlt.s0: ld iy,zlt
- jr z.ps
- zlt: jp m,zgo
- jr loop
- zle.l: ld iy,zle
- jr z.pl
- zle.s0: ld iy,zle
- jr z.ps
- zle: jp m,zgo
- jr nz,loop
- xor a
- add a,l
- jr z,zgo
- jr loop
- zeq.l: ld iy,zeq
- jr z.pl
- zeq.s1: inc d
- zeq.s0: ld iy,zeq
- jr z.ps
- zeq: ld a,l
- or h
- jr nz,loop
- zgo: push de
- pop ix
- jr loop
- zne.sm1:dec d
- jr zne.s0
- zne.l: ld iy,zne
- jr z.pl
- zne.s0: ld iy,zne
- jr z.ps
- zne: ld a,l
- or h
- jr nz,zgo
- jr loop
- zge.l: ld iy,zge
- jr z.pl
- zge.s0: ld iy,zge
- jr z.ps
- zge: jp m,loop
- jr zgo
- zgt.l: ld iy,zgt
- jr z.pl
- zgt.s0: ld iy,zgt
- jr z.ps
- zgt: jp m,loop
- jr nz,zgo
- xor a
- add a,l
- jr z,loop
- jr zgo
- ! ------------------- ARRAY REFERENCE GROUP ---------------------------
- ! AAR
- aar.z:
- ld iy,aar.2
- jr pop2
- aar.l: call long2
- aar.2: ld hl,loop
- aarint: pop iy ! descriptor
- ex (sp),hl ! save return address and hl:=index
- ld e,(iy+0)
- ld d,(iy+1) ! de := lwb
- ld a,h
- xor d
- jp m,1f
- sbc hl,de
- jr 2f
- 1: sbc hl,de
- xor d
- 2: call m,e.array
- ld e,(iy+2)
- ld d,(iy+3) ! de := upb - lwb
- push hl
- ex de,hl
- ld a,h
- xor d
- jp m,1f
- sbc hl,de
- jr 2f
- 1: xor d
- 2: ex de,hl
- pop hl
- call m,e.array
- 1: ld e,(iy+4)
- ld d,(iy+5)
- pop iy
- ex (sp),iy
- push iy ! exchange base address and return address
- push de
- push de
- push hl
- ld iy,1f
- jr mliint
- 1: pop de
- pop iy
- pop hl
- push iy
- add hl,de
- pop de
- ex (sp),hl
- jp (hl)
- lar.l: call long2
- lar.2: ld hl,loi
- jr aarint
- lar.z:
- ld iy,lar.2
- jr pop2
- sar.l: call long2
- sar.2: ld hl,sti
- jr aarint
- sar.z:
- ld iy,sar.2
- jr pop2
- ! --------------------- PROCEDURE CALL/RETURN --------------------------
- ! CAL
- cal.1: cal.2: cal.3: cal.4: cal.5: cal.6: cal.7: cal.8:
- cal.9: cal.10: cal.11: cal.12: cal.13: cal.14: cal.15: cal.16:
- cal.17: cal.18: cal.19: cal.20: cal.21: cal.22: cal.23: cal.24:
- cal.25: cal.26: cal.27: cal.28:
- ld hl,-b_cal
- add hl,de
- ex de,hl
- jr cal
- cal.l: ld d,(ix)
- inc ix
- cal.s0: ld e,(ix)
- inc ix
- cal: push ix ! entry point for main program of interpreter
- push bc
- ld hl,(eb)
- push hl
- ld hl,(ebp4)
- push hl
- ! temporary tracing facility
- ! NOP it if you don't want it
- push de
- ld de,(ebp4)
- ld hl,(eb)
- call prline
- pop de
- ! end of temporary tracing
- ld hl,0
- add hl,sp
- ld b,h
- ld c,l
- ld hl,(pd)
- ex de,hl
- add hl,hl
- add hl,hl
- add hl,de
- push hl
- pop iy
- ld e,(iy+0)
- ld d,(iy+1)
- ld l,c
- ld h,b
- xor a
- sbc hl,de
- ld sp,hl
- ld e,(iy+2)
- ld d,(iy+3)
- ld ix,0
- add ix,de
- jr loop
- ! CAI
- cai.z: pop de
- jr cal
- ! LFR
- lfr.z: pop de
- 2: ld a,e
- rr a
- cp 5
- jp p,eilsize ! only result sizes <= 8 are allowed
- ld hl,retarea
- add hl,de
- 1: dec hl
- ld d,(hl)
- dec hl
- ld e,(hl)
- push de
- dec a
- jr nz,1b
- jr loop
- lfr.l: ld d,(ix)
- inc ix
- lfr.s0: ld e,(ix)
- inc ix
- jr 2b
- lfr.2: ld hl,(retarea)
- jr phl
- lfr.4: ld de,4
- jr 2b
- ! RET
- ret.2: ld a,1
- jr 3f
- ret.z: pop de
- 2: ld a,d
- or e
- jr z,ret.0
- rr a
- cp 5
- jp p,eilsize ! only result sizes <= 8 bytes are allowed
- 3: ld hl,retarea
- 1: pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- dec a
- jr nz,1b
- ret.0:
- ld h,b
- ld l,c
- ld sp,hl
- pop hl
- ld (ebp4),hl
- pop hl
- ld (eb),hl
- pop bc ! old LB
- pop ix ! reta
- push ix ! check to see if reta = boot (= 0)
- pop hl
- ld a,l
- or h
- jr nz,loop ! not done yet
- call uxfinish
- jr boot
- ret.l: ld d,(ix)
- inc ix
- ret.s0: ld e,(ix)
- inc ix
- jr 2b
- ! ------------------------- MISCELLANEOUS -----------------------------
- ! SIG, TRP, RTT
- sig.z:
- ld hl,(trapproc)
- ex (sp),hl
- ld (trapproc),hl
- jr loop
- trp.z:
- ex (sp),hl
- push de
- push af
- push ix
- push iy
- push bc
- ! ld iy,trapproc
- ! ld a,(iy)
- ! or (iy+1)
- ! jr nz,1f
- ld iy,2f+13
- call octnr
- ld c,printstring
- ld de,2f
- call bdos
- ld de,(ebp4)
- ld hl,(eb)
- call prline
- 0:
- pop iy ! LB
- ld a,(iy+6)
- or (iy+7) ! reta
- jr nz,3f
- call uxfinish
- jp boot
- 3:
- ld c,(iy+4)
- ld b,(iy+5)
- push bc ! next LB
- ld e,(iy)
- ld d,(iy+1) ! file name
- ld l,(iy+2)
- ld h,(iy+3) ! lineno
- call prline
- jr 0b
- !1:
- ! ld ix,0
- ! push hl
- ! ld hl,(trapproc)
- ! push hl
- ! ld hl,0
- ! ld (trapproc),hl
- ! jr cai.z
- 2: .ascii 'error 0xxxxxx\r\n$'
- prline:
- ! prints lineno (hl) and filename (de)
- push de
- ld iy,2f+12
- call octnr
- ld c,printstring
- ld de,2f
- call bdos
- pop de
- ld hl,4f
- 0:
- ld a,(de)
- or a
- jr z,1f
- ld (hl),a
- inc de
- inc hl
- jr 0b
- 1:
- ld (hl),36 ! '$'
- ld de,4f
- ld c,printstring
- call bdos
- ld de,3f
- ld c,printstring
- call bdos
- ret
- 2: .ascii 'line 0xxxxxx in $'
- 3: .ascii '\r\n$'
- 4: .space 12
- rtt.z=ret.0
- ! NOP
- ! changed into output routine to print linenumber
- ! in octal (6 digits)
- nop.z: push bc
- ld iy,1f+12
- ld hl,(eb)
- call octnr
- ld iy,1f+20
- ld hl,0
- add hl,sp
- call octnr
- ld c,printstring
- ld de,1f
- call bdos
- pop bc
- jr loop
- 1: .ascii 'test 0xxxxxx 0xxxxxx\r\n$'
- octnr:
- ld b,6
- 1: ld a,7
- and l
- add a,'0'
- dec iy
- ld (iy+0),a
- srl h
- rr l
- srl h
- rr l
- srl h
- rr l
- djnz 1b
- ret
- ! DUP
- dup.2: pop hl
- push hl
- jr phl
- dus.z:
- ld iy,1f
- jr pop2
- dus.l: call long2
- 1: push bc
- pop iy
- pop bc
- jr dodup
- dup.l:
- push bc
- pop iy
- ld b,(ix)
- inc ix
- ld c,(ix)
- inc ix
- dodup: ld h,d
- ld l,d ! ld hl,0
- add hl,sp
- ld d,h
- ld e,l
- xor a
- sbc hl,bc
- ld sp,hl
- ex de,hl
- ldir
- push iy
- pop bc
- jr loop
- ! BLM, BLS
- bls.z:
- ld iy,blm
- jr pop2
- bls.l: call long2
- blm:
- push bc
- pop iy
- pop bc
- pop de
- pop hl
- ldir
- push iy
- pop bc
- jr loop
- blm.l:
- ld d,(ix)
- inc ix
- blm.s0: ld e,(ix)
- inc ix
- push de
- jr blm
- ! ASP, ASS
- ass.z:
- ld iy,1f
- jr pop2
- ass.l: call long2
- 1: pop hl
- jr 1f
- asp.l:
- ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- asp: add hl,hl
- 1: add hl,sp
- ld sp,hl
- jr loop
- asp.2: asp.4: asp.6: asp.8: asp.10:
- ld hl,-b_asp
- add hl,de
- jr asp
- asp.w0: ld e,(ix)
- inc ix
- ex de,hl
- jr asp
- ! CSA
- csa.z:
- ld iy,csa.2
- jr pop2
- csa.l: call long2
- csa.2:
- !! temporary version while bug in cem remains
- ! pop iy
- ! pop de
- ! push bc
- ! ld c,(iy)
- ! ld b,(iy+1)
- ! ld l,(iy+4)
- ! ld h,(iy+5)
- ! xor a
- ! sbc hl,de
- ! jp m,1f
- ! ex de,hl
- ! ld e,(iy+2)
- ! ld d,(iy+3)
- ! xor a
- ! sbc hl,de
- ! jp m,1f
- ! end of temporary piece
- pop iy
- pop hl
- push bc
- ld c,(iy)
- ld b,(iy+1)
- ld e,(iy+2)
- ld d,(iy+3)
- xor a
- sbc hl,de
- jp m,1f
- ex de,hl
- ld l,(iy+4)
- ld h,(iy+5)
- xor a
- sbc hl,de
- jp m,1f
- ex de,hl
- add hl,hl
- ld de,6
- add hl,de
- ex de,hl
- add iy,de
- ld l,(iy)
- ld h,(iy+1)
- ld a,h
- or l
- jr nz,2f
- 1: ld a,b
- or c
- jr z,e.case
- ld l,c
- ld h,b
- 2: pop bc
- push hl
- pop ix
- jr loop
- ! CSB
- csb.z:
- ld iy,csb.2
- jr pop2
- csb.l: call long2
- csb.2:
- pop ix
- pop iy
- ld e,(ix)
- inc ix
- ld d,(ix)
- inc ix
- push de
- ex (sp),iy
- pop de
- push bc
- ld c,(ix)
- inc ix
- ld b,(ix)
- inc ix
- 1:
- ld a,b
- or c
- jr z,noteq
- ld a,(ix+0)
- cp e
- jr nz,2f
- ld a,(ix+1)
- cp d
- jr nz,2f
- ld l,(ix+2)
- ld h,(ix+3)
- jr 3f
- 2: inc ix
- inc ix
- inc ix
- inc ix
- dec bc
- jr 1b
- noteq: push iy
- pop hl
- 3: ld a,l
- or h
- jr z,e.case
- 2:
- pop bc
- push hl
- pop ix
- jr loop
- ! LIN
- lin.l: ld d,(ix)
- inc ix
- lin.s0: ld e,(ix)
- inc ix
- ld (eb),de
- jr loop
- ! FIL
- fil.z: pop hl
- 1:
- ld (ebp4),hl
- jr loop
- fil.l: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- ld de,eb
- add hl,de
- jr 1b
- ! LNI
- lni.z: ld hl,(eb)
- inc hl
- ld (eb),hl
- jr loop
- ! RCK
- rck.z:
- ld iy,rck.2
- jr pop2
- rck.l: call long2
- rck.2:
- pop iy
- 3: pop hl
- push hl
- ld e,(iy)
- ld d,(iy+1)
- ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr 2f
- 1: xor d ! now a equals (original) h again
- 2: call m,e.rck
- pop de
- push de
- ld l,(iy+2)
- ld h,(iy+3)
- ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr 2f
- 1: xor d ! now a equals (original) h again
- 2: call m,e.rck
- jr loop
- ! LIM
- lim.z: ld hl,(ignmask)
- jr phl
- ! SIM
- sim.z: pop de
- ld (ignmask),de
- jr loop
- ! LOR
- lor.s0: ld e,(ix)
- inc ix
- ld a,d
- or e
- jr nz,1f
- push bc
- jr loop
- 1: ld hl,-1
- adc hl,de
- jr nz,1f
- add hl,sp
- jr phl
- 1: ld hl,(hp)
- jr phl
- ! STR
- str.s0: ld e,(ix)
- inc ix
- ld a,d
- or e
- jr nz,1f
- pop bc
- jr loop
- 1: pop hl
- dec de
- ld a,d
- or e
- jr nz,1f
- ld sp,hl
- jr loop
- 1: ld (hp),hl
- jr loop
- ! Floating point calling routines
- loadfregs:
- pop hl
- pop de
- ld (fpac),de
- pop de
- ld (fpac+2),de
- pop de
- ld (fpop),de
- pop de
- ld (fpop+2),de
- jp (hl)
- dofltop:
- call loadfregs
- push bc
- push ix
- ld hl,1f
- push hl
- push iy
- ret ! really a call
- 1:
- pop ix
- pop bc
- ld hl,(fpac+2)
- push hl
- ld hl,(fpac)
- jr phl
- pop4:
- pop hl
- or h
- jr nz,9f
- ld a,l
- cp 4
- jr nz,9f
- jp (iy)
- arg4:
- or d
- jr nz,9f
- ld a,(ix)
- inc ix
- cp 4
- jr nz,9f
- jp (iy)
- 9: jr unimpld
- adf.z: ld iy,doadf
- jr pop4
- adf.l: ld d,(ix)
- inc ix
- adf.s0: ld iy,doadf
- jr arg4
- doadf:
- ld iy,fpadd ! routine to call
- jr dofltop
- sbf.z: ld iy,dosbf
- jr pop4
- sbf.l: ld d,(ix)
- inc ix
- sbf.s0: ld iy,dosbf
- jr arg4
- dosbf:
- ld iy,fpsub ! routine to call
- jr dofltop
- mlf.z: ld iy,domlf
- jr pop4
- mlf.l: ld d,(ix)
- inc ix
- mlf.s0: ld iy,domlf
- jr arg4
- domlf:
- ld iy,fpmult ! routine to call
- jr dofltop
- dvf.z: ld iy,dodvf
- jr pop4
- dvf.l: ld d,(ix)
- inc ix
- dvf.s0: ld iy,dodvf
- jr arg4
- dodvf:
- ld iy,fpdiv ! routine to call
- jr dofltop
- cmf.z: ld iy,docmf
- jr pop4
- cmf.l: ld d,(ix)
- inc ix
- cmf.s0: ld iy,docmf
- jr arg4
- docmf:
- call loadfregs
- push bc
- push ix
- call fpcmf
- pop ix
- pop bc
- ld hl,(fpac)
- jr phl
- cfi.z:
- pop de
- call chk24
- .data2 1f,0f
- 1: ld iy,1f
- jr pop4
- 1: pop hl
- ld (fpac),hl
- pop hl
- ld (fpac+2),hl
- push bc
- push ix
- call fpcfi
- pop ix
- pop bc
- ld hl,(fpac)
- jr phl
- 0: ld iy,1f
- jr pop4
- 1: pop hl
- ld (fpac),hl
- pop hl
- ld (fpac+2),hl!
- push bc
- push ix
- call fpcfd
- jr 8f
- cif.z:
- ld iy,1f
- jr pop4
- 1:
- pop de
- call chk24
- .data2 1f,0f
- 1: pop hl
- ld (fpac),hl
- push bc
- push ix
- call fpcif
- 8: pop ix
- pop bc
- ld hl,(fpac+2)
- push hl
- ld hl,(fpac)
- jr phl
- 0: pop hl
- ld (fpac),hl
- pop hl
- ld (fpac+2),hl
- push bc
- push ix
- call fpcdf
- jr 8b
- ngf.l: ld d,(ix)
- inc ix
- ld iy,1f
- jr arg4
- ngf.z:
- ld iy,1f
- jr pop4
- 1: pop hl
- ld (fpac),hl
- pop hl
- ld (fpac+2),hl
- push bc
- push ix
- call fpcomp
- jr 8b
- fif.z:
- ld iy,1f
- jr pop4
- fif.l:
- ld d,(ix)
- inc ix
- ld iy,1f
- jr arg4
- 1: call loadfregs
- push bc
- push ix
- call fpfif
- pop ix
- pop bc
- ld hl,(fpac+2)
- push hl
- ld hl,(fpac)
- push hl
- ld hl,(fpop+2)
- push hl
- ld hl,(fpop)
- jr phl
- fef.z:
- ld iy,1f
- jr pop4
- fef.l:
- ld d,(ix)
- inc ix
- ld iy,1f
- jr arg4
- 1: pop hl
- ld (fpop),hl
- pop hl
- ld (fpop+2),hl
- push bc
- push ix
- call fpfef
- pop ix
- pop bc
- ld hl,(fpop+2)
- push hl
- ld hl,(fpop)
- push hl
- ld hl,(fpac)
- jr phl
- ! double aritmetic
- adi.4:
- push bc
- pop iy
- pop hl
- pop de
- pop bc
- add hl,bc
- ex de,hl
- pop bc
- adc hl,bc
- push hl
- push de
- push iy
- pop bc
- jr loop
- sbi.4:
- push bc
- pop iy
- pop bc
- pop de
- pop hl
- sbc hl,bc
- ex de,hl
- ld b,h
- ld c,l
- pop hl
- 9:
- sbc hl,bc
- push hl
- push de
- push iy
- pop bc
- jr loop
- ngi.4:
- push bc
- pop iy
- ld hl,0
- pop de
- sbc hl,de
- ex de,hl
- ld hl,0
- pop bc
- jr 9b
- mli.4:
- ld iy,.mli4
- 0:
- ld (retarea),bc
- ld (retarea+2),ix
- ld hl,1f
- push hl
- push iy
- ret
- 1:
- ld bc,(retarea)
- ld ix,(retarea+2)
- jr loop
- dvu.4:
- ld iy,.dvu4
- jr 0b
-
- dvi.4:
- ld iy,.dvi4
- jr 0b
-
- ! list of not yet implemented instructions
- cuf.z:
- cff.z:
- cfu.z:
- unimpld: ! used in dispatch table to
- ! catch unimplemented instructions
- ld hl,EILLINS
- 9: push hl
- jr trp.z
- eilsize:
- ld hl,EILLSIZE
- jr 9b
- e.case:
- ld hl,ECASE
- jr 9b
- e.mon:
- ld hl,EMON
- jr 9b
- e.array:
- push af
- ld a,(ignmask)
- bit 0,a
- jr nz,8f
- ld hl,EARRAY
- jr 9b
- e.rck:
- push af
- ld a,(ignmask)
- bit 1,a
- jr nz,8f
- ld hl,ERANGE
- jr 9b
- 8:
- pop af
- ret
- long2: ld a,(ix)
- inc ix
- or a
- jr nz,unimpld
- ld a,(ix)
- inc ix
- cp 2
- jr nz,unimpld
- xor a ! clear carry
- ret
- ! monitor instruction
- ! a small collection of UNIX system calls implemented under CP/M
- ux_indir=e.mon
- ux_fork=e.mon
- ux_wait=e.mon
- ux_link=e.mon
- ux_exec=e.mon
- ux_chdir=e.mon
- ux_mknod=e.mon
- ux_chmod=e.mon
- ux_chown=e.mon
- ux_break=e.mon
- ux_stat=e.mon
- ux_seek=e.mon
- ux_mount=e.mon
- ux_umount=e.mon
- ux_setuid=e.mon
- ux_getuid=e.mon
- ux_stime=e.mon
- ux_ptrace=e.mon
- ux_alarm=e.mon
- ux_fstat=e.mon
- ux_pause=e.mon
- ux_utime=e.mon
- ux_stty=e.mon
- ux_gtty=e.mon
- ux_access=e.mon
- ux_nice=e.mon
- ux_sync=e.mon
- ux_kill=e.mon
- ux_dup=e.mon
- ux_pipe=e.mon
- ux_times=e.mon
- ux_prof=e.mon
- ux_unused=e.mon
- ux_setgid=e.mon
- ux_getgid=e.mon
- ux_sig=e.mon
- ux_umask=e.mon
- ux_chroot=e.mon
- EPERM = 1
- ENOENT = 2
- ESRCH = 3
- EINTR = 4
- EIO = 5
- ENXIO = 6
- E2BIG = 7
- ENOEXEC = 8
- EBADF = 9
- ECHILD = 10
- EAGAIN = 11
- ENOMEM = 12
- EACCES = 13
- EFAULT = 14
- ENOTBLK = 15
- EBUSY = 16
- EEXIST = 17
- EXDEV = 18
- ENODEV = 19
- ENOTDIR = 20
- EISDIR = 21
- EINVAL = 22
- ENFILE = 23
- EMFILE = 24
- ENOTTY = 25
- ETXTBSY = 26
- EFBIG = 27
- ENOSPC = 28
- ESPIPE = 29
- EROFS = 30
- EMLINK = 31
- EPIPE = 32
- EDOM = 33
- ! Structure of filearea maintained by this implementation
- ! First iobuffer of 128 bytes
- ! Then the fcb area of 36 bytes
- ! The number of bytes left in the buffer, 1 byte
- ! The iopointer into the buffer, 2 bytes
- ! The openflag 0 unused, 1 reading, 2 writing, 1 byte
- ! The filedescriptor starting at 3, 1 byte
- ! The number of CTRL-Zs that have been absorbed, 1 byte
- ! The byte read after a sequence of CTRL-Zs, 1 byte
- maxfiles=8
- filesize=128+36+1+2+1+1+1+1
- filefcb=0 ! pointers point to fcb
- position=33
- nleft=36
- iopointer=37
- openflag=39
- fildes=40
- zcount=41
- zsave=42
- .assert [ filefcb] == 0
- 0: .space maxfiles*filesize
- filearea = 0b+128
- sibuf:
- .data2 0
- .space 82
- siptr: .space 2
- saveargs:
- .space 128
- argv: .space 40 ! not more than 20 args
- argc: .space 2
- ttymode:.data1 9,9,8,21;.data2 06310+RAW*040 ! raw = 040
- uxinit:
- xor a
- ld c,maxfiles
- ld hl,0b
- 1: ld b,filesize
- 2: ld (hl),a
- inc hl
- djnz 2b
- dec c
- jr nz,1b
- ret
- uxfinish:
- ld a,maxfiles-1
- 1: push af
- call closefil
- pop af
- dec a
- cp 0377
- jr nz,1b
- ret
- makeargv:
- ld hl,0x80
- ld de,saveargs
- ld bc,128
- ldir
- ld hl,saveargs
- ld e,(hl)
- inc hl
- ld d,0
- add hl,de
- ld (hl),0
- ld hl,saveargs+1
- ld ix,argv
- 1: ld a,(hl)
- or a
- jr z,9f
- cp ' '
- jr nz,2f
- 4: ld (hl),0
- inc hl
- jr 1b
- 2: ld (ix),l
- inc ix
- ld (ix),h
- inc ix
- 3: inc hl
- ld a,(hl)
- or a
- jr z,9f
- cp ' '
- jr nz,3b
- jr 4b
- 9: push ix
- pop hl
- ld de,argv
- or a
- sbc hl,de
- srl h;rr l
- ld (argc),hl
- ld (ix+0),0
- ld (ix+1),0
- ret
- mon.z:
- pop de ! system call number
- xor a
- or d
- jr nz,unimpld ! too big
- ld a,e
- and 0300 ! only 64 system calls
- jr nz,unimpld
- sla e
- ld hl,systab
- add hl,de
- ld e,(hl)
- inc hl
- ld d,(hl)
- ex de,hl
- jp (hl)
- systab:
- .data2 ux_indir
- .data2 ux_exit
- .data2 ux_fork
- .data2 ux_read
- .data2 ux_write
- .data2 ux_open
- .data2 ux_close
- .data2 ux_wait
- .data2 ux_creat
- .data2 ux_link
- .data2 ux_unlink
- .data2 ux_exec
- .data2 ux_chdir
- .data2 ux_time
- .data2 ux_mknod
- .data2 ux_chmod
- .data2 ux_chown
- .data2 ux_break
- .data2 ux_stat
- .data2 ux_seek
- .data2 ux_getpid
- .data2 ux_mount
- .data2 ux_umount
- .data2 ux_setuid
- .data2 ux_getuid
- .data2 ux_stime
- .data2 ux_ptrace
- .data2 ux_alarm
- .data2 ux_fstat
- .data2 ux_pause
- .data2 ux_utime
- .data2 ux_stty
- .data2 ux_gtty
- .data2 ux_access
- .data2 ux_nice
- .data2 ux_ftime
- .data2 ux_sync
- .data2 ux_kill
- .data2 unimpld
- .data2 unimpld
- .data2 unimpld
- .data2 ux_dup
- .data2 ux_pipe
- .data2 ux_times
- .data2 ux_prof
- .data2 ux_unused
- .data2 ux_setgid
- .data2 ux_getgid
- .data2 ux_sig
- .data2 unimpld
- .data2 unimpld
- .data2 unimpld
- .data2 unimpld
- .data2 unimpld
- .data2 ux_ioctl
- .data2 unimpld
- .data2 unimpld
- .data2 unimpld
- .data2 unimpld
- .data2 ux_exece
- .data2 ux_umask
- .data2 ux_chroot
- .data2 unimpld
- .data2 unimpld
- emptyfile:
- ! searches for a free filestructure
- ! returns pointer in iy, 0 if not found
- ld iy,filearea
- ld l,maxfiles
- 1:
- xor a
- or (iy+openflag)
- jr nz,3f
- ld a,maxfiles+3
- sub l
- ld (iy+fildes),a
- #ifdef CPM1
- push bc
- push iy
- ld de,-128
- add iy,de
- push iy
- pop de
- ld c,setdma
- call bdos
- pop iy
- pop bc
- or a ! to clear C
- #endif
- ret
- 3:
- ld de,filesize
- add iy,de
- dec l
- jr nz,1b
- scf
- ret
- findfile:
- ld iy,filearea
- ld de,filesize
- 0:
- dec a
- ret m
- add iy,de
- jr 0b
- getchar:
- push bc
- push de
- push hl
- dec (iy+nleft)
- jp p,0f
- push iy
- pop hl
- ld de,-128
- add hl,de
- ld (iy+iopointer),l
- ld (iy+iopointer+1),h
- ex de,hl
- push iy
- ld c,setdma
- call bdos
- #ifdef CPM1
- ld c,seqread
- #else
- ld c,randomread
- #endif
- pop de
- call bdos
- or a
- jr z,1f
- ld (iy+zcount),0
- pop hl
- pop de
- pop bc
- scf
- ret
- 1:
- inc (iy+position)
- jr nz,2f
- inc (iy+position+1)
- 2:
- ld a,127
- ld (iy+nleft),a
- 0:
- ld h,(iy+iopointer+1)
- ld l,(iy+iopointer)
- ld a,(hl)
- inc hl
- ld (iy+iopointer),l
- ld (iy+iopointer+1),h
- pop hl
- pop de
- pop bc
- ret
- or a
- putchar:
- push hl
- ld h,(iy+iopointer+1)
- ld l,(iy+iopointer)
- ld (hl),a
- dec (iy+nleft)
- jr z,0f
- inc hl
- ld (iy+iopointer+1),h
- ld (iy+iopointer),l
- pop hl
- ret
- 0:
- pop hl
- flsbuf:
- push hl
- push de
- push bc
- push iy
- pop hl
- ld de,-128
- add hl,de
- ld (iy+iopointer+1),h
- ld (iy+iopointer),l
- ex de,hl
- push iy
- ld c,setdma
- call bdos
- pop de
- #ifdef CPM1
- ld c,seqwrite
- #else
- ld c,randomwrite
- #endif
- call bdos
- or a
- jr z,1f
- pop bc
- pop de
- pop hl
- scf
- ret
- 1:
- inc (iy+position)
- jr nz,2f
- inc (iy+position+1)
- 2:
- ld a,128
- ld (iy+nleft),a
- ld b,a
- push iy
- pop hl
- ld de,-128
- add hl,de
- ld a,26 ! ctrl z
- 1: ld (hl),a
- inc hl
- djnz 1b
- pop bc
- pop de
- pop hl
- or a
- ret
- parsename:
- ! parses file name pointed to by hl and fills in fcb
- ! of the file pointed to by iy.
- ! recognizes filenames as complicated as 'b:file.zot'
- ! and as simple as 'x'
- push bc
- push iy
- pop de
- xor a
- push de
- ld b,36 ! sizeof fcb
- 0: ld (de),a
- inc de
- djnz 0b
- pop de
- inc hl
- ld a,(hl)
- dec hl
- cp ':' ! drive specified ?
- jr nz,1f
- ld a,(hl)
- inc hl
- inc hl
- dec a
- and 15
- inc a ! now 1<= a <= 16
- ld (de),a
- 1: inc de
- ld b,8 ! filename maximum of 8 characters
- 1: ld a,(hl)
- or a
- jr nz,8f
- dec hl
- ld a,'.'
- 8:
- inc hl
- cp '.'
- jr z,2f
- and 0177 ! no parity
- bit 6,a
- jr z,9f
- and 0337 ! UPPER case
- 9:
- ld (de),a
- inc de
- djnz 1b
- ld a,(hl)
- inc hl
- cp '.'
- jr z,3f
- ld a,' '
- ld (de),a
- inc de
- ld (de),a
- inc de
- ld (de),a
- pop bc
- ret ! filenames longer than 8 are truncated
- 2: ld a,' ' ! fill with spaces
- 0: ld (de),a
- inc de
- djnz 0b
- 3: ld b,3 ! length of extension
- 1: ld a,(hl)
- inc hl
- or a
- jr z,4f
- cp 0100
- jp m,2f
- and 0137
- 2: ld (de),a
- inc de
- djnz 1b
- pop bc
- ret
- 4: ld a,' '
- 0: ld (de),a
- inc de
- djnz 0b
- pop bc
- ret
- ! various routines
- ux_close:
- pop hl
- ld a,l
- sub 3
- jp m,1f
- cp maxfiles
- call m,closefil
- 1: ld hl,0
- jr phl
- closefil:
- call findfile
- ld a,(iy+openflag)
- or a
- jr z,3f
- ld (iy+openflag),0
- cp 1
- jr z,2f
- ld a,(iy+nleft)
- cp 128
- jr z,2f
- call flsbuf
- 2:
- push bc
- push iy
- pop de
- ld c,close
- call bdos
- pop bc
- 3: ret
- ux_ioctl:
- pop hl
- ld a,l
- sub 3
- jp p,1f
- pop hl
- ld a,h
- cp 't'
- jr nz,e.mon
- ld a,l
- cp 8
- jr z,tiocgetp
- cp 9
- jr z,tiocsetp
- jr e.mon
- 1: pop hl
- pop hl
- ld hl,-1
- jr phl
- tiocgetp:
- pop de
- ld hl,ttymode
- 2: push bc
- ld bc,6
- ldir
- ld h,b
- ld l,c
- pop bc
- jr phl
- tiocsetp:
- pop hl
- ld de,ttymode
- jr 2b
- ux_time:
- call time4
- jr loop
- ux_ftime:
- pop hl
- ld (retarea+6),hl
- call time4
- ld hl,(retarea+6)
- pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- xor a
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- jr loop
- time4:
- pop hl
- ld (retarea),bc
- ld (retarea+2),ix
- ld (retarea+4),hl
- ld hl,(timebuf+2)
- push hl
- ld hl,(timebuf)
- push hl
- ld hl,0
- push hl
- ld hl,50
- push hl
- call .dvu4
- ld bc,(retarea)
- ld ix,(retarea+2)
- ld hl,(retarea+4)
- jp (hl)
- ux_exit:
- call uxfinish
- ld c,reset
- call bdos
- ! no return
- ux_creat:
- call emptyfile
- jr c,openfailed
- pop hl
- call parsename
- pop hl ! file mode, not used under CP/M
- push bc
- push iy
- push iy
- pop de
- ld c,delete
- call bdos
- pop de
- ld c,makefile
- call bdos
- pop bc
- ld l,1
- jr afteropen
- ux_open:
- call emptyfile
- jr nc,1f
- openfailed:
- pop hl
- pop hl ! remove params
- ld hl,EMFILE
- push hl
- jr phl
- 1:
- pop hl ! filename
- call parsename
- push bc
- ld c,open
- push iy
- pop de
- call bdos
- pop bc
- pop hl
- afteropen:
- inc a
- jr nz,1f
- ld hl,ENOENT
- push hl
- jr phl
- 1:
- inc l
- ld (iy+openflag),l
- xor a
- ld (iy+nleft),a
- ld (iy+zcount),a
- ld (iy+zsave),26
- bit 1,l
- jr z,2f
- ld (iy+nleft),128
- 2:
- ld (iy+position),a
- ld (iy+position+1),a
- push iy
- pop hl
- push bc
- ld b,128
- 3: dec hl
- ld (hl),26
- djnz 3b
- pop bc
- ld (iy+iopointer+1),h
- ld (iy+iopointer),l
- ld h,a
- ld l,(iy+fildes)
- push hl
- ld l,a
- jr phl
- ux_read:
- pop hl
- ld a,l
- sub 3
- jp p,readfile
- ld a,(ttymode+4)
- bit 5,a
- jr z,1f ! not raw
- push bc
- #ifdef CPM1
- !raw echo interface
- ld c,consolein
- call bdos
- #else
- !no echo interface
- 4:
- ld c,diconio
- ld e,0xff
- call bdos
- or a
- jr z,4b
- !end of no echo interface
- #endif
- pop bc
- pop hl
- ld (hl),a
- pop hl
- ld hl,1
- push hl
- ld hl,0
- jr phl
- 1:
- ld hl,sibuf+1 ! read from console assumed
- dec (hl)
- jp p,2f
- dec hl ! go read console line
- ld (hl),80 ! max line length
- push bc
- push hl
- ld c,readconsole
- ex de,hl
- call bdos
- ld c,writeconsole
- ld e,'\n'
- call bdos
- pop hl
- pop bc
- inc hl
- inc (hl)
- ld (siptr),hl ! ready for transfer
- push hl
- ld e,(hl)
- ld d,0
- add hl,de
- ld (hl),'\r'
- inc hl
- ld (hl),'\n'
- pop hl
- 2:
- push bc
- pop iy
- ld b,(hl)
- inc b ! bytes remaining
- pop hl ! copy to
- pop de ! bytes wanted (probably 512)
- push iy
- ld iy,(siptr) ! copy from
- xor a ! find out minimum of ramaining and wanted
- or d
- jr nz,3f ! more than 255 wanted (forget that)
- ld a,b
- cp e
- jp m,3f ! not enough remaining
- ld b,e
- 3:
- ld c,b ! keep copy
- 0:
- inc iy
- ld a,(iy)
- ld (hl),a
- inc hl
- djnz 0b
- ld a,(sibuf+1)
- sub c
- inc a
- ld (sibuf+1),a
- ld (siptr),iy
- pop hl
- push bc
- ld c,b
- push bc ! load 0
- ld b,h
- ld c,l
- jr loop
- readfile:
- call findfile
- pop de
- pop hl ! count
- push bc
- ld bc,0
- 0:
- xor a
- or l
- jr z,1f
- dec l
- 3:
- ! warning: this may not work if zcount overflows
- ld a,(iy+zcount)
- or a
- jr nz,5f
- ld a,(iy+zsave)
- cp 26
- jr z,4f
- ld (iy+zsave),26
- jr 8f
- 4:
- call getchar
- jr c,2f
- ld (de),a
- sub 26 ! CTRL-Z
- jr z,7f
- ld a,(iy+zcount)
- or a
- jr z,6f
- ld a,(de)
- ld (iy+zsave),a
- 5:
- ld a,26
- dec (iy+zcount)
- 8:
- ld (de),a
- 6:
- inc de
- inc bc
- jr 0b
- 1:
- dec l
- dec h
- jp p,3b
- 2:
- pop hl
- push bc
- ld b,h
- ld c,l
- ld hl,0
- jr phl
- 7:
- inc (iy+zcount)
- jr 4b
- ux_write:
- pop hl
- ld a,l
- sub 3
- jp p,writefile
- pop hl ! buffer address
- pop de ! count
- push de
- ld iy,0
- push iy
- push bc
- ld b,e ! count now in 'db'
- 0:
- ld a,b
- or a
- jr nz,1f
- ld a,d
- or a
- jr nz,2f
- pop bc
- jr loop
- 2:
- dec d
- 1:
- dec b
- ld e,(hl)
- inc hl
- push bc
- push de
- push hl
- ld c,writeconsole
- call bdos
- pop hl
- pop de
- pop bc
- jr 0b
- writefile:
- call findfile
- pop de
- pop hl ! count
- push bc
- ld bc,0
- 0:
- xor a
- or l
- jr z,1f
- dec l
- 3:
- ld a,(de)
- inc de
- call putchar
- jr c,4f
- inc bc
- jr 0b
- 1:
- dec l
- dec h
- jp p,3b
- ld iy,0
- 2:
- pop hl
- push bc
- ld b,h
- ld c,l
- push iy
- jr loop
- 4:
- ld iy,ENOSPC
- jr 2b
- ux_unlink:
- pop hl
- ld iy,fcb
- call parsename
- push bc
- ld c,delete
- ld de,fcb
- call bdos
- pop bc
- inc a
- jr nz,1f
- ld hl,ENOENT
- jr phl
- 1:
- ld hl,0
- jr phl
- ux_getpid:
- ld hl,12345 ! nice number
- jr phl
- ux_exece:
- ld iy,fcb
- pop hl
- call parsename
- pop hl
- ld b,h;ld c,l
- pop iy
- ld ix,0x82
- ld (ix-1),' '
- 4: ld h,b;ld l,c
- 3: ld e,(hl)
- inc hl
- ld d,(hl)
- inc hl
- ld b,h;ld c,l
- ex de,hl
- ld a,h
- or l
- jr z,1f
- 2:
- ld a,(hl)
- inc hl
- ld (ix),a
- inc ix
- or a
- jr nz,2b
- ld (ix-1),' '
- jr 4b
- 1:
- ld (ix),'X'
- ld (ix+1),'\r'
- ld (ix+2),'\n'
- ld (ix+3),'$'
- ld de,0x81
- push ix
- ld c,printstring
- call bdos
- pop hl
- ld de,-129
- add hl,de
- ld a,l
- ld (0x80),a
- jr warmstart
- dispat1: ! base for escaped opcodes
- .data2 aar.l, aar.z, adf.l, adf.z, adi.l, adi.z, ads.l, ads.z
- .data2 adu.l, adu.z, and.l, and.z, asp.l, ass.l, ass.z, bge.l
- .data2 bgt.l, ble.l, blm.l, bls.l, bls.z, blt.l, bne.l, cai.z
- .data2 cal.l, cfi.z, cfu.z, ciu.z, cmf.l, cmf.z, cmi.l, cmi.z
- .data2 cms.l, cms.z, cmu.l, cmu.z, com.l, com.z, csa.l, csa.z
- .data2 csb.l, csb.z, cuf.z, cui.z, cuu.z, dee.l, del.p, del.n
- .data2 dup.l, dus.l, dus.z, dvf.l, dvf.z, dvi.l, dvi.z, dvu.l
- .data2 dvu.z, fef.l, fef.z, fif.l, fif.z, inl.p, inl.n, inn.l
- .data2 inn.z, ior.l, ior.z, lar.l, lar.z, ldc.l, ldf.l, ldl.p
- .data2 ldl.n, lfr.l, lil.p, lil.n, lim.z, los.l, los.z, lor.s0
- .data2 lpi.l, lxa.l, lxl.l, mlf.l, mlf.z, mli.l, mli.z, mlu.l
- .data2 mlu.z, mon.z, ngf.l, ngf.z, ngi.l, ngi.z, nop.z, rck.l
- .data2 rck.z, ret.l, rmi.l, rmi.z, rmu.l, rmu.z, rol.l, rol.z
- .data2 ror.l, ror.z, rtt.z, sar.l, sar.z, sbf.l, sbf.z, sbi.l
- .data2 sbi.z, sbs.l, sbs.z, sbu.l, sbu.z, sde.l, sdf.l, sdl.p
- .data2 sdl.n, set.l, set.z, sig.z, sil.p, sil.n, sim.z, sli.l
- .data2 sli.z, slu.l, slu.z, sri.l, sri.z, sru.l, sru.z, sti.l
- .data2 sts.l, sts.z, str.s0, tge.z, tle.z, trp.z, xor.l, xor.z
- .data2 zer.l, zer.z, zge.l, zgt.l, zle.l, zlt.l, zne.l, zrf.l
- .data2 zrf.z, zrl.p, dch.z, exg.s0, exg.l, exg.z, lpb.z
- dispat2: ! base for 4 byte offsets
- .data2 ldc.f
- ignmask: .data2 0 ! ignore mask (variable)
- retarea: .data2 0 ! base of buffer for result values (max 8 bytes)
- .data2 0
- .data2 0
- .data2 0
- trapproc:
- .data2 0
- nextp: .data1 0
- header:
- ntext: .data2 0
- ndata: .data2 0
- nproc: .data2 0
- entry: .data2 0
- nline: .data2 0
- hp: .data2 0
- pb: .data2 0
- pd: .data2 0
|