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

Output of file : CHASM.BAS contained in archive : ASSEMBLE.ZIP
ÿ¸ ':Ù***********************************ã ':Ù* PROGRAM CHASM Version 1.9 *
$':Ù* *9
.':Ù* CHeap ASseMbler for the IBM PC. *d
8':Ù* *
B':Ù* Begun 6/15/82 by Dave Whitman *º
`':Ù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 Í 
.º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 ç OFFSETVAL5à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 Í 
<:Ù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 requested W? ‹ (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‘Ç ‹ 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

  3 Responses to “Category : Assembly Language Source Code
Archive   : ASSEMBLE.ZIP
Filename : CHASM.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: