Category : Assembly Language Source Code
Archive   : ASSEMBLE.ZIP
Filename : CHASM.BAS

ÿ¸ ':Ù***********************************ã ':Ù* PROGRAM CHASM Version 1.9 *
$':Ù* *9
.':Ù* CHeap ASseMbler for the IBM PC. *d
8':Ù* *
B':Ù* Begun 6/15/82 by Dave Whitman *º
L':Ù***********************************Â
V':ÙÖ
`':Ùmain programó
j'  Pà :Ùinitializet' :Ùwipe out transient code=~' þŒ ½ "chasm.ovl",ˆ',ALL,© PÃêrÉ_ˆ'  îM :Ùset up sym tableˆ’'  º' :Ùpass 1: build sym table½œ'  Œ( :Ùpass 2: generate obj code & listingצ'  "L :Ùclean upÞ°'þƒº':Ù*******************************************DÄ':Ù* SUBROUTINE PASSONE *wÎ':Ù* Adds user-defined symbols to sym table. *ªØ':Ù*******************************************²â':Ù¿ì'PASS ç óö'LOCTR ç 
:Ù0-255 reserved for p.s. prefix(LINENUM ç 
(±é Ó ÿ£()6( :Ùget source line, initializeP(  |) :Ùgetlinea(( :Ùparse itx2(  ê) :Ùparse<( :Ùif label, enter in sym tableÈF( ‹ LABEL$ èæ "" Í  x- :ÙnewentryîP( :Ùif op, decode, & update loctrZ( ‹ OP$ èæ "" Í  À0 :Ùupdate_loctr3d( :Ùprogress report@n(  ŠMGx( ²M‚(ŽvŒ(:Ù*********************************Ÿ–(:Ù* SUBROUTINE PASSTWO *È (:Ù* Generates obj code & listing. *ñª(:Ù*********************************ù´(:Ù¾( ªK :Ùpass2_initÈ(:Ù)Ò(±é Ó ÿ£()MÜ( :Ùget source line, initializegæ(  |) :Ùgetlinezð( :Ùparse line’ú(  ê) :Ùparse§) :Ùphase error?Õ) ‹ LABEL$ èæ "" Í  †. :Ùcheck_phase) :Ùif op, update loctr, generate obj. code2") ‹ OP$ èæ "" Í  À0 :Ùupdate_loctrZ,) :Ùoutput obj. code & listing liner6)  LJ :Ùoutput‰@) :Ùprogess report–J)  ŠMT) ²±^):Ùwipe out msgßh) X ç ÿ‘(): Y ç Û: Ê ,: ‘ ÎO): Ê Y,Xår)Ž|):Ù********************************************M†):Ù* SUBROUTINE GETLINE *):Ù* Gets line of source code for processing. *µš):Ù* and initializes for new iteration. *é¤):Ù********************************************ñ®):Ù¸)° …#, INPLINE$Â)LINENUM ç LINENUM é EÌ)NEEDOFFSET ç NONE: DSFLAG ç FALSETÖ)OBJLEN ç Zà)Ž—ê):Ù*****************************************************Ôô):Ù* SUBROUTINE PARSE *þ):Ù* Parses input line for any label, op, or operands. *N*:Ù*****************************************************V*:Ùt*LINEPTR ç : LINEPTR2 ç ¨&*LABEL$ ç "": OP$ ç "": SOURCE$ ç "": DEST$ ç ""°0*:ÙÑ:*:Ùset endptr to end of codeD* ENDPTR ç Ø(INPLINE$,";") ê  :Ùjust before comment]N* ‹ ENDPTR ç ê Í ENDPTR ç ÿ’(INPLINE$) :Ùno comment, set to eoleX*:Ù~b*:Ùno code? (return)—l* ‹ ENDPTR ç  Í p+Ÿv*:Ùº€*:Ùconvert to all capsÆŠ*  „+Δ*:Ùäž*:Ùlabel (if any)¨* ‹ ÿ(INPLINE$,) ç " " Í Ð*"²*  , :Ùgetfield8¼* LABEL$ ç FLD$@Æ*:ÙOÐ*:Ùop-codehÚ*  , :Ùgetfield~ä* ‹ Ó FOUND Í p+‘î* OP$ ç FLD$¶ø*:Ùsave ptr to start of operandsÍ+ OPDPTR ç LINEPTRÕ +:Ùù+:Ùdestination operand (if any) +  , :Ùgetfield(*+ ‹ Ó FOUND Í p+;4+ DEST$ ç FLD$C>+:ÙbH+:Ùsource operand (if any){R+  , :Ùgetfield‘\+ ‹ Ó FOUND Í p+¦f+ SOURCE$ ç FLD$¬p+Ž´z+:ÙÔ„+:Ùinternal subroutine capsÿŽ+:ÙScans inpline$ up to comment field,:˜+:Ùconverting l.c. chars. to u.c.. Skips over strings.O¢+‚ I ç  Ì ENDPTRk¬+ C$ ç ÿƒ(INPLINE$,I,)¶+ :Ùskip strings›À+ ‹ C$ èæ "'" Í è+ÂÊ+ STRGEND ç Ø(Ié,INPLINE$,C$)ïÔ+ ‹ STRGEND æ  Í I ç STRGEND: ‰ ò+Þ+ :Ùconverteè+ ‹ ÿ•(C$) çæ a î ÿ•(C$) èç z Í C$ ç ÿ–(ÿ•(C$) ê  ): ÿƒ(INPLINE$,I,) ç C$oò+ ƒ Iuü+Ž¸,:Ù***********************************************************û,:Ù* SUBROUTINE GETFIELD *>,:Ù* Starting at lineptr, trys to return next field in FLD$. *$,:Ù* Sets found if sucessful. Moves lineptr past field. *Ä.,:Ù***********************************************************Ì8,:ÙúB,:Ùfind next non-delimiter or run off endL, ±é LINEPTR èç ENDPTRFV, ‹ Ø(" ,",ÿƒ(INPLINE$,LINEPTR,)) ç  Í t,c`, LINEPTR ç LINEPTR é lj, ²Št,:Ùif past end, not foundª~, ‹ LINEPTR èç ENDPTR Í œ,¿ˆ, FOUND ç FALSEÈ’, ŽÐœ,:Ùï¦,:Ùstrings terminated by '°, ‹ ÿƒ(INPLINE$,LINEPTR,) èæ "'" Í ì,Eº, STRGEND ç Ø(LINEPTRé,INPLINE$,"'")`Ä, ‹ STRGEND ç  Í ì,€Î, LINEPTR2 ç STRGEND é Ø, ‰ 2-—â,:ÙÍì,:Ùotherwise, find next delimter or go 1 past endåö, LINEPTR2 ç LINEPTR- ±é LINEPTR2 èç ENDPTR3
- ‹ Ø(" ,",ÿƒ(INPLINE$,LINEPTR2,)) æ  Í 2-R- LINEPTR2 ç LINEPTR2 é [- ²c(-:Ùu2-:Ùcopy field§<- FLD$ ç ÿƒ(INPLINE$,LINEPTR,LINEPTR2êLINEPTR)¯F-:ÙâP-:Ùmove lineptr past field, set found & returnúZ- LINEPTR ç LINEPTR2 d- FOUND ç TRUE n- ŽI x-:Ù********************************************** ‚-:Ù* SUBROUTINE NEWENTRY *µ Œ-:Ù* Adds new symbol to sym table with default *ë –-:Ù* attributes. (may be changed by pseudo-ops) *!! -:Ù**********************************************)!ª-:ÙJ!´-:Ùalready in table? (error)a!¾- TARGET$ ç LABEL$‚!È-  þ. :Ùoperand_lookup—!Ò- ‹ Ó FOUND Í .®!Ü- ERRS ç ERRS é õ!æ- ‘#,"****Error: Duplicate definition of ";LABEL$;" in ";LINENUMþ!ð- Ž"ú-:Ù!".:Ùtable full? (error)>". ‹ NUMSYM è MAXSYM Í @.U". ERRS ç ERRS é ‘"". ‘#, "****Error: Too many user symbols in "; LINENUMš",. Ž¢"6.:Ù½"@.:Ùelse make new entryÖ"J. NUMSYM ç NUMSYM é ñ"T. SYM$(NUMSYM) ç LABEL$#^. VAL1(NUMSYM) ç LOCTR'#h. SYMTYPE(NUMSYM) ç NEAR/#r.:Ù5#|.Ž^#†.:Ù*********************************‡#.:Ù* SUBROUTINE CHECK_PHASE *°#š.:Ù* Label value same both passes? *Ù#¤.:Ù*********************************ñ#®.‹ OP$ ç "EQU" Í ô.$¸.TARGET$ ç LABEL$#$Â. þ. :Ùoperand_lookup+$Ì.:Ùb$Ö.‹ (SYMTYPE(TABLEPTR) î (NEAR ï MEM)) ç FALSE Í ô.‡$à. ‹ VAL1(TABLEPTR) ç LOCTR Í ô.·$ê. ERRS ç ERRS é : ‘#, "****Phase Error"½$ô.Žö$þ.:Ù*************************************************/%/:Ù* SUBROUTINE OPERAND_LOOKUP *h%/:Ù* Trys to find TARGET$ in sym table. If there, *¡%/:Ù* sets FOUND true, & TABLEPTR to its'position. *Ú%&/:Ù*************************************************÷%0/:Ùscan table for symbol&:/ ‚ TABLEPTR ç  Ì NUMSYMG&D/ ‹ SYM$(TABLEPTR) ç TARGET$ Í €/ :ÙfoundZ&N/ ƒ TABLEPTRb&X/:Ù|&b/:Ùfailure exit point&l/ FOUND ç FALSE˜&v/ Ž±&€/:Ùsucess exit pointÄ&Š/ FOUND ç TRUEÌ&”/ Ž
'ž/:Ù*********************************************************N'¨/:Ù* SUBROUTINE LOOKUP_OP *'²/:Ù* Given op-code in op$, & operand types in dtype & *Ð'¼/:Ù* stype, trys to find op in opcode table. If sucessful, *(Æ/:Ù* sets found true, & opptr to its' position. *R(Ð/:Ù*********************************************************}(Ú/:Ùbinary search for good starting pt.œ(ä/ MOVE ç NUMOP: ST ç MOVEì®(î/ ±é MOVE æç Ã(ø/ MOVE ç MOVEì
)0 ‹ OP$ æ OPCODE$(ST) Í ST ç ST é MOVE :¡ ST ç ST ê MOVE) 0 ‹ ST è  Í ST ç ;)0 ‹ ST æ NUMOP Í ST ç NUMOPD) 0 ²L)*0:Ùx)40:Ùscan for entry matching all 3 fields’)>0 ‚ OPPTR ç ST Ì NUMOPÂ)H0 ‹ OPCODE$(OPPTR) æ OP$ Í „0 :Ùfailedç)R0 ‹ OPCODE$(OPPTR) èæ OP$ Í z0*\0 ‹ (SRCTYPE(OPPTR) î STYPE) ç FALSE Í z0G*f0 ‹ (DSTTYPE(OPPTR) î DTYPE) ç FALSE Í z0^*p0 ‰ ¢0 :Ùfound!m*z0 ƒ OPPTR*„0:Ùfailure exit”*Ž0 FOUND ç FALSE›*˜0 Ž²*¢0:Ùsuccessful exitÄ*¬0 FOUND ç TRUEË*¶0 Žú*À0:Ù***************************************)+Ê0:Ù* SUBROUTINE UPDATE_LOCTR *X+Ô0:Ù* Decodes operation & advances loctr. *‡+Þ0:Ù* On pass 2, generates obj. code. *¶+è0:Ù***************************************¾+ò0:Ùà+ü0:Ùset operand types & valuesý+1 :Ùdestination operand-,1 TARGET$ ç DEST$:  <2 :Ùtype_operandE,1 DTYPE ç TARGTYPE],$1 DVAL1 ç TARGVAL1u,.1 DVAL2 ç TARGVAL2,81 :Ùsource operand­,B1 :Ùspecial case: RET opæ,L1 ‹ OP$ ç "RET" Í STYPE ç PROCTYPE(STKTOP): ‰ ’1ÿ,V1 :Ùnormal source3-`1 TARGET$ ç SOURCE$:  <2 :Ùtype_operandM-j1 STYPE ç TARGTYPEg-t1 SVAL1 ç TARGVAL1-~1 SVAL2 ç TARGVAL2‰-ˆ1:Ù·-’1:Ùfind op in op table (not there: error)Ê-œ1 TARGET$ ç OP$ä-¦1  ž/ :Ùlookup_op÷-°1 ‹ FOUND Í 
2
.º1 ‹ PASS ç  Í ŽN.Ä1 ERRS ç ERRS é : ‘#,"****Syntax Error: ";OP$;DTYPE;STYPE».Î1 ‹ ((ACUM8 ï ACUM16 ï REG8 ï REG16 ï SEG ï CS) î (DTYPE ï STYPE)) Í 2ø.Ø1 ‹ (STYPE î (NONE ï IMMED8 ï IMMED16)) ç FALSE Í 2"/â1 ‹ Ø("BW",ÿ‚(OP$,)) èæ  Í 2?/ì1 DIAG ç DIAG é /ö1 ‘#,"****Diagnostic: Specify word or byte operation"Š/2 Ž£/
2 FLAG ç OFLAG(OPPTR)«/2:Ùã/2:Ùbranch for mach ops & pseudo-ops to update loctr 0(2 ‹ FLAG î MACHOP Í  8; :¡  b>022ŽP0<2:Ù*********************************************************‘0F2:Ù* SUBROUTINE TYPE_OPERAND *Ò0P2:Ù* Sets TARGTYPE to reflect TARGET$'s type. Sets *1Z2:Ù* TARGVAL1 to its' value. If the operand is a register, *T1d2:Ù* sets TARVAL2 to its' val2. If an offset appears, *•1n2:Ù* NEEDOFFSET gets the its' type, and OFFSET its' value. *Ö1x2:Ù*********************************************************Þ1‚2:Ùò1Œ2:Ùany operand?2–2 ‹ ÿ’(TARGET$) æ  Í ´2&2 2 TARGTYPE ç NONE/2ª2 ŽD2´2:Ùin sym table?c2¾2  þ. :Ùoperand_lookupx2È2 ‹ Ó FOUND Í ú2œ2Ò2 TARGTYPE ç SYMTYPE(TABLEPTR)½2Ü2 TARGVAL1 ç VAL1(TABLEPTR)õ2æ2 ‹ TABLEPTR èç PREDEF Í TARGVAL2 ç VAL2(TABLEPTR)þ2ð2 Ž
3ú2:Ùnumber?)33  €4 :Ùtest_number>33 ‹ Ó FOUND Í 63X33 TARGTYPE ç NUMTYPEq3"3 TARGVAL1 ç NUMVALz3,3 Ž“363:Ùdirect mem. ref.?ª3@3  ü5 :Ùmemref¿3J3 ‹ Ó FOUND Í r3Õ3T3 TARGTYPE ç MEMï3^3 TARGVAL1 ç MEMADDRø3h3 Ž4r3:Ùoffset off register?74|3  d7 :Ùparse_disp_off_regL4†3 ‹ Ó FOUND Í ¸3e43 TARGTYPE ç MEMREG~4š3 TARGVAL1 ç REGVAL‡4¤3 Ž–4®3:Ùoffset?«4¸3  ž9 :ÙoffsetÀ4Â3 ‹ Ó FOUND Í ê3Ü4Ì3 TARGTYPE ç OFFSETYPEø4Ö3 TARGVAL1 ç OFFSETVAL
5à3 Ž5ê3:Ùcharactor?5ô3  Ê:35þ3 ‹ Ó FOUND Í &4W54 TARGTYPE ç IMMED8 ï IMMED16r54 TARGVAL1 ç CHARVAL|54 Ž‹5&4:Ùstring?­504 ‹ ÿ(TARGET$,) èæ "'" Í X4Æ5:4 TARGTYPE ç STRINGÏ5D4 Ž×5N4:Ù6X4:Ùnot found? assume near label or mem ref. (error on pass 2)x6b4 ‹ PASS ç  Í ‘#,"****Error: Undefined symbol ";TARGET$: ERRS ç ERRS é “6l4 TARGTYPE ç NEAR ï MEM™6v4ŽÌ6€4:Ù*******************************************ÿ6Š4:Ù* SUBROUTINE TEST_NUMBER *27”4:Ù* Trys to interpret TARGET$ as a number. *e7ž4:Ù* If sucessful, sets FOUND true, NUMVAL *˜7¨4:Ù* to its' value and NUMTYPE to its' type. *Ë7²4:Ù*******************************************Ó7¼4:Ùå7Æ4FOUND ç FALSE8Ð4TN$ ç TARGET$ :Ùworking copy8Ú4:Ù#8ä4:Ùhex number?A8î4 ‹ ÿ‚(TN$,) èæ "H" Í z5T8ø4 :Ùlop off Hs85 TN$ ç ÿ(TN$,ÿ’(TN$)ê)›8 5 :Ùscan for non-hex digits (exit)¨85 I ç Á8 5 ‚ I ç  Ì ÿ’(TN$)Û8*5 C$ ç ÿƒ(TN$,I,)945 ‹ Ø("0123456789ABCDEF",C$) ç  Í Ž9>5 ƒ I'9H5 :Ùget valueF9R5 NUMVAL ç ÿ”("&H" é TN$)`9\5 :Ùset type, returnm9f5 ‰ Ô5u9p5:ÙŒ9z5:Ùdecimal number?´9„5 :Ùscan for non-dec digits (exit)Í9Ž5 ‚ I ç  Ì ÿ’(TN$)ç9˜5 C$ ç ÿƒ(TN$,I,):¢5 ‹ Ø("0123456789-+",C$) ç  Í Ž:¬5 ƒ I/:¶5 :Ùget valueG:À5 NUMVAL ç ÿ”(TN$)O:Ê5:Ùb:Ô5:Ùsucess exitt:Þ5 FOUND ç TRUEØ:è5 ‹ ÿ’(ÿš(NUMVAL)) è  Í NUMTYPE ç IMMED16 ï IMMED8 :¡ NUMTYPE ç IMMED16Þ:ò5Ž;ü5:Ù********************************************F;6:Ù* SUBROUTINE MEMREF *z;6:Ù* Trys to interpret target$ as a direct *®;6:Ù* mem ref. If sucessful, sets FOUND true, *â;$6:Ù* & MEMADDR to the address referanced. *<.6:Ù********************************************<86:Ù>ö6 MEMADDR ç VAL1(TABLEPTR):>7 ‰ F7 :ÙexitB>
7:ÙV>7:Ùfailure exiti>7 FOUND ç FALSE|>(7 TARGET$ ç MR$ƒ>27 Ž‹><7:Ù¡>F7:Ùsucessful exit´>P7 TARGET$ ç MR$»>Z7 Žø>d7:Ù*****************************************************5?n7:Ù* SUBROUTINE PARSE_DISP_OFF_REG *r?x7:Ù* Trys to parse TARGET$ as an offset off a register *¯?‚7:Ù* If sucessful, sets FOUND true, sets NEEDOFFSET *ì?Œ7:Ù* to the offset's type, and OFFSET to it's value . *)@–7:Ù*****************************************************1@ 7:ÙS@ª7PDOR$ ç TARGET$ :Ùsave copy[@´7:Ùo@¾7:Ùspecial caseÉ@È7 ‹ TARGET$ ç "[BP]" Í REGVAL ç : NEEDOFFSET ç IMMED8: OFFSET ç : ‰ N9Ñ@Ò7:Ùè@Ü7:Ùparse reg spec.Aæ7 :Ùset ptr to candidate Að7 PTR ç Ø(TARGET$,"[")IAú7 ‹ PTR èç  Í v9 :Ùno disp, exitcA8 :Ùisolate candidateŠA8 REG$ ç ÿ‚(PDOR$,ÿ’(PDOR$)êPTRé)£A8 :Ùvalid reg. spec?ÍA"8 ‹ REG$ ç "[BP]" Í REGVAL ç : ‰ h8âA,8 TARGET$ ç REG$
B68  þ. :Ùoperand_lookup5B@8 ‹ Ó FOUND ï SYMTYPE(TABLEPTR) èæ MEMREG Í v9NBJ8 :Ùsave reg valuenBT8 REGVAL ç VAL1(TABLEPTR)vB^8:ÙBh8:Ùnow parse disp.§Br8 :Ùisolate candidateÅB|8 DISP$ ç ÿ(PDOR$,PTRê)ÙB†8 :Ùvalid disp?ïB8 TARGET$ ç DISP$ Cš8 :Ùmight be symbol+C¤8  þ. :Ùoperand_lookupPC®8 ‹ Ó FOUND Í à8 :Ùnot sym‘C¸8 ‹ (SYMTYPE(TABLEPTR) î (IMMED16 ï IMMED8)) ç FALSE Í à8ºCÂ8 NEEDOFFSET ç SYMTYPE(TABLEPTR)ÜCÌ8 OFFSET ç VAL1(TABLEPTR)ìCÖ8 ‰ N9Dà8 :Ùor numberDê8  €4 :Ùtest_number7Dô8 ‹ Ó FOUND Í 9VDþ8 NEEDOFFSET ç NUMTYPEpD9 OFFSET ç NUMVAL„D9 ‰ N9˜D9 :Ùor offset°D&9  ž9 :ÙoffsetÈD09 ‹ Ó FOUND Í v9éD:9 NEEDOFFSET ç OFFSETYPEED9 OFFSET ç OFFSETVALEN9:Ùsucess exit.EX9 TARGET$ ç PDOR$@Eb9 FOUND ç TRUEGEl9 Ž[Ev9:Ùfailure exitpE€9 TARGET$ ç PDOR$ƒEŠ9 FOUND ç FALSEŠE”9 ŽÅEž9:Ù***************************************************F¨9:Ù* SUBROUTINE OFFSET *;F²9:Ù* Trys to interpret TARGET$ as an offset operand. *vF¼9:Ù* If sucessful, set FOUND, set OFFSETYPE *±FÆ9:Ù* immed16, and TARGVAL1 to the label's offset. *ìFÐ9:Ù***************************************************ôFÚ9:ÙGä9OS$ ç TARGET$Gî9:Ù>Gø9‹ ÿ(OS$,) èæ "OFFSET(" Í FOUND ç FALSE: ŽSG:‹ PASS ç  Í ¢:[G ::ÙpG::Ùisolate labelœG : TARGET$ ç ÿƒ(TARGET$,,ÿ’(TARGET$)ê)¤G*::Ù¶G4::Ùlook it upÔG>:  þ. :Ùoperand_lookupÜGH::ÙHR:‹ FOUND î (SYMTYPE(TABLEPTR) î (MEM ï NEAR)) Í Ž:)H\: ERRS ç ERRS é jHf: ‘#, "****Error: Illegal or undefined argument for Offset"~Hp: OFFSETVAL ç ŠHz: ‰ ¢:’H„::Ù±HŽ:OFFSETVAL ç VAL1(TABLEPTR)¹H˜::ÙÊH¢:FOUND ç TRUEâH¬:OFFSETYPE ç IMMED16ôH¶:TARGET$ ç OS$úHÀ:Ž)IÊ::Ù***************************************XIÔ::Ù* SUBROUTINE CHAR *‡IÞ::Ù* Trys to interpret TARGET$ as a char *¶Iè::Ù***************************************ÈIò:FOUND ç FALSEãIü:‹ ÿ’(TARGET$) èæ  Í ŽJ;‹ ÿ(TARGET$,) èæ "'" Í Ž!J;‹ ÿ‚(TARGET$,) èæ "'" Í Ž5J; FOUND ç TRUEZJ$; CHARVAL ç ÿ•(ÿƒ(TARGET$,,))`J.;ŽJ8;:Ù*************************************ºJB;:Ù* SUBROUTINE MACHOP *çJL;:Ù* Updates loctr based on op length. *KV;:Ù* On pass 2, generates obj. code. *AK`;:Ù*************************************IKj;:Ù_Kt; ¸= :Ùop_typegK~;:ÙuKˆ;:ÙopcodeŒK’; LOCTR ç LOCTR é µKœ; ‹ PASS ç  Í  ¼> :Ùbuild_opcode½K¦;:ÙÑK°;:Ù2nd op byte? Lº; ‹ (OPVAL(OPPTR) èæ Õ) î (OPVAL(OPPTR) èæ Ô) Í â;%LÄ; LOCTR ç LOCTR é `LÎ; ‹ PASS ç  Í OBJLEN ç OBJLEN é : OBJ(OBJLEN) ç
hLØ;:Ù®Lâ;:Ùroom for m. byte disp. (must go here, modebyte modifys offset)ÍLì; ‹ NEEDOFFSET ç NONE Í 
<6Mö; ‹ (NEEDOFFSET î IMMED8) Í LOCTR ç LOCTR é  :¡ LOCTR ç LOCTR é >M<:ÙwM
<:Ùif direct addr. mode byte, leave room for address®M< ‹ (FLAG î (NEEDMODEBYTE ï NEEDEXT)) ç FALSE Í 2<áM< ‹ (DTYPE ï STYPE) î MEM Í LOCTR ç LOCTR é éM(<:ÙN2<:Ùextension byte?&N<< ‹ (FLAG î NEEDEXT) ç FALSE Í d<?NF< LOCTR ç LOCTR é hNP< ‹ PASS ç  Í  À? :Ùbuild_extpNZ<:Ù‚Nd<:Ùmode byte?­Nn< ‹ (FLAG î NEEDMODEBYTE) ç FALSE Í –<ÆNx< LOCTR ç LOCTR é óN‚< ‹ PASS ç  Í  L@ :Ùbuild_modebyteûNŒ<:ÙO–<:Ù8 bit disp.?6O < ‹ (FLAG î NEEDISP8) ç FALSE Í È<OOª< LOCTR ç LOCTR é yO´< ‹ PASS ç  Í  ^B :Ùbuild_disp8O¾<:Ù–OÈ<:Ù16 bit disp.?¾OÒ< ‹ (FLAG î NEEDISP16) ç FALSE Í ú<×OÜ< LOCTR ç LOCTR é 
Pæ< ‹ PASS ç  Í  :C :Ùbuild_disp16 Pð<:Ù Pú<:Ùimmediate byte?IP= ‹ (FLAG î NEEDIMMED8) ç FALSE Í "=bP= LOCTR ç LOCTR é |P= ‹ PASS ç  Í  ¢D­P"= ‹ WORD ï ((FLAG î NEEDIMMED) ç FALSE) Í J=ÆP,= LOCTR ç LOCTR é òP6= ‹ PASS ç  Í  ¢D :Ùbuild_immed8úP@=:ÙQJ=:Ùimmediate word(s)?HQT= ‹ Ó(WORD) ï ((FLAG î NEEDIMMED) ç FALSE) Í |=ŠQ^= ‹ DTYPE ç IMMED16 Í LOCTR ç LOCTR é  :¡ LOCTR ç LOCTR é ¶Qh= ‹ PASS ç  Í  D :Ùbuild_immed16¾Qr=:ÙÑQ|=:Ùmem. addr.?÷Q†= ‹ (FLAG î NEEDMEM) ç FALSE Í ®=R= LOCTR ç LOCTR é 7Rš= ‹ PASS ç  Í  BE :Ùmem_addr?R¤=:ÙER®=ŽqR¸=:Ù************************************RÂ=:Ù* SUBROUTINE OP_TYPE *ÉRÌ=:Ù* Decides between word & byte ops. *õRÖ=:Ù************************************ýRà=:Ù7Sê=‹ (DTYPE ï STYPE) î (REG16 ï ACUM16 ï SEG ï CS) Í >dSô=‹ (DTYPE ï STYPE) î (REG8 ï ACUM8) Í D>lSþ=:ÙˆS>‹ ÿ‚(OP$,) ç "B" Í D>S>:ÙœS>:Ùword­S&> WORD ç TRUE´S0> Ž¼S:>:ÙÈSD>:ÙbyteÚSN> WORD ç FALSEáSX> ŽTb>:Ù**********************************************MTl>:Ù* SUBROUTINE PSEUDO-OP *ƒTv>:Ù* Branches to routines to handle each pseudo *¹T€>:Ù* op using the value field as an index. *ïTŠ>:Ù**********************************************÷T”>:Ù)Už>• OPVAL(OPPTR)  ÄE, ‚F, ÒF, NH, 4I, ÊInU¨>:Ù EQU ORG DB DS PROC ENDPtU²>Ž¶U¼>:Ù**********************************************************øUÆ>:Ù* SUBROUTINE BUILD_OPCODE *:VÐ>:Ù* Builds opcode, stores it in obj. Increments objlength. *|VÚ>:Ù**********************************************************„Vä>:ÙœVî>OBJLEN ç OBJLEN é »Vø>OBJ(OBJLEN) ç OPVAL(OPPTR)ÃV?:ÙæV ?:Ùadd reg. field if requestedW? ‹ (FLAG î ADDREG) ç FALSE Í f?"W ? :Ùsegment reg.RW*? ‹ DTYPE î (SEG ï CS) Í R ç DVAL2: ‰ R?hW4? :Ùnormal reg.¢W>? ‹ (FLAG î DIRECTION) Í R ç SVAL2ì :¡ R ç DVAL2ìªWH?:ÙÏWR? OBJ(OBJLEN) ç OBJ(OBJLEN) é R×W\?:ÙíWf?:Ùauto word bit?Xp? ‹ (FLAG î AUTOW) ç FALSE Í Ž??Xz? ‹ WORD Í OBJ(OBJLEN) ç OBJ(OBJLEN) é GX„?:Ù^XŽ?:Ùauto count bit?‚X˜? ‹ (FLAG î AUTOC) ç FALSE Í ¶?¶X¢? ‹ STYPE î CL Í OBJ(OBJLEN) ç OBJ(OBJLEN) é ¾X¬?:ÙÄX¶?ŽþXÀ?:Ù**************************************************8YÊ?:Ù* SUBROUTINE BUILD_EXTENSION_BYTE *rYÔ?:Ù* Builds an opcode extension byte. The ext. val *¬YÞ?:Ù* is extracted from bits 3-5 of the flag word. *æYè?:Ù**************************************************îYò?:ÙþYü?:Ùget ext.Z@ MASK ç 8%Z@ EXT ç FLAG î MASK-Z@:ÙdZ$@:Ùdefine proper operand as ext. & build mode bytešZ.@ ‹ FLAG î DIRECTION Í DVAL2 ç EXT :¡ SVAL2 ç EXT¹Z8@  L@ :Ùbuild_modebyte¿ZB@Ž[L@:Ù***************************************************************M[V@:Ù* SUBROUTINE BUILD_MODE_BYTE *”[`@:Ù* Given direction flag, memreg values in dval1 and sval1 and *Û[j@:Ù* reg values in dval2 and sval2, builds an addressing mode *"\t@:Ù* byte. If necessary, also builds displacement byte(s). *i\~@:Ù***************************************************************q\ˆ@:Ù‰\’@OBJLEN ç OBJLEN é ‘\œ@:Ù¾\¦@:Ùspecial case: direct mem. addressing?ë\°@ ‹ ((DTYPE ï STYPE) î MEM) ç FALSE Í ö@]º@ ‹ DTYPE ç MEM Í M ç SVAL2 :¡ M ç DVAL27]Ä@ OBJ(OBJLEN) ç  é MY]Î@  BE :Ùbuild_mem_addrd]Ø@ Žl]â@:Ù„]ì@:Ùnormal mode byte±]ö@ :Ùoperands in normal or reverse order?ó]A ‹ FLAG î DIRECTION Í M ç SVAL1 é DVAL2 :¡ M ç DVAL1 é SVAL2û]
A:Ù^A OBJ(OBJLEN) ç M^A:Ù/^(A:Ùoffset byte(s)?7^2A:ÙU^D:ÙLhHD‹ DTYPE î IMMED16 Í IVAL ç DVAL1:  fDxhRD‹ STYPE î IMMED16 Í IVAL ç SVAL1:  fD~h\DŽ¡hfD:Ùinternal subroutine immed16ÆhpDNUMLOW ç IVAL:  úA :Ùhi/lowÞhzDOBJLEN ç OBJLEN é ùh„DOBJ(OBJLENê) ç NUMLOWiŽDOBJ(OBJLEN) ç NUMHIGHi˜DŽCi¢D:Ù**********************************mi¬D:Ù* SUBROUTINE BUILD_IMMED8 *—i¶D:Ù* Builds byte of immediate data. *ÁiÀD:Ù**********************************ÉiÊD:ÙôiÔD‹ DTYPE î IMMED8 Í IVAL ç DVAL1:  òDjÞD‹ STYPE î IMMED8 Í IVAL ç SVAL1:  òD%jèDŽ=jòD:Ùint. sub. immed8`jüD‹ IVAL èç ÿ î IVAL æç  Í $EojE IVAL ç ²jE ‹ PASS ç  Í ERRS ç ERRS é : ‘#,"****Error: Data too long"ºjE:ÙÒj$EOBJLEN ç OBJLEN é éj.EOBJ(OBJLEN) ç IVALïj8EŽkBE:Ù*********************************AkLE:Ù* SUBROUTINE MEMREF *jkVE:Ù* Builds a memory address word. *“k`E:Ù*********************************›kjE:Ù»ktE:Ùget addr. in hi/low formñk~E ‹ DTYPE ç MEM Í NUMLOW ç DVAL1 :¡ NUMLOW ç SVAL1ükˆE  úAl’E:Ùbuild word'lœE OBJLEN ç OBJLEN é Cl¦E OBJ(OBJLENê) ç NUMLOW^l°E OBJ(OBJLEN) ç NUMHIGHdlºEŽ‡lÄE:Ù***************************ªlÎE:Ù* SUBROUTINE EQU *ÍlØE:Ù* Handles equ pseudo-op. *ðlâE:Ù***************************ølìE:ÙmöE‹ (LABEL$ èæ "") Í FZmF ‹ PASS ç  Í ERRS ç ERRSé: ‘#,"****Error: EQU without symbol"bm
F ŽjmF:ÙmF‹ PASS ç  Í xF‡m(F:ÙÊm2F‹ DTYPE èæ (NEAR ï MEM) Í dF :Ùpass 1 default if not foundàm v>I:Ù* SUBROUTINE PROC *0vHI:Ù* Handles proc pseudo-op. *SvRI:Ù***************************[v\I:ÙwvfI‹ STKTOP è MAXSTK Í ¢IŽvpI ‹ PASS ç  Í ŽI¦vzI ERRS ç ERRS é Ýv„I ‘#, "****Error: Procedures nested too deeply"åvŽI Žív˜I:Ùw¢I:Ùpush new proc type for returns,w¬I STKTOP ç STKTOP é Jw¶I PROCTYPE(STKTOP) ç DTYPEPwÀIŽlwÊI:Ù********************ˆwÔI:Ù* SUBROUTINE ENDP *¤wÞI:Ù* Pops proc stack. *ÀwèI:Ù********************ÈwòI:ÙßwüI‹ STKTOP æ  Í 8JöwJ ‹ PASS ç  Í $JxJ ERRS ç ERRS é :xJ ‘#, "****Error: ENDP without PROC"Bx$J ŽJx.J:Ùbx8JSTKTOP ç STKTOP ê hxBJŽ”xLJ:Ù************************************ÀxVJ:Ù* SUBROUTINE OUTPUT *ìx`J:Ù* Outputs obj code & listing line, *yjJ:Ù* given code in obj(objlength). *DytJ:Ù************************************Ly~J:Ù‰yˆJ‹ DSFLAG Í H$ ç ÿš(LOCTRêDVAL1) :¡ H$ ç ÿš(LOCTRêOBJLEN)§y’JH$ ç Ö(êÿ’(H$),"0") é H$¸yœJ‘#, Î) H$;Íy¦J:Ùfirst 6 bytesØy°J I ç æyºJ ‘#, Î)õyÄJ ±é I èç zÎJ ‹ I æ OBJLEN Í K3zØJ þ… BYTE$ ç ÿ–(OBJ(I)): þˆ #hzâJ H$ ç ÿš(OBJ(I)): ‹ ÿ’(H$) ç  Í H$ ç "0" é H$xzìJ ‘#, H$;‰zöJ I ç I é ’zK ²šz
K:ÙÀzK:Ùsource (truncate if necessary)ÏzK ‘#, Î)ìz(K ‘#, × "####"; LINENUM;{2K ‘#, ÿ˜() ÿ(INPLINE$, LWIDTHê){ : † PROCTYPE(MAXSTK): STKTOP ç ƒŒÚŎÀŒäÅ:Ù*****************************************************ýŒîÅ:Ù* SUBROUTINE OPEN_FILES *:øÅ:Ù* Prompts user for i/o filenames, then opens files. *wÆ:Ù***************************************************** Æ:Ùƕ § ‰ 8Ǖ Æ:Ù§*Æ:Ùinput fileٍ4Æ Ê ,: …"Source code file name? [.asm] ", S$ó>Æ ‹ S$ ç "" Í Å: ‰ 4ÆŽHÆ :Ùif no extension, add defaultߎRÆ ‹ Ø(S$,".") ç  Í SC$ ç S$ é ".asm" :¡ SC$ ç S$: S$ ç ÿ(S$,Ø(S$,".")ê)öŽ\Æ º SC$ ‚ … AS #
fÆ Ê ,DpÆ …"Direct listing to Printer (P), Screen (S), or Disk (D)?",L$^zÆ ‹ L$ ç "" Í Å: ‰ fƚ„Æ ‹ Ø("PpSsDd",L$) ç  Í Å: ‰ fÆ :Ùinvalid responseۏŽÆ ‹ L$ ç "P" ï L$ ç "p" Í L$ ç "lpt1:" : ‰ ÊÆ :Ùprinter?˜Æ ‹ L$ ç "S" ï L$ ç "s" Í L$ ç "scrn:" : ‰ ÊÆ :Ùscreen?<¢Æ Ê ,: ‘ ÿ˜(O);: Ê ,n¬Æ ‘"Name for listing file? [";S$;".lst] ";¶Æ … "",L$ÀÀÆ ‹ L$ ç "" Í L$ ç S$ é ".lst" :Ùdefault to source nameېÊÆ º L$ ‚ OUTPUT AS #ûÔƑ#, :Ùtest listing device‘ÞÆ:Ùobject fileD‘èÆ Ê ,: ‘ "Name for object file? [";S$;".com] ";Q‘òÆ … "",O$y‘üÆ :Ùdefault to source file name.com‘Ç ‹ O$ ç "" Í O$ ç S$ é ".com"đÇ :Ùwill open after symtable setupé‘Ǖ § ‰  :Ùkill error trappingö‘$Ç ‘: ‘: ‘ü‘.ǎ’8Ç:Ù****************,’BÇ:Ù*Error Handler *D’LÇ:Ù****************L’VÇ:Ù`’`Nj Õ èæ 5 Í °Ço’jÇ ¿ ,: ź’tÇ ‘ SC$; " not found. Press Esc to exit, anything else to continue.";ڒ~Ç SC$ ç Þ: ‹ SC$ ç "" Í ~Çô’ˆÇ ‹ SC$ ç ÿ–() Í þƒ“’Ç Ê ,: ¿ ,: ‘ ÿ˜(O);7“œÇ Ê ,: ‘ ÿ˜(0); : Ê ,: ¨ 4Æ?“¦Ç:ÙS“°Ç‹ Õ èæ  Í ìÇi“ºÇ » #: ¿ ,: ŧ“ÄÇ ‘"Printer not available. Press any key to continue.";ǓÎÇ L$ ç Þ : ‹ L$ ç "" Í ÎÇå“ØÇ Ê ,: ¿ ,: ‘ ÿ˜(O);”âÇ Ê ,8: ‘ ÿ˜();: Ê ,: ¨ pÆ”ìÇ • § ‰ :”öÇ:Ù***********************Y”È:Ù* SUBROUTINE OP_TABLE *x”
È:Ù***********************€”È:Ùœ”Ⱥ "chasm.dat" ‚ … AS #ǔ(È:Ùnote: c$ used to skip data commentsϔ2È:Ùó”<ȅ#, NUMOP: ° …#,C$: ° …#, C$&•FȆ OPCODE$(NUMOP), OPVAL(NUMOP), SRCTYPE(NUMOP)I•PȆ DSTTYPE(NUMOP), OFLAG(NUMOP)Q•ZÈ:Ùe•dȂ I ç  Ì NUMOP£•nÈ …#, OPCODE$(I),OPVAL(I),DSTTYPE(I),SRCTYPE(I),OFLAG(I)³•xÈ ° …#, C$½•‚È ƒ IՌȎ䕖È:Ù*************************– È:Ù* SUBROUTINE HEADER *&–ªÈ:Ù* Prints listing header.*G–´È:Ù*************************O–¾È:Ùq–ÈÈLWIDTH ç O :Ùdefault widthy–ÒÈ:Ù–ÜÈ:Ùtitle & dateŖæÈ D$ ç ÿ(þ,) é "/" é ÿƒ(þ,,) é "/" é ÿ‚(þ,)ð–ðÈ ‘#, SC$ ÎLWIDTHêÿ’(D$)) D$:‘#,:‘#,ø–úÈ:Ù—É:Ùprinter set up?*—É ‹ L$ èæ "lpt1:" Í TÉp—É :Ùfor NEC 8023 printer, remove quotes for auto condensed mode®—"É :Ùsimilar code may be substituted for other printers.ٗ,É:Ù LWIDTH = 131: WIDTH #2, LWIDTH + 1˜6É:Ù PRINT#2, CHR$(27) + "Q" 'pmodeon%˜@É:Ù PMODEOFF$ = CHR$(27) + "N"-˜JÉ:ÙD˜TÉ:Ùcolumn headingsv˜^É ‘#,"LOC"Î)"OBJ"Î)"LINE"Î)"SOURCE":‘#,~˜hÉ:Ù„˜rɎÙ PM