OR AX,AX JZ memin5 ;:no std in file MOV stdin,#$0000 ;set handle: std in MOV.B stdinfl,#$00 ;clear flag memin5 MOV stdoutof,DI ;buffer addr std output CS: MOV AX,[SI]$12 ;set std out buffer MOV stdoutsz,AX OR AX,AX JZ memin6 ;:no std out file MOV stdout,#$0001 ;set handle: std out MOV.B stdoutfl,#$00 ;clear flag:not open memin6 ADD SI,#$14 ;set return addr PUSH SI XOR AX,AX ;0 -> ES MOV ES,AX ES: ;save div / 0 interrupt MOV AX,div0vec MOV svintv,AX ES: MOV AX,availmem ;div0vec1 MOV svintv1,AX ES: ;now set own routine MOV div0vec,#div0err ES: MOV availmem,CS ;div0vec1 TEST modeflg,#$0008 ;set breakpoint int ? JZ memin7 ;:no ES: MOV int3vec,#brkint ES: MOV int3vec1,CS memin7 TEST modeflg,#$0004 ;test for ^C, ^S ? JZ memin8 ;:no MOV.B cbreak,#$01 ;set flag memin8 MOV verror,#$10D0 ;set error vec XOR AX,AX MOV errpos2,AX ;clear error pos MOV ovrpnbuf,AL ;clear ovrlay pathname MOV CX,stdinsz ;open std in for read PUSH DS MOV DI,#stdin CALL xresettx MOV CX,stdoutsz ;open std out for write PUSH DS MOV DI,#stdout CALL xrewrttx MOV.B errio,#$00 ;clear flag CALL xcrtinit ;CrtInit RET ;" readvers MOV AH,#$30 ;Read Version Number CALL dos ;do MS-DOS OR.B AL,AL ;Version 0 ? JZ verserr ;yes:error RET ;' verserr MOV DX,#msgdos JMP.b writerr ;' memerr MOV DX,#msgmem writerr PUSH CS ;CS -> DS POP DS MOV AH,#$09 ;print string CALL dos ;do MS-DOS MOV DX,#msgend MOV AH,#$09 ;print string CALL dos ;MS-DOS MOV AH,#$00 ;exit program CALL dos ;"do MS-DOS msgmem B "Not enough memory$" msgdos B "Incorrect DOS version$" msgend B $0D,$0A,"Program aborted",$0D,$0A,"$" ;" progend PUSH AX ;End of program PUSH DS ;AX=0:normal MOV DI,#stdin ;close std input CALL xclosetx PUSH DS MOV DI,#stdout ;close std output CALL xclosetx XOR AX,AX ;restore div / 0 int MOV ES,AX MOV AX,svintv ES: MOV div0vec,AX MOV AX,svintv1 ES: MOV availmem,AX ;div0int1 POP AX ;end flag TEST modeflg,#$0001 ;direct mode ? JNZ turbort ;yes: return to Turbo MOV AH,#$4C ;end process CALL dos ;'return to MS-DOS turbort MOV AH,#$80 ;close all files CALL dos PUSH turbocs ;set return addr MOV AX,#turboret PUSH AX PUSH DS ;DS -> ES POP ES MOV DS,turbods RETF ;"return to Turbo ;Uncrunch program ;This routine makes space for overlays, which are not stored ;in the main code file. It makes use of an inline data structure: ;+ 0:length of the block to move ;+ 2:destination addr of this block ;This makes a list which continues at the end of each block. uncrunch POP BX ;return addr CS: MOV AX,[BX] ;get block length OR AX,AX ;0 ? JZ uncrdone ;yes:end of list PUSH DS ;save DS PUSH CS ;CS -> DS POP DS PUSH CS ;CS -> ES POP ES ;push list on stack XOR DX,DX ;count blocks uncrlist MOV AX,[BX] ;get word OR AX,AX ;end of list ? JZ uncrstrt ;:yes PUSH BX ;push offset ADD BX,AX ;add offset INC DX ;count entry JMP uncrlist ;'continue uncrstrt MOV CX,BX ;last ptr POP BX ;get ptr from stack MOV SI,BX ;+4 -> beginning of block ADD SI,#$04 MOV DI,[BX]$02 ;get destination addr CMP SI,DI ;the same ? JZ uncrno SUB CX,SI ;block length ADD SI,CX ;ptrs to last byte in block ADD DI,CX DEC SI DEC DI STD ;move backwards REPZ MOVS.B uncrno DEC DX ;another block ? JNZ uncrstrt ;:yes MOV [BX],#$0000 ;clear the list: uncrunched POP DS ;restore DS uncrdone ADD BX,#$04 ;skip inline data JMP BX ;"return ;Overlay header. Inline parameters: ;+ 0:currently valid procedure (ptr into file) ;+ 2:name of the overlay file ;+ F:start of the procedure code rdover POP SI ;get return addr CS: ;DX = file offset of proc wanted CMP DX,[SI] ;is it already there ? JNZ ovrread ;:no ovrcall ADD SI,#$0F ;skip filename JMP SI ;'jump into procedure ovrread PUSH AX ;AX = overlay length PUSH DX ;save overlay pos PUSH SI ;save dest addr MOV DI,#ovrpnbuf ;scan overlay pathname XOR.B AL,AL ;clear char buffer ovrscan MOV.B AH,AL ;buffer:last char MOV.B AL,[DI] ;get char OR.B AL,AL ;end of name ? JZ ovrpne ;:yes INC DI ;next char JMP ovrscan ;'continue scanning ovrpne PUSH DI ;save end pos OR.B AH,AH ;test last char JZ ovrnob ;:no path specified CMP.B AH,#$3A ;: ? JZ ovrnob ;:yes CMP.B AH,#$5C ;\ ? JZ ovrnob ;:yes MOV.B [DI],#$5C ;store a \ at the end INC DI ovrnob INC SI ;set to beg of filename INC SI ovrcopy CS: ;get char from filename MOV.B AL,[SI] MOV.B [DI],AL ;store in pathname INC SI INC DI ;next char OR.B AL,AL ;end ? JNZ ovrcopy ;no: continue MOV AX,#$3D00 ;open file MOV DX,#ovrpnbuf ;pathname PUSH DS ;DS -> ES POP ES CALL dos ;do it MOV BX,AX ;file handle POP DI ;restore parms POP SI POP DX MOV.B [DI],#$00 ;restore overlay pathname JB ovrerr ;:error CS: ;store pos as current pos MOV [SI],DX ;in the overlay header MOV AX,#$4200 ;seek absolute XOR.B CH,CH ;pos = DX*256 MOV.B CL,DH MOV.B DH,DL XOR.B DL,DL CALL dos ;do it POP CX ;restore length JB ovrerr ;:error MOV AH,#$3F ;read byte block LEA DX,[SI]$0F ;destination addr PUSH DS ;save DS PUSH CS ;CS -> DS POP DS CALL dos ;do it POP DS ;restore DS JB ovrerr ;:error MOV AH,#$3E ;close file CALL dos JMP ovrcall ;'jump into procedure ovrerr MOV DL,#$F0 ;error: Overlay not found PUSH SI ;return addr JMP runerrrt ;" xovrpath POP BX ;OvrPath CALL getpn ;convert string -> ASCIIZ PUSH BX ;restore ret MOV SI,#pnbuf ;copy into overlay pathname MOV DI,#ovrpnbuf PUSH DS ;DS -> ES POP ES MOV CX,#$0020 ;64 bytes CLD REPZ MOVS RET ;" xkeypres DEC SP ;KeyPressed CALL [vkbdstat] ;check status RET ;" xgotoxy POP BX ;GotoXY POP CX ;column PUSH BX ;restore ret MOV.B DL,AL ;row-1 MOV.B DH,CL ;column-1 DEC.B DL ;(Turbo uses origin 1,1) DEC.B DH JMP setcpos ;"set position xparmstr MOV DX,AX ;ParamStr: # wanted string OR DX,DX ;0 ? JZ prmstr1 CALL prmcnt1 ;search in parm line XCHG AX,BX ;string length -> AX prmstr1 POP BX ;return addr SUB SP,AX ;allot space for string DEC SP MOV DI,SP ;string dest PUSH DS ;save DS PUSH CS ;CS -> DS POP DS PUSH SS ;SS -> ES POP ES CLD ;move string STOS.B ;store length XCHG AX,CX ;-> count REPZ ;move string MOVS.B POP DS ;restore DS JMP BX ;"return xparmcnt XOR DX,DX ;ParamCount: count string entries prmcnt1 MOV DI,#paramlin ;parameter line CS: MOV.B CL,[DI] ;length of param line XOR.B CH,CH INC DI ;beginning of string XOR BX,BX ;clear parm cnt prmcsep JCXZ prmcst ;:end of line CS: ;search char <> tab, space MOV.B AL,[DI] ;read char CMP AL,#$20 ;space ? JZ prmcsep2 ;:continue CMP AL,#$09 ;tab ? JNZ prmcst ;no:start of parm prmcsep2 INC DI ;next char DEC CX ;count length JMP prmcsep ;'continue prmcst MOV SI,DI ;start of parm string prmcstl JCXZ prmcste ;end of line CS: ;search char = tab, space MOV.B AL,[DI] ;get char CMP AL,#$20 ;space ? JZ prmcste ;yes: end of parm CMP AL,#$09 ;tab ? JZ prmcste ;yes: end of parm INC DI ;next char DEC CX ;count length JMP prmcstl ;'continue searching prmcste MOV AX,DI ;end position - beg position SUB AX,SI JZ prmcrt ;=0:forget it INC BX ;count parm DEC DX ;search another parm ? JNZ prmcsep ;:yes prmcrt XCHG AX,BX ;return count, string length RET ;" xstrint MOV.B fmtfield,CL ;Str(Integer): max length MOV fmtsdst,DI ;dest ofs POP BX ;ret addr POP fmtsdst1 ;dest seg POP CX ;format POP AX ;number PUSH BX ;restore ret PUSH CX ;save format MOV BX,#pnbuf ;dest buffer CALL intasc ;Integer -> ASCII JMP.b str1 ;'store in string xstrreal MOV.B fmtfield,CL ;Str(Real): max length MOV fmtsdst,DI ;dest ofs POP BX ;ret addr POP fmtsdst1 ;dest seg POP DX ;format 2 POP AX ;format 1 MOV DI,#recvbuf ;buffer for real number POP [DI] ;pop real number POP [DI]$02 POP [DI]$04 PUSH BX ;restore ret PUSH AX ;format 1 XCHG AX,CX ;format 2 -> AX MOV BX,#pnbuf ;dest buffer CALL fmtreal ;Real -> ASCII str1 POP CX ;format LES DI,fmtsdst ;ptr to dest string PUSH DI ;save begin pos MOV.B DL,fmtfield ;max. field size XOR.B DH,DH XCHG AX,BX ;endposition - buffer pos SUB AX,#pnbuf ;-> length SUB CX,AX ;max len - len JBE strcpy0 ;:too long strpad INC DI ;pad with spaces ES: MOV.B [DI],#$20 INC.B DH ;count len CMP.B DH,DL ;= max len ? JZ strdone ;yes:done LOOP strpad ;continue padding strcpy0 XCHG AX,CX ;num len -> CX MOV BX,#pnbuf ;source ptr strcopy MOV.B AL,[BX] ;get char INC BX ;ptr to next INC DI ES: MOV.B [DI],AL ;store in string INC.B DH ;pos = max len ? CMP.B DH,DL JZ strdone ;yes: end it LOOP strcopy ;continue strdone POP DI ;restore dest ptr ES: MOV.B [DI],DH ;store length RET ;" xvalint XOR.B AL,AL ;Val(Integer) JMP.b val1 ;' xvalreal MOV AL,#$01 ;Val(Real) val1 MOV fmttype,AL ;store type MOV fmtpdst,DI ;pos ofs POP BX ;ret addr POP fmtpdst1 ;pos seg POP fmtvdst ;dest ofs POP fmtvdst1 ;dest seg CALL getstz ;get string from stack PUSH BX ;restore ret XOR AX,AX ;no error MOV BX,#pnbuf CMP.B [BX],AL ;null string ? JZ valrt ;:set pos, no change to dest CMP.B fmttype,AL ;integer ? JNZ val2 ;:no CALL ascint ;ASCIIZ -> Integer JB valerr ;:error LES DI,fmtvdst ;dest ptr ES: MOV [DI],AX ;store result JMP.b valend ;'get error pos val2 MOV DI,#recvbuf ;real dest CALL ascreal ;ASCIIZ -> Real JB valerr ;:error MOV SI,DI LES DI,fmtvdst ;move real into CLD ;dest var MOVS MOVS MOVS valend XOR AX,AX ;no error CMP.B [BX],AL ;end of buffer reached ? JZ valrt ;:yes valerr XCHG AX,BX ;calculate error pos SUB AX,#pnbuf0 valrt LES DI,fmtpdst ;store error pos ES: MOV [DI],AX RET ;" getpn MOV CX,#$0040 ;get string from stack JMP.b gstz1 ;'max 64 chars getstz MOV CX,#$007F ;max 127 chars gstz1 MOV DI,#pnbuf ;dest buffer (redundant!) POP AX ;ret addr MOV SI,SP ;ptr to string SS: MOV.B DL,[SI] ;get length XOR.B DH,DH CMP CX,DX ;> max length ? JBE gstz2 ;yes, limit it MOV CX,DX ;take this length gstz2 INC DX INC SI ;skip length MOV DI,#pnbuf ;dest ptr PUSH DS ;DS -> ES POP ES PUSH SS ;SS -> DS POP DS CLD REPZ ;move string into buffer MOVS.B PUSH ES ;restore DS POP DS MOV.B [DI],#$00 ;store a 0 at the end ADD SP,DX ;remove string from stack JMP AX ;"return xrndmize MOV AH,#$2C ;Randomize: Get time CALL dos MOV rndseed1,CX ;store as random seed MOV rndseed,DX RET ;" xmovevar POP BX ;Move var - CX = length MOV DX,DS ;save DS MOV SI,DI ;source ofs POP DS ;source seg POP DI ;dest ofs POP ES ;dest seg CLD ;move var REPZ MOVS.B MOV DS,DX ;restore DS JMP BX ;"return xblkparm POP BX ;Copy var -> stack MOV DX,DS ;save DS MOV SI,DI ;source ofs POP DS ;source seg SUB SP,CX ;make space - CX = len MOV DI,SP ;dest ptr PUSH SS ;SS -> ES POP ES CLD ;move it REPZ MOVS.B MOV DS,DX ;restore DS JMP BX ;"return xfillchr POP BX ;FillChar POP CX ;number of bytes POP DI ;array ofs POP ES ;array seg CLD ;fill it - char in AL REPZ STOS.B JMP BX ;"return xmove XCHG AX,CX ;Move: Count -> CX MOV DX,DS ;save DS POP BX ;ret addr POP DI ;dest ofs POP ES ;dest seg POP SI ;source ofs POP DS ;source seg CLD ;forward move CMP SI,DI ;source > dest ? JNB domove ;yes: move forward ADD SI,CX ;set ptr to end of block ADD DI,CX DEC SI DEC DI STD ;move backwards domove REPZ ;do it MOVS.B MOV DS,DX ;restore DS JMP BX ;"return xsetregs POP BX ;Get parms for MsDos, Intr POP AX ;record seg PUSH BP ;save regs PUSH DS PUSH AX ;save record addr PUSH DI PUSH BX ;restore ret MOV SI,DI ;pointer -> source MOV DS,AX ;source segment CLD LODS ;AX value -> stack PUSH AX LODS ;BX value MOV BX,AX LODS ;CX value MOV CX,AX LODS ;DX value MOV DX,AX LODS ;BP value MOV BP,AX LODS ;SI value -> stack PUSH AX LODS ;DI value MOV DI,AX LODS ;DS value PUSH AX LODS ;ES value MOV ES,AX POP DS ;get DS,SI,AX from stack POP SI POP AX RET ;" xgetregs PUSHF ;store register values PUSH ES PUSH DI PUSH BP MOV BP,SP ;stack index LES DI,[BP]$0A ;get record ptr CLD ;store AX STOS MOV AX,BX ;store BX STOS MOV AX,CX ;store CX STOS MOV AX,DX ;store DX STOS POP AX ;store BP (from stack) STOS MOV AX,SI ;store SI STOS POP AX ;store DI (from stack) STOS MOV AX,DS ;store DS STOS POP AX ;store ES (from stack) STOS POP AX ;store flags (from stack) STOS POP BX ;return addr ADD SP,#$04 ;clear stack POP DS ;restore DS,BP POP BP JMP BX ;"return xindchk CMP AX,CX ;array index check JNB chklim1 ;AX>=limit CX:error RET ;' chklim1 MOV DL,#$90 ;Index out of range JMP.b runerrrt ;" NOP ;Range check CX<=AX<=DX xrngchk CMP AX,CX JL chkrng1 ;not enough:error CMP AX,DX JG chkrng1 ;too much:error RET ;' chkrng1 MOV DL,#$91 ;Scalar or subrange JMP.b runerrrt ;"out of range NOP ;Stack check xchkstk MOV AX,SP ;CX=space required SUB AX,CX ;SP-CX JB chkstk1 ;:error CMP AX,#$0200 ;getting tight ? JB chkstk1 ;:yes MOV CL,#$04 ;convert to segment SHR AX,CL MOV CX,SS ADD AX,CX CMP AX,hptop1 ;compare with heap top JB chkstk1 ;below:error RET ;' chkstk1 MOV DL,#$FF ;heap / stack collision JMP.b runerrrt ;" NOP ;Breakpoint interrupt brkint POP BX ;return addr POP AX ;AX POPF ;Flags PUSH BX ;restore ret OR.B cbreak,#$02 ;set flag: int test DEC SP CALL kbdstat ;Key pressed ? JZ brkno ;:no DEC SP CALL kbdget ;get that key brkno AND.B cbreak,#$01 ;restore flag CMP AL,#$03 ;^C ? JZ brkbrk ;:yes RET ;' brkbrk POP errpos ;get return addr ADD errpos,#$02 ;adjust for length of INT3 brkmsg MOV DX,#$0001 ;error: break JMP.b error ;" xiores XOR AX,AX ;IOResult: clear AX XCHG.B AL,errnum ;read error, clear it RET ;" xiochk CMP.B errnum,#$00 ;check for I/O-error JNZ chkioerr RET ;' chkioerr MOV.B DL,errnum ;get error number MOV DH,#$01 ;I/O-error JMP.b error ;'display message div0err POP BX ;Div/0 interrupt POP AX ;take stuff from stack POPF PUSH BX ;restore ret MOV DL,#$04 ;div / 0 runerrrt POP errpos ;error pos: return addr runerr MOV DH,#$02 ;runtime error error PUSH DX ;save error number CALL reinit1 ;reinit files, I/O POP DX ;error number MOV AX,errpos SUB AX,#$0003 XCHG AX,errpos2 ;store pos of call OR AX,AX ;break ? JNZ errbrk ;:yes PUSH DX ;save error number PUSH DX PUSH errpos2 CALL [verror] ;error handler POP DX ;restore err number errbrk CMP.B DH,#$01 ;Break ? JNB errrunio ;:no CALL prints B "^C",$0D,$0A,"User Break",$00 JMP.b errwpos ;' errrunio MOV.B errio,#$FF ;set flag: real error JA errrun ;:runtime error CALL prints B $0D,$0A,"I/O",$00 JMP.b errerr ;' errrun CALL prints B $0D,$0A,"Run-time",$00 errerr CALL prints B " error ",$00 MOV.B AL,DL ;write error number CALL whexbyte ;(hex) errwpos CALL prints B ", PC=",$00 MOV AX,errpos2 ;display error pos CALL whexword CALL prints B $0D,$0A,"Program aborted",$0D,$0A,$00 MOV AL,#$01 ;Program end: error JMP progend ;" RET $0004 ;"Error handler iabs OR AX,AX ;Abs(Integer):test sign JNS iabspos ;:positive, zero NEG AX ;negate it iabspos RET ;" irandom PUSH AX ;Random(Integer):save limit CALL dorandom ;do random POP BX ;get limit SHR AX,1 ;div 2 CWD DIV BX ;do modulo XCHG AX,DX ;remainder -> AX RET ;" dorandom MOV BX,rndseed1 ;do random MOV CX,rndseed ;get seed PUSH BX ;save it PUSH CX MOV.B AL,BH ;permutate it MOV.B BH,BL MOV.B BL,CH MOV.B CH,CL XOR.B CL,CL RCR.B AL,1 RCR BX,1 RCR CX,1 POP AX ;old seed ADD CX,AX ;add it POP AX ADC BX,AX MOV AX,#$62E9 ;add constant ADD CX,AX MOV AX,#$3619 ADC BX,AX MOV rndseed1,BX ;new seed MOV rndseed,CX MOV AX,BX ;result RET ;" intasc OR AX,AX ;Integer -> ASCII JNS iapos ;:positive number NEG AX ;negate it MOV.B [BX],#$2D ;store a - INC BX iapos XOR.B CH,CH ;flag for leading zeroes MOV DX,#$2710 ;digit 10000 CALL iadigit MOV DX,#$03E8 ;digit 1000 CALL iadigit MOV DX,#$0064 ;digit 100 CALL iadigit MOV DL,#$0A ;digit 10 CALL iadigit MOV.B CL,AL ;do it direct JMP.b iadput ;'last digit iadigit XOR.B CL,CL ;clear digit iadsub INC.B CL ;do successive subtraction SUB AX,DX ;(faster than DIV) JNB iadsub ;:continue ADD AX,DX ;restore remainder INC.B CH ;flag:now print zeroes DEC.B CL ;dec number JNZ iadput ;:ok, non-zero DEC.B CH ;clear flag JZ iadnoput iadput ADD.B CL,#$30 ;convert to ASCII MOV.B [BX],CL ;store INC BX iadnoput RET ;" asccard XOR AX,AX ;Read integer number:clear result CMP.B [BX],#$24 ;$ ? MOV DX,#$000A ;base 10 JNZ acdec ;no:ok MOV DL,#$10 ;base 16 acloop INC BX ;go to next char acdec PUSH AX ;save previous result MOV.B AL,[BX] ;get char CALL upcase MOV.B CL,AL ;save char POP AX ;restore result SUB.B CL,#$30 ;digit < 0 ? JB acend ;:yes, end of number CMP.B CL,#$0A ;> 9 ? JB acdigok ;no:ok CMP.B DL,#$10 ;base = 16 ? JNZ acend ;no:end SUB.B CL,#$07 ;adjust hex CMP.B CL,#$0A ;< A ? JB acend ;:end CMP.B CL,#$10 ;> F ? JNB acend ;:end acdigok PUSH DX ;save base MUL DX ;do multiplication POP DX ;restore base JB acret ;:overflow XOR.B CH,CH ;clear hi byte ADD AX,CX ;add digit to result JNB acloop ;:no overflow, continue JMP.b acret ;'end it - overflow acend CMP.B DL,#$10 ;base 16 ? JZ acret ;:yes MOV CX,AX ;CX:=number*2 ADD CX,CX acret RET ;" ascint MOV.B CL,[BX] ;read integer:test sign CMP.B CL,#$2D ;- ? JNZ aipos ;:no INC BX ;go to next char aipos PUSH CX ;save sign CALL asccard ;read integer POP CX ;restore sign JB aichk ;:might be wrong CMP.B CL,#$2D ;- ? JNZ ainoneg ;:no NEG AX ;negate it ainoneg CLC ;no error RET ;' aichk CMP AX,#$8000 ;$8000 ? JNZ aierr ;no:really error CMP.B CL,#$2D ;negative ? JNZ aierr ;no:overflow RET ;'yes:ok aierr STC ;return error RET ;" strload POP BX ;get string var -> stack POP ES ;source seg MOV SI,DI ;source ofs ES: ;get length MOV.B CL,[SI] XOR.B CH,CH ;-> count INC CX ;copy length, too SUB SP,CX ;make space on stack MOV DI,SP ;dest: new stack top PUSH DS ;save DS PUSH ES ;ES -> DS POP DS PUSH SS ;SS -> ES POP ES CLD ;move string to stack REPZ MOVS.B POP DS ;restore DS JMP BX ;"return xstrcn POP SI ;inline string -> stack CS: ;get length MOV.B CL,[SI] XOR.B CH,CH ;-> count INC CX ;copy length, too SUB SP,CX ;make space on stack MOV DI,SP ;dest: new stack top PUSH DS ;save DS PUSH CS ;CS -> DS POP DS PUSH SS ;SS -> ES POP ES CLD ;move string to stack REPZ ;puts SI to end of string MOVS.B POP DS ;restore DS JMP SI ;"return strstore POP DX ;store string from stack MOV.B AL,CL ;max. length dest MOV BX,SP ;stack base SS: ;get length of source string MOV.B CL,[BX] XOR.B CH,CH ADD BX,CX ;add to stack base INC BX ;+1 SS: LES DI,[BX] ;get dest ptr MOV SI,SP ;source ptr:stack CMP.B CL,AL ;too long ? JBE stslenok ;:yes MOV.B CL,AL ;take real length SS: MOV.B [SI],AL ;store length on stack stslenok INC CX ;count PUSH DS ;save DS PUSH SS ;SS -> DS POP DS CLD ;move string REPZ MOVS.B POP DS ;restore DS LEA SP,[BX]$04 ;remove string, ptr JMP DX ;"return xldarrch POP BX ;store string on stack POP ES ;source seg MOV SI,DI ;source ofs XOR.B CH,CH ;CL=length SUB SP,CX ;make space on stack DEC SP MOV DI,SP ;dest addr SS: MOV.B [DI],CL ;store length INC DI PUSH DS ;save DS PUSH ES ;ES -> DS POP DS PUSH SS ;SS -> ES POP ES CLD ;move to stack REPZ MOVS.B POP DS ;restore DS JMP BX ;"return xstrparm POP BX ;String insert / delete XOR.B CH,CH ;CL=length MOV SI,SP ;string pos SS: MOV.B AL,[SI] ;get length XOR.B AH,AH SUB AX,CX ;compare length MOV DI,SI ;dest ptr ADD DI,AX ;+ difference OR AX,AX ;test direction JZ strret ;:same length JNS strins ;:make it shorter MOV SP,DI ;new stack top SS: ;insert - make string longer MOV.B CL,[SI] ;get length INC CX ;+1 -> count PUSH DS ;save DS PUSH SS ;SS -> DS POP DS PUSH SS ;SS -> ES POP ES CLD ;move it REPZ MOVS.B POP DS ;restore DS JMP.b strret ;'return strins SS: ;delete - shorten string MOV.B [SI],CL ;store new length ADD DI,CX ;go to end of string ADD SI,CX INC CX ;count+1 PUSH DS ;save DS PUSH SS ;SS -> DS POP DS PUSH SS ;SS -> ES POP ES STD ;move it up REPZ MOVS.B POP DS ;restore DS INC DI ;beginning of string MOV SP,DI ;= new stack top strret JMP BX ;"return csteq CALL cmpstr ;Compare strings = MOV AX,#$0001 JZ csteq1 ;equal:true DEC AX ;false csteq1 OR AX,AX ;set flags RET ;" cstne CALL cmpstr ;Compare strings <> MOV AX,#$0001 JNZ cstne1 ;not equal:true DEC AX cstne1 OR AX,AX RET ;" cstge CALL cmpstr ;Compare strings >= MOV AX,#$0001 JNB cstge1 ;larger or equal:true DEC AX cstge1 OR AX,AX RET ;" cstle CALL cmpstr ;Compare strings <= MOV AX,#$0001 JBE cstle1 ;less or equal:true DEC AX cstle1 OR AX,AX RET ;" cstg CALL cmpstr ;Compare strings > MOV AX,#$0001 JA cstg1 ;larger:true DEC AX cstg1 OR AX,AX RET ;" cstl CALL cmpstr ;Compare strings < MOV AX,#$0001 JB cstl1 ;less:true DEC AX cstl1 OR AX,AX RET ;" cmpstr MOV DI,SP ;Compare strings ADD DI,#$04 ;ignore 2 ret addr SS: MOV.B CL,[DI] ;get len second string XOR.B CH,CH ;clr hi byte INC DI ;ptr to beg of string MOV SI,DI ;calc pos of first string ADD SI,CX ;add len SS: MOV.B DL,[SI] ;get len first string XOR.B DH,DH ;clr hi byte INC SI MOV BX,SI ;calc end pos of string ADD BX,DX ;for removing it MOV.B AL,CL ;second len MOV.B AH,DL ;first len CMP CX,DX ;compare them JBE csshrt ;:CX already shorter XCHG CX,DX ;shorter len -> CX csshrt OR CX,CX ;null string ? JZ csnull ;:yes PUSH DS ;save DS PUSH SS ;SS -> ES POP ES PUSH SS ;SS -> DS POP DS CLD ;compare strings on stack REPZ CMPS.B POP DS ;restore DS JNZ csnoteq ;:not equal - flags are set csnull CMP.B AH,AL ;compare len csnoteq POP DX ;return addr POP CX ;return addr caller MOV SP,BX ;remove strings from stack PUSH CX ;restore ret caller JMP DX ;"return xconcat POP errpos ;Concat: get return addr MOV DI,SP ;pos second string SS: MOV.B DL,[DI] ;len2 XOR.B DH,DH MOV SI,DI ;go to start of first string INC SI ADD SI,DX SS: MOV.B CL,[SI] ;len1 ADD.B DL,CL ;len1+len2 too long ? JB concerr ;yes:error SS: MOV.B [SI],DL ;store new len XOR.B CH,CH ;put first string in front SUB DI,CX ;of second MOV SP,DI ;get space on stack INC CX ;len1+1; len2 will be overwritten PUSH DS ;save DS PUSH SI ;save SI PUSH SS ;SS -> ES POP ES PUSH SS ;SS -> DS POP DS CLD ;move first string REPZ MOVS.B MOV DI,SI ;end addr of string 1 POP SI ;end pos of concat string DEC SI DEC DI MOV CX,DX ;resulting length + 1 INC CX STD REPZ ;copy it up MOVS.B POP DS ;restore DS INC DI MOV SP,DI ;remove garbage from stack JMP [errpos] ;'return concerr MOV DL,#$10 ;String too long JMP runerr ;" xcopy POP errpos ;Copy: get return addr CALL limstind ;limit index (length) MOV CX,AX ;-> CX POP AX ;string pos CALL chkstind ;check string index DEC AX ;pos in string MOV SI,SP ;addr of string SS: MOV.B DL,[SI] ;get length XOR.B DH,DH MOV DI,SP ;pos of dest ADD DI,DX ;+ length SUB DX,AX ;length > pos ? JBE copnull ;no - return null string ADD SI,AX ;begin pos of substring CMP DX,CX ;length > num ? JBE copend ;:yes, sub goes to end ADD SI,CX ;pos end of substring MOV DX,CX ;new length PUSH DS ;save DS PUSH SS ;SS -> ES POP ES PUSH SS ;SS -> DS POP DS STD ;move string REPZ MOVS.B POP DS ;restore DS JMP.b copmovd ;'return result copnull XOR DX,DX ;length = 0 copmovd XCHG SI,DI ;point to beg of new string copend SS: MOV.B [SI],DL ;store length MOV SP,SI ;remove the rest JMP [errpos] ;"return xlength POP BX ;Length MOV DI,SP ;pos of string SS: MOV.B AL,[DI] ;get length XOR.B AH,AH ;clr hi byte ADD SP,AX ;remove string from stack INC SP JMP BX ;"return xpos POP errpos ;Pos (search substring) MOV DI,SP ;pos of string SS: MOV.B DL,[DI] ;length of XOR.B DH,DH INC DI ;begin pos of string MOV SI,DI ;DI:string scanned ADD SI,DX ;go to beg of pattern str SS: MOV.B CL,[SI] ;get pattern len XOR.B CH,CH INC SI ;SI:pattern string MOV BX,SI ;calc stack end pos ADD BX,CX ;to remove strings XOR AX,AX ;find position SUB DX,CX ;DX:length difference JB posend ;pattern too long: not found INC AX ;pos 1 OR CX,CX ;pattern = null ? JZ posend ;yes: found INC DX ;number of compares PUSH DS ;save DS PUSH SS ;SS -> ES POP ES PUSH SS ;SS -> DS POP DS CLD ;forward compare posloop PUSH CX ;save parms PUSH DI PUSH SI REPZ ;compare it CMPS.B POP SI ;restore parms POP DI POP CX JZ posdone ;:found INC AX ;next pos INC DI DEC DX ;another search ? JNZ posloop ;:yes XOR AX,AX ;not found = 0 posdone POP DS ;restore DS posend MOV SP,BX ;remove strings JMP [errpos] ;"return xinsert MOV.B strdstln,CL ;Insert: max. dest len MOV strpos,AX ;pos POP BX ;return addr POP strtrgt ;target string ptr POP strtrgt1 MOV strobj,SP ;object string - on stack MOV strobj1,SS PUSH BX ;restore ret LES DI,strtrgt ;target string PUSH ES ;save ptr for storing result PUSH DI PUSH ES ;get target string CALL strload ;-> stack MOV AX,#$0001 ;Copy(target,1,pos-1) PUSH AX MOV AX,strpos DEC AX CALL xcopy ;do it LES DI,strobj ;get obj string PUSH ES CALL strload ;-> stack CALL xconcat ;concat strings LES DI,strtrgt ;get target string PUSH ES CALL strload ;-> stack PUSH strpos ;Copy(target,pos,255) MOV AX,#$00FF CALL xcopy ;do it CALL xconcat ;concat strings MOV.B CL,strdstln ;max. length CALL strstore ;store string JMP xlength ;"remove strings xdelete MOV strnum,AX ;Delete: number of chars POP BX ;ret addr POP strpos ;pos in string POP strtrgt ;target string POP strtrgt1 PUSH BX ;restore ret LES DI,strtrgt ;target string PUSH ES ;save ptr for storing result PUSH DI PUSH ES ;get target CALL strload ;-> stack MOV AX,#$0001 ;Copy(target,1,pos-1) PUSH AX MOV AX,strpos DEC AX CALL xcopy ;do it MOV AX,strpos ADD AX,strnum ;pos+num OR.B AH,AH ;test it JNZ delnorem ;too big: nothing left LES DI,strtrgt ;get target PUSH ES CALL strload ;-> stack PUSH AX ;Copy(target,pos+num,255) MOV AX,#$00FF CALL xcopy ;do it CALL xconcat ;concat strings delnorem MOV CL,#$FF ;max len - never a problem CALL strstore ;store string RET ;" xstrch POP BX ;String -> char POP AX ;get string DEC.B AL ;test length JNZ stcherr ;<> 1:error XCHG.B AL,AH ;char -> AL JMP BX ;'return stcherr MOV errpos,BX ;store error position MOV DL,#$10 ;String too long JMP runerr ;" xchstr MOV SI,SP ;string -> substring SS: ;(1 char) MOV.B BL,[SI]$02 ;length of string XOR.B BH,BH SS: MOV AX,[BX_SI]$03 ;get char MOV.B AH,AL ;char MOV AL,#$01 ;length = 1 SS: MOV [BX_SI]$03,AX ;store in string RET ;" POP BX ;return string as function result ADD SP,DX ;forget DX bytes on stack MOV SI,SP ;pos of string SS: MOV.B AL,[SI] ;get its length CMP.B AL,CL ;= CL (expected length) ? JZ retstrt ;yes: done XOR.B AH,AH ADD SI,AX ;ptr to end of string MOV DI,SP ;destination (must be longer) XOR.B CH,CH ADD DI,CX ;end of destination XCHG AX,CX ;real length -> count INC CX ;copy length, too PUSH DS ;save DS PUSH SS ;SS -> DS POP DS PUSH SS ;SS -> ES POP ES STD ;move backwards REPZ MOVS.B POP DS ;restore DS INC DI MOV SP,DI ;new stack top retstrt JMP BX ;"return chkstind OR.B AH,AH ;Check string index JNZ stinderr ;> 255:error OR.B AL,AL JZ stinderr ;0:error RET ;' stinderr MOV DL,#$11 ;Invalid string index JMP runerr ;" ;Get set. CL=bytes used, CH=bytes empty at beginning xldset POP BX ;ret addr POP DX ;source seg MOV SI,DI ;source ofs SUB SP,#$20 ;make space on stack MOV DI,SP ;dest ptr PUSH CX ;save crunch byte PUSH SS ;SS -> ES POP ES CLD ;forward OR.B CH,CH ;empty bytes at beginning JZ sld2 ;:none XOR.B AL,AL ;store zeroes sldclr1 STOS.B DEC.B CH JNZ sldclr1 ;:another sld2 PUSH DS ;save DS MOV DS,DX ;DX -> DS REPZ MOVS.B ;move set POP DS ;restore DS POP CX ;restore crunch byte MOV AH,#$20 ;calculate empty bytes SUB.B AH,CH ;at end SUB.B AH,CL JZ sld3 ;:none XOR.B AL,AL ;store zeroes sldclr2 STOS.B DEC.B AH JNZ sldclr2 ;:another one sld3 JMP BX ;"return sldempty POP BX ;Make empty set SUB SP,#$20 ;32 bytes on stack MOV DI,SP ;dest addr PUSH SS ;SS -> ES POP ES MOV CX,#$0010 ;do 32 bytes XOR AX,AX ;fill with zeroes CLD REPZ STOS JMP BX ;"return setincl CALL setindex ;Include element: calc index SS: OR.B [BX],AL ;include it RET ;" setinrng XCHG AX,CX ;Include range in set POP BX ;ret addr POP AX ;lower; upper is in CX PUSH BX ;restore ret SUB.B CL,AL ;upper < lower ? JB srngnil XOR.B CH,CH ;upper-lower -> count INC CX MOV.B AH,CL ;save count CALL setindex ;calc set index (lower) MOV.B CL,AH ;restore count srngloop SS: ;include element in set OR.B [BX],AL SHL.B AL,1 ;for next bit JNB srngbit ;:ok INC BX ;go to next byte MOV AL,#$01 srngbit LOOP srngloop ;:another element srngnil RET ;" setsto MOV SI,SP ;store set. CX as with load INC SI INC SI ;source addr SS: MOV DI,[SI]$20 ;get dest ofs SS: MOV ES,[SI]$22 ;dest seg MOV.B DL,CH ;# empty bytes XOR.B DH,DH ADD SI,DX ;add to source addr XOR.B CH,CH ;CL = # bytes used PUSH DS ;save DS PUSH SS ;SS -> DS POP DS CLD ;move used bytes REPZ MOVS.B POP DS ;restore DS RET $0024 ;"remove set, pointer xsetparm POP BX ;Put set as procedure parm MOV.B DL,CH ;bytes empty at beg XOR.B DH,DH XOR.B CH,CH ;bytes used MOV SI,SP ;source addr ADD SI,DX ;calc end pos ADD SI,CX MOV DI,SP ;dest addr ADD DI,#$20 CMP SI,DI ;= end pos ? JZ putsetrt DEC SI ;go back one byte DEC DI PUSH DS ;save DS PUSH SS ;SS -> ES POP ES PUSH SS ;SS -> DS POP DS ;set is stored as compressed STD ;local var REPZ MOVS.B ;do move it POP DS ;restore DS INC DI MOV SP,DI ;remove empty space putsetrt JMP BX ;"return seteq MOV AX,#$0001 ;Set comparison = JMP.b setcmp ;' setne XOR AX,AX ;Set comparison <> setcmp CALL setptrs ;set parms REPZ ;compare sets CMPS MOV DS,DX ;restore DS JZ setceq ;:equal XOR AX,#$0001 ;invert result setceq OR AX,AX ;test result RET $0040 ;"remove sets from stack setge XOR AX,AX ;Set comparison >= JMP.b setcmp2 ;' setle MOV AX,#$0001 ;Set comparison <= setcmp2 CALL setptrs ;set parms DEC AX ;'test type of comparison JNZ setc2l ;:<= XCHG DI,SI ;swap set1, set2 setc2l LODS ;get byte from set2 OR AX,[DI] ;include set1 SCAS ;compare with set1 JNZ setc2g ;:not the same LOOP setc2l ;:continue MOV AX,#$0001 ;true JMP.b setc2rt ;'end it setc2g XOR AX,AX ;false setc2rt MOV DS,DX ;restore DS OR AX,AX ;test result RET $0040 ;"remove sets from stack sunion CALL setptrs ;Set union: set parms sunion1 LODS ;get byte set 2 OR AX,[DI] ;include set 1 STOS ;store in set 1 LOOP sunion1 ;:continue MOV DS,DX ;restore DS RET $0020 ;"remove set 2 from stack sdiff CALL setptrs ;Set difference: set parms sdiff1 LODS ;get byte set 2 NOT AX ;invert it AND AX,[DI] ;take it from set 1 STOS ;store in set 1 LOOP sdiff1 ;:continue MOV DS,DX ;restore DS RET $0020 ;"remove set 2 from stack sinter CALL setptrs ;Set intersection: set parms sinter1 LODS ;get byte set 2 AND AX,[DI] ;intersect set 1 STOS ;store in set 1 LOOP sinter1 ;:continue MOV DS,DX ;restore DS RET $0020 ;"remove set 2 from stack xsetin MOV BX,SP ;Set IN operation SS: ;pos of set MOV AX,[BX]$22 ;get parm OR.B AH,AH ;> 255 ? JZ setintst ;no: ok XOR AX,AX ;false JMP.b setnotin ;'return result setintst CALL setindex ;calc set index SS: AND.B AL,[BX] ;test set element MOV AX,#$0000 ;false JZ setnotin ;not set: false INC AX ;true setnotin OR AX,AX ;test result RET $0022 ;"remove set, parm setindex MOV.B BL,AL ;Calculate set index, mask XOR.B BH,BH ;BX = bit number MOV CL,#$03 ;bit number DIV 8 SHR BX,CL ADD BX,#$04 ;+SP+4 -> set ptr ADD BX,SP MOV.B CL,AL ;bit number MOD 8 AND.B CL,#$07 MOV AL,#$01 ;create bit mask SHL.B AL,CL RET ;" setptrs MOV SI,SP ;Set parms for set ops ADD SI,#$04 ;ptr set 2 MOV DI,SP ;skip two ret addrs ADD DI,#$24 ;ptr set 1 MOV DX,DS ;save DS PUSH SS ;SS -> ES POP ES PUSH SS ;SS -> DS POP DS MOV CX,#$0010 ;count: 32 bytes CLD RET ;" ptreq CMP AX,BX ;Compare pointers DX:AX = CX:BX MOV AX,#$0000 ;false JNZ ptreqno ;:not equal CMP DX,CX JNZ ptreqno ;:not equal INC AX ;true ptreqno OR AX,AX ;set flags RET ;" ptrne CMP AX,BX ;Compare pointers <> MOV AX,#$0001 ;true JNZ ptrne1 ;not equal: true CMP DX,CX JNZ ptrne1 ;not equal: true DEC AX ;false ptrne1 OR AX,AX ;set flags RET ;" ;*** Real Operations *** ;#1 #2 register usage ;AX CX LSB, exponent ;BX SI mantissa ;DX DI MSB, sign resub MOV resign,#$8000 ;Do real subtraction JMP.b ra1 ;' readd MOV resign,#$0000 ;Do real addition ra1 OR.B CL,CL ;second = 0 ? JZ raret ;:yes, done XOR DI,resign ;change sign2, if sub OR.B AL,AL ;first = 0 ? JNZ ranotriv ;:no raretn2 MOV AX,CX ;second -> result MOV BX,SI MOV DX,DI raret RET ;' ranotriv CMP.B AL,CL ;compare exponents JBE ranoswap ;AL <= CL ! XCHG AX,CX ;otherwhise swap numbers XCHG BX,SI XCHG DX,DI ranoswap MOV.B cvdecexp,CL ;save exp2 SUB.B CL,AL ;exponent difference CMP.B CL,#$28 ;first number too small ? JB ranoundr ;:no MOV.B CL,cvdecexp ;restore exp2 JMP raretn2 ;'second -> result ranoundr MOV resign,DI ;save MSB 2 AND.B resave,#$80 ;mask out mantissa MOV remant,DI ;save MSB 2 XOR.B remant1,DH OR DI,#$8000 ;remove sign OR.B DH,#$80 ;remove sign raadj16l CMP.B CL,#$10 ;shift first in 16-bit-steps JB raadj8 ;:done MOV.B AH,BH ;do it. MOV BX,DX ;first num is shifted to make XOR DX,DX ;exp1 = exp2 SUB.B CL,#$10 JMP raadj16l ;'try again raadj8 CMP.B CL,#$08 ;shift first in 8-bit-steps JB raadj8l ;:done MOV.B AH,BL ;do it MOV.B BL,BH MOV.B BH,DL MOV.B DL,DH XOR.B DH,DH SUB.B CL,#$08 ;count down difference raadj8l OR.B CL,CL ;test difference JZ raadjend ;:adjustment done raadj1l SHR DX,1 ;shift right in 1-bit-steps RCR BX,1 RCR.B AH,1 DEC.B CL JNZ raadj1l ;:continue raadjend MOV AL,cvdecexp ;get exp2 TEST.B remant1,#$80 ;test sign JNZ radosub ;:negative ADD.B AH,CH ;add mantissa ADC BX,SI ADC DX,DI JNB rasign ;:ok RCR DX,1 ;do normalization RCR BX,1 RCR.B AH,1 INC.B AL ;inc exponent JNZ rasign ;:ok STC ;overflow error RET ;' radosub XCHG.B AH,CH ;exchange numbers XCHG BX,SI XCHG DX,DI SUB.B AH,CH ;subtract numbers SBB BX,SI SBB DX,DI JNB ranoneg ;:no underflow XOR.B resave,#$80 ;change sign NOT.B AH ;negate mantissa NOT BX ;= inverted mantissa + 1 NOT DX ADD.B AH,#$01 ADC BX,#$00 ADC DX,#$00 ranoneg MOV CL,#$05 ;normalize number ranrm8l OR.B DH,DH ;upper byte empty ? JNZ ranrm1l ;:no MOV.B DH,DL ;shift left 8 bits MOV.B DL,BH MOV.B BH,BL MOV.B BL,AH XOR.B AH,AH SUB AL,#$08 ;sub 8 from exp JB razero ;:underflow, return 0 DEC.B CL ;count down bytes JNZ ranrm8l ;:another one JMP.b razero ;'underflow ranrm1l TEST.B DH,#$80 ;Mantissa MSB must be 1 JNZ rasign ;:yes, done SHL.B AH,1 ;shift left 1 bit RCL BX,1 RCL DX,1 DEC.B AL ;sub 1 from exp JNZ ranrm1l ;:ok razero XOR AX,AX ;underflow, return zero XOR BX,BX XOR DX,DX RET ;' rasign AND.B DH,#$7F ;clear MSB mantissa XOR.B DH,resave ;set correct sign RET ;" remult OR.B CL,CL ;Real multiplication: second=0 ? JZ rmzero ;yes: return zero OR.B AL,AL ;first=0 ? JZ rmret ;yes: done ADD.B AL,CL ;add exponents CALL testexp ;test exponent MOV remul11,AX ;save first number MOV remul12,BX MOV remul13,DX XOR.B AH,AH ;clear result XOR BX,BX XOR DX,DX MOV DI,#remul21 ;ptr to second mantissa MOV CL,#$05 ;do 5 bytes rmbyt INC DI ;get byte from second mantissa MOV.B CH,[DI] OR.B CH,CH ;0 ? JNZ rmdomul ;no: do multiplication MOV.B AH,BL ;just shift result MOV.B BL,BH ;8 bits right MOV.B BH,DL MOV.B DL,DH XOR.B DH,DH JMP.b rmnxtbyt ;'next step rmdomul MOV SI,#$0008 ;do 8 bits rmmul RCR.B CH,1 ;get bit JNB rmbit0 ;:not set ADD.B AH,remul11a ;add mantissa 1 to result ADC BX,remul12 ADC DX,remul13 rmbit0 RCR DX,1 ;shift result 1 bit right RCR BX,1 RCR.B AH,1 DEC SI ;another bit ? JNZ rmmul ;:yes rmnxtbyt DEC.B CL ;another byte ? JNZ rmbyt ;:yes XCHG AX,CX ;save AX, CL LAHF ;save flags TEST.B DH,#$80 ;already normalized ? JNZ rmnoadj ;:yes SAHF ;restore flags RCL.B CH,1 ;shift 1 bit left RCL BX,1 RCL DX,1 OR.B CL,CL ;check exp JZ rmnoadj ;:underflow DEC.B CL ;sub 1 from exp rmnoadj XCHG AX,CX ;restore AX, CL XOR.B DH,resave ;set sign OR.B AL,AL ;test exponent JNZ rmret ;:ok rmzero XOR AX,AX ;return zero XOR BX,BX XOR DX,DX rmret RET ;" rediv OR.B AL,AL ;Real division JZ rmret ;first=0:done SUB.B AL,CL ;sub exponents CMC CALL testexp ;test exponent MOV remul11,AL ;save exponent MOV DI,#remul21b ;ptr to dest MOV CL,#$05 ;5 bytes MOV SI,#$0008 ;8 bits rdloop CMP DX,remul23 ;compare with num2 JNZ rdcmp CMP BX,remul22 JNZ rdcmp