.XLIST PAGE 60,132 TITLE THE DO-Language SUBTTL CONSTANTS AND PARAMETERS ; MAINSEG SEGMENT ASSUME CS:MAINSEG,SS:MAINSEG,DS:MAINSEG,ES:MAINSEG ; ;------------------------------- ; ORG 1B00H VERIFY DB 'precision 15:fix 0:' DB 'def {x} { }' DB ' {t} 00000:' DB 'open {n} {b:n}:x.=n:' DB 't=.(dec x[1,5]):' DB 'if((t/t[1,2]*t[4,2])[1,5]<>x[26,5]) system:' DB 'clear:' ; ORG 1C00H STAC DB 16 DUP('STACK ') ; %OUT SYMBOLS ORG 1C80H ; ;---------- PARAMETERS ---------- INTRAM DW ? ; LEXANF DW ? LEXFIN DW ? LEXNUM DW ? PS DW ? OS DW ? VS DW ? VD DW ? RS DW ? TS DW ? XP DW ? ; INVEC DW ? INLEN DW ? AUXBEG DW ? AUXFIN DW ? TOP DW ? ; FILLER DB ? PROMPT DB ? INDEV DB ? OUTDEV DB ? STDIN DB ? STDOUT DB ? CRTBLK DB 10 DUP(?) PRT_NO DW ? RS232_NO DW ? ; TOPTOP DW ? ; PRE DW ? PRE2 DW ? PRE3 DW ? APRE DW ? APRE1 DW ? FIX DW ? FIX1 DW ? SPRE DW ? ; ;---------- VARIABLES ---------- GETBEG DW ? GETEND DW ? DB ? GETYPE DB ? GOTBEG DW ? VARLEN DW ? DEVICE DB ? TYPE0 DB ? SOURCE DW ? SRCLEN DW ? OUTVEC DW ? OUTLEN DW ? EFFBEG DW ? EFFLEN DW ? DIFLEN DW ? ; LEXREG DW ? STACKR DW ? RPTFLG DB ? PRORTY DB ? LEXPNT DW ? LEXPN2 DW ? INPLEN DW ? INVLEN DW ? REG DW ? OPJUMP DW ? ; ERROR DB ? ERR DB ? BRKPNT DW ? DW ? ; DELEX DW ? HREG DB ? INFLAG DB '0' OUTFLAG DB '0' SPACE DB ' ' CURSOR DW ? COLOR DW 0700H MREG DB ? PFLAG DB ? ; HANDLE DW ? DSKADR DW 2 DUP(?) NBYTE DW ? RAMADR DW ? BUFFER DW ? ; VSREG DW ? LONGER DB ? COMRES DB ? TYPREG DB ? LASTCH DB ? BOOL DW ? ;------- SORT MERGE -------- NN DW ? LOFF DW ? LSEG DW ? KOFF DW ? KSEG DW ? JOFF DW ? JSEG DW ? ; N DW ? J DW ? K DW ? L DW ? KEYL DW ? ; ;---------- MATHPACKAGE ---------- BCD DW ? ASCI DW ? BIN DB 4 DUP(?) BINAX DB 4 DUP(?) ; TEMP DB ? DB ? ; START0 DW ? POINT0 DW ? END0 DW ? SFTLEN DW ? ; BINASC DB 10 DUP(?) SHIFT DW ? SIGNS DB ? DB ? RANDOM DW 1234H ; OP1 DB 64 DUP(?) OP2 DB 64 DUP(?) RES DB 64 DUP(?) ; SIGNTABLE DB 1,2,4,3,2,1,3,4 ; ;---------- TRANSLATION TABLE ---------- TRANSTAB DB 15,15,15,15,15,15,15,0,0,0,0,0,0,1,15,15 DB 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15 DB 2,15,15,15,15,15,15,10,4,5,14,14,3,14,14,14 DB 16,16,16,16,16,16,16,16,16,16,6,11,14,14,14,15 DB 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15 DB 15,15,15,15,15,15,15,15,15,15,15,7,15,8,15,15 DB 15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15 DB 15,15,15,15,15,15,15,15,15,15,15,12,15,9,15,0 ; ;---------- MESSAGES ------- INMESS DB 'screen:? {the DO-language V2.0} cr cr: ' DB 'if(ram[93,1]<>{ }) {do ram[93,11]:}: ' ERRMES DB '? ram[hex[7412,2],hex[7414,2]] cr: ' DB '? {Error no. }: ?? err: ' ; ;---------- INTRO ----------- INTROM DW 0000H,2400H,3400H,2860H,0000H,0000H,0000H,0000H DW 0000H,0000H,0000H,2200H,0049H,2300H,23FCH,3400H DW 0B020H,3130H,3030H,0908H,117FH,0A0DH,4B53H,004DH DW 0000H,0000H,0000H,000AH,000CH,000DH,0008H,0009H DW 0002,0003H,000FH ; PSTACK DB 120 DUP(?) ;6 * 20 DW 0000H,0000H,0000H OSTACK DB 24 DUP(?) ;2 * 12 VSTACK DB 120 DUP(?) ;6 * 20 RSTACK DB 60 DUP(?) ;6 * 10 TSTACK DB 60 DUP(?) ;3 * 20 PARSTACK DB 60 DUP(?) ;6 * 20 ; SUBTTL DICTIONARY PAGE ORG 2400H LEXICON DB 16 DUP(' ') DB '( ' DW OFFSET MISCL_O, 0000H, '(0' DB '[ double ' DW OFFSET INDEXDBL_O, 0000H, '[0' DB '[ simple ' DW OFFSET INDEXSM_O, 0000H, '[0' DB 'verify ' DW OFFSET VERIFY, 00FFH, 'A0' DB 'init ' DW OFFSET INIT_O, 0000H, 'H0' DB 'system ' DW OFFSET SYSTEM_O, 0000H, 'H0' DB 'in_out ' DW OFFSET INDEV, 0002H, 'A0' DB 'close ' DW OFFSET CLOSE_O, 0000H, 'O6' DB 'open ' DW OFFSET OPEN_O, 0000H, 'O6' DB 'error ' DW OFFSET ERRMES, 004FH, 'A0' DB 'err ' DW OFFSET ERR, 0001H, 'H0' DB 'cr ' DW OFFSET CRTBLK+4, 0002H, 'H0' DB 'inline ' DW OFFSET INLINE_O, 0000H, 'O6' DB 'edit ' DW OFFSET EDIT_O, 0000H, 'O6' DB 'input ' DW OFFSET INPUT_O, 0000H, 'O6' DB 'output ' DW OFFSET OUTPUT_O, 0000H, 'O1' DB 'sort ' DW OFFSET SORT_O, 0000H, 'O6' DB 'merge ' DW OFFSET MERGE_O, 0000H, 'O6' DB 'find ' DW OFFSET FIND_O, 0000H, 'O8' DB 'bios ' DW OFFSET BIOS_O, 0000H, 'O6' DB '? ' DW OFFSET OUTCRT_O, 0000H, 'O1' DB '?? ' DW OFFSET MONITOR_O, 0000H, 'O1' DB 'prompt ' DW OFFSET PROMPT, 00001H, 'A0' DB 'screen ' DW OFFSET COLOR_O, 0000H, 'O0' DB 'do ' DW OFFSET DO_O, 0000H, 'O0' DB 'clear ' DW OFFSET CLEAR_O, 0000H, 'O0' DB 'top ' DW OFFSET TOP, 0002H, 'H0' DB 'precision ' DW OFFSET PRECISION_O,0000H, 'O6' DB 'rnd ' DW OFFSET RANDOM_O, 0000H, 'O8' DB '@ ' DW OFFSET CURSOR_O, 0000H, 'O6' DB 'filler ' DW OFFSET FILLER, 0001H, 'A0' DB 'repeat ' DW OFFSET REPEAT_O, 0000H, 'O6' DB 'fix ' DW OFFSET FIX_O, 0000H, 'O6' DB 'and ' DW OFFSET AND_O, 0000H, 'O2' DB 'or ' DW OFFSET OR_O, 0000H, 'O2' DB 'not ' DW OFFSET NOT_O, 0000H, 'O2' DB 'exit ' DW OFFSET EXIT_O, 0000H, 'H0' DB 'next ' DW OFFSET NEXT_O, 0000H, 'H0' DB 'break ' DW OFFSET BREAK_O, 0000H, 'H0' DB 'adr ' DW OFFSET ADR_O, 0000H, 'O8' DB 'len ' DW OFFSET LEN_O, 0000H, 'O8' DB 'type ' DW OFFSET TYPE_O, 0000H, 'O8' DB 'ind ' DW OFFSET IND_O, 0000H, 'O8' DB 'head ' DW OFFSET HEAD_O, 0000H, 'O8' DB 'tail ' DW OFFSET TAIL_O, 0000H, 'O8' DB 'case ' DW OFFSET CASE_O, 0000H, 'O8' DB 'contents ' DW OFFSET CONTENTS_O, 0000H, 'O8' DB 'pos ' DW OFFSET POS_O, 0000H, 'O8' DB 'bin ' DW OFFSET BIN_O, SIZE BIN_O, 'O8' DB 'dec ' DW OFFSET DEC_O, SIZE DEC_O, 'O8' DB 'if ' DW OFFSET IF_O, 0000H, 'O6' DB 'mptr ' MPTR DW 0000H, 0000H, 41FFH DB 'mem ' DW 0001H, 0000H, 41FFH DB '= ' DW OFFSET EQUAL_O, 0000H, 'O3' DB '> ' DW OFFSET GREATER_O, 0000H, 'O3' DB '< ' DW OFFSET LESS_O, 0000H, 'O3' DB '>= ' DW OFFSET GRTEQU_O, 0000H, 'O3' DB '<= ' DW OFFSET LESSEQU_O, 0000H, 'O3' DB '<> ' DW OFFSET NOTEQU_O, 0000H, 'O3' DB '.= ' DW OFFSET MVLEFT_O, 0000H, 'O1' DB '=. ' DW OFFSET MVRGHT_O, 0000H, 'O1' DB '+ ' DW OFFSET ADD_O, 0000H, 'O4' DB '- ' DW OFFSET SUBTRACT_O, 0000H, 'O4' DB '* ' DW OFFSET MULTIPLY_O, 0000H, 'O5' DB '/ ' DW OFFSET DIVIDE_O, 0000H, 'O5' DB 'ram ' DW 0001H, 0FFFEH, 'A0' DB 'hex ' DW 0001H, 0FFFEH, 'H0' DB 'def ' DW OFFSET DEFINE_O, 0000H, 'O6' DB 'del ' DW OFFSET DELETE_O, 0000H, 'O6' DB 'pass ' DW OFFSET PASS_O, 0000H, 'O6' ; ;--------------------------------------------------------------- ; SUBTTL DO - BIOS PAGE ORG 100H %OUT BIOS ; PROGRAM PROC FAR ; DO_BEGIN: MOV SP,1C78H CALL PARSETUP JMP OUT_MSSG ; ;********** DO BIOS ********** ; INPCH PROC NEAR CMP INFLAG,'0' JNE INRS232 MOV AH,8 INT 21H INPCHEND: RET ; INRS232: CMP INFLAG,'2' JNE INPCHEND MOV DX,RS232_NO MOV AH,2 INT 14H JMP INPCHEND ; INPCH ENDP ;----------------------------- OUTCH PROC NEAR CMP OUTFLAG,'0' JNE PRINTER MOV AH,2 MOV DL,AL INT 21H RET ; PRINTER: CMP OUTFLAG,'1' JNE RS232_1 MOV DX,PRT_NO MOV AH,0 INT 17H RET ; RS232_1: CMP OUTFLAG,'2' JNE OUTFIN MOV DX,RS232_NO MOV AH,1 INT 14H OUTFIN: RET ; OUTCH ENDP ; POSCURSOR PROC NEAR MOV AH,2 INT 10H RET POSCURSOR ENDP ; FWDCURSOR PROC NEAR PUSH BX MOV AH,3 MOV BH,0 INT 10H ;READ CURSOR INC DL MOV AH,2 INT 10H ;POS CURSOR POP BX RET FWDCURSOR ENDP ; BCKCURSOR PROC NEAR PUSH BX MOV AH,3 MOV BH,0 INT 10H DEC DL MOV AH,2 INT 10H POP BX RET BCKCURSOR ENDP ; WRITEATTR PROC NEAR MOV AH,8 INT 10H MOV AH,9 INT 10H RET WRITEATTR ENDP ; ERASE_O PROC NEAR MOV CX,0 MOV DX,184FH MOV BX,COLOR MOV AX,0600H INT 10H MOV DX,0000H MOV BH,0 MOV AH,2 INT 10H RET ERASE_O ENDP ; COLOR_O PROC NEAR CMP VS,0 JE ERASE CALL PULLVA CALL CONVERT MOV AL,BIN MOV BYTE PTR COLOR+1,AL CALL PULLVA CALL CONVERT MOV AL,BIN MOV CL,4 SHL AL,CL OR BYTE PTR COLOR+1,AL ERASE: CALL ERASE_O RET COLOR_O ENDP ; SUBTTL DISK I/O MODULE ;=============================================================== OPEN_O PROC NEAR CALL PULLVA MOV DX,AUXBEG MOV DI,DX MOV SI,GOTBEG MOV CX,VARLEN REP MOVSB CMP DI,AUXFIN JBE OPEN_01 MOV AL,60H JMP ERROUT OPEN_01: MOV AL,0 STOSB MOV AX,3D02H ;OPEN TYPE 02 INT 21H JNC OPEN_1 CMP AL,2 JNE DISK_ERROR OPN_CREATE: MOV AH,3CH MOV CX,0H INT 21H JC DISK_ERROR OPEN_1: CMP AH,0 JE OPEN_11 MOV AL,71H ;SYS ERROR JMP ERROUT OPEN_11: MOV VARLEN,0000H MOV GOTBEG,0000H MOV TYPE0,'A' MOV DEVICE,AL CALL PUSHVA CALL DEF01 OPEN_END: RET OPEN_O ENDP ; CLOSE_O PROC NEAR CALL PULLVA ADD VS,6 CALL SEELEX MOV DI,LEXPNT MOV BL,BYTE PTR [DI+14] MOV BH,0 MOV AH,3EH INT 21H JC DISK_ERROR CLOSE_1: CALL DELETE_O CLOSE_END: RET CLOSE_O ENDP ; READDISK PROC NEAR CMP HANDLE,00FFH JNE READHARD CALL SETUPOFFS MOV SI,DX MOV DI,RAMADR MOV CX,NBYTE MOV DS,AX REP MOVSB MOV AX,ES MOV DS,AX RET ; READHARD: CALL RW_SETUP MOV AH,3FH INT 21H JC DISK_ERROR RET READDISK ENDP ; DISK_ERROR: ADD AL,60H JMP ERROUT ; WRITEDISK PROC NEAR CMP HANDLE,00FFH JNE WRITEHARD CALL SETUPOFFS MOV DI,DX MOV SI,RAMADR MOV CX,NBYTE MOV ES,AX REP MOVSB MOV AX,DS MOV ES,AX RET ; WRITEHARD: CALL RW_SETUP MOV AH,40H INT 21H JC DISK_ERROR RET WRITEDISK ENDP ; RW_SETUP PROC NEAR MOV BX,HANDLE MOV DX,DSKADR MOV CX,WORD PTR DSKADR+2 MOV AX,4200H ;SET POINTER AL=0 INT 21H JC DISK_ERROR MOV BX,HANDLE MOV CX,NBYTE MOV DX,RAMADR RET RW_SETUP ENDP ; OVERLAY PROC NEAR MOV AX,3D00H INT 21H ;OPEN FILE JC DISK_ERROR MOV BX,AX MOV DX,0 MOV CX,0 MOV AX,4202H INT 21H ;FILE SIZE MOV VARLEN,AX MOV DX,0 MOV AX,4200H INT 21H ;GOTO BOF JC DISK_ERROR MOV CX,VARLEN MOV DX,TOP MOV AH,3FH INT 21H ;READ FILE JC DISK_ERROR MOV AH,3EH INT 21H ;CLOSE FILE JNC OVEREND JMP DISK_ERROR OVEREND: RET OVERLAY ENDP ; SETUPOFFS PROC NEAR MOV AX,DSKADR MOV DX,AX MOV CL,4 SHR AX,CL MOV BX,DSKADR+2 MOV CL,12 SAL BX,CL ADD AX,BX AND DX,000FH RET SETUPOFFS ENDP ; ;======================================================== ; SUBTTL MAIN PROCESSOR PAGE %OUT MAIN PROCESSOR ;********* START ********** ; PARSETUP PROC NEAR MOV STACKR,SP CLD MOV SI,OFFSET INTROM MOV DI,OFFSET INTRAM MOV CX,70 REP MOVSB MOV AX,CS ADD AX,1000H MOV WORD PTR MPTR+2,AX MOV CL,12 SHR WORD PTR MPTR+2,CL MOV CL,4 SAL AX,CL MOV WORD PTR MPTR,AX RET PARSETUP ENDP ; ;---------- OUT MESSAGE ---------- OUT_MSSG: MOV GETBEG,OFFSET INMESS MOV GETEND,OFFSET INMESS+79 JMP DO2 ; ;********** INPUT KEYBOARD *********** ; KEYIN PROC NEAR XOR DI,DI MOV BX,INVEC MOV INPLEN,DI IN00: CALL INPCH CMP AL,CRTBLK+3 ;EXCAPE KEY JNE IN01 JMP BREAK IN01: CMP AL,CRTBLK ;BACKSPACE KEY JE DLT CMP AL,CRTBLK+4 ;CARRIAGE RETURN JE CART CMP AL,0 JNE IN02 CALL INPCH CMP AL,CRTBLK+6 ;DEL KEY JE DLT CMP AL,CRTBLK+7 ;CURSOR LEFT JE BSP CMP AL,CRTBLK+8 ;CURSOR RIGHT JE FWD IN02: CMP DI,INPLEN JNE INSERT CMP DI,INVLEN JE FULL CALL OUTCH INC DI INC INPLEN MOV [BX][DI],AL JMP IN00 FULL: MOV AL,7 CALL OUTCH JMP IN00 ; BSP: JMP BACKSP FWD: JMP FORWRD DLT: JMP DELETE CART: JMP CARRET ; ;---------- INSERT CHARACTER --------- ; INSERT: PUSH AX MOV REG,DI MOV DI,INPLEN CMP DI,INVLEN JE INS INC INPLEN MOV DI,INPLEN INS: DEC DI CMP DI,REG JE SHOW MOV AL,[BX][DI] MOV [BX][DI+1],AL JMP INS SHOW: MOV DI,REG INC DI MOV REG,DI POP AX MOV [BX][DI],AL OUT0: CALL OUTCH CMP DI,INPLEN JE MOVBCK INC DI MOV AL,[BX][DI] JMP OUT0 MOVBCK: CMP DI,REG JE EXMOV CALL BCKCURSOR DEC DI JMP MOVBCK EXMOV: JMP IN00 ; ;---------- DELETE ---------- ; DELETE: CMP DI,INPLEN JE DESBS MOV REG,DI INC DI CMP DI,INPLEN JE DESP MOVLFT: INC DI MOV AL,[BX][DI] MOV [BX][DI-1],AL CALL OUTCH CMP DI,INPLEN JNE MOVLFT MOV AL,SPACE CALL OUTCH MV: CALL BCKCURSOR DEC DI CMP DI,REG JNE MV JMP EX ;---------- DESTRUCTIVE SPACE ----------- DESP: MOV AL,SPACE CALL OUTCH CALL BCKCURSOR DEC DI EX: DEC INPLEN JMP IN00 ;---------- DESTRUCTIVE BACKSPACE ---------- DESBS: CMP DI,0 JE EXDES CALL BCKCURSOR MOV AL,SPACE CALL OUTCH CALL BCKCURSOR DEC DI DEC INPLEN EXDES: JMP IN00 ;---------- BACKSPACE ----------- BACKSP: CMP DI,0 JE NOBCK DEC DI CALL BCKCURSOR NOBCK: JMP IN00 ;----------- FORWARD SPACE ---------- FORWRD: CMP DI,INPLEN JE NOFOR INC DI CALL FWDCURSOR NOFOR: JMP IN00 ;---------- CARRIAGE RETURN ---------- CARRET: INC INPLEN MOV DI,INPLEN MOV [BX][DI],AL MOV LASTCH,AL CALL CRETURN RET ; KEYIN ENDP ;---------- CRETURN ---------- CRETURN PROC NEAR MOV AL,CRTBLK+4 CALL OUTCH MOV AL,CRTBLK+5 CALL OUTCH RET CRETURN ENDP ; ;********** GETNEXT ********** ; GETNXT PROC NEAR MOV BX,OFFSET TRANSTAB XOR CX,CX MOV DEVICE,'0' MOV PRORTY,'0' MOV DI,GETBEG MOV DX,GETEND GETON: CMP DI,DX JB GET ENDGET: MOV TYPE0,'E' GETFIN: MOV GETBEG,DI MOV VARLEN,CX RET ; GET: MOV AL,[DI] MOV AH,AL XLAT CMP AH,0 JE ENDGET CMP AL,3 JA GETST LEADIN: INC DI JMP GETON ; GETST: CMP AL,8 JBE LIMIT CMP AL,12 JE ASCII CMP AL,11 JE COMENT0 CMP AL,10 JE HEX0 CMP AL,14 JBE SGN CMP AL,15 JBE IDENT JMP NUMBER LIMIT: INC DI INC CX MOV TYPE0,AH JMP GETFIN ; SGN: JMP SGNOPS COMENT0: JMP COMENT HEX0: JMP HEX ; ;---------- IDENTIFIER ---------- IDENT: MOV GOTBEG,DI GOID: INC CX INC DI CMP DI,DX JE IDEND MOV AL,[DI] XLAT CMP AL,15 JAE GOID ; IDEND: MOV TYPE0,'I' JMP GETFIN ; ;---------- NUMBER ---------- NUMBER: MOV PFLAG,0 MOV GOTBEG,DI GONMBR: INC CL INC DI CMP DI,DX JE NUMEND MOV AL,[DI] CMP AL,'.' JNE GOINT CMP PFLAG,0 JNE NUMEND INC PFLAG JMP GONMBR GOINT: XLAT CMP AL,16 JE GONMBR NUMEND: MOV TYPE0,'N' JMP GETFIN ; ;---------- ASCII STRING ---------- ASCII: MOV AX,1 INC DI CMP DI,DX JE ERR02 ;MISSING CLOSING } MOV GOTBEG,DI GETASC: CMP BYTE PTR [DI],'}' JE CLOSE CMP BYTE PTR [DI],'{' JNE GOASC OPEN: INC AX GOASC: INC DI CMP DI,DX JNE GETASC JMP ERR02 ; CLOSE: DEC AX CMP AX,0 JNE GOASC ENDASC: MOV CX,DI SUB CX,GOTBEG INC DI MOV TYPE0,'A' JMP GETFIN ; ERR02: MOV AL,02H JMP ERROUT ; ;---------- SPECIAL SIGNS +-+/=.<> ---------- SGNOPS: MOV GOTBEG,DI GOSGNOPS: INC CX INC DI CMP DI,DX JE SGNOPSEND MOV AL,[DI] XLAT CMP AL,14 JE GOSGNOPS SGNOPSEND: JMP IDEND ; ;---------- HEX STRING ---------- HEX: INC DI CMP DI,DX JE ERR03 ;CLOSING ' MOV SI,AUXBEG MOV GOTBEG,SI ; GETHEX: MOV AL,[DI] CMP AL,27H JE ENDHEX CALL HEXBIN JAE GOHEX SAL AL,1 SAL AL,1 SAL AL,1 SAL AL,1 MOV [SI],AL INC DI CMP DI,DX JE ERR03 MOV AL,[DI] CMP AL,27H JE ERR04 ;MISSING LOWBYTE CALL HEXBIN JAE ERR04 OR [SI],AL INC SI INC CX CMP CX,255 JE ERR05 ;HEX STRING TOO LONG GOHEX: INC DI CMP DI,DX JNE GETHEX JMP ERR03 ; ENDHEX: CMP SI,AUXFIN JAE ERR06 MOV AUXBEG,SI INC DI MOV TYPE0,'H' JMP GETFIN ;---------- HEXBIN ---------- HEXBIN PROC NEAR SUB AL,30H CMP AL,10 JB NOAD SUB AL,7 CMP AL,16 NOAD: RET HEXBIN ENDP ;---------------------------- ERR03: MOV AL,03H JMP ERROUT ERR04: MOV AL,04H JMP ERROUT ERR05: MOV AL,05H JMP ERROUT ERR06: MOV AL,06H JMP ERROUT ; ;---------- COMENT ----------- COMENT: INC DI CMP DI,DX JE FINGET CMP BYTE PTR [DI],':' JE ENDCOM CMP BYTE PTR [DI],13 JNE COMENT ; ENDCOM: JMP LEADIN FINGET: JMP ENDGET GETNXT ENDP ;---------------------------------------- ; ;********** SEARCH LEXICON ********** SEELEX PROC NEAR MOV DI,LEXNUM COMLEX: MOV LEXPNT,DI MOV CX,VARLEN CMP CX,10 JA ERR07 MOV SI,GOTBEG REPE CMPSB JNE DONE1 CMP VARLEN,10 JE FOUND CMP BYTE PTR [DI],32 JNE DONE1 FOUND: MOV SI,LEXPNT ADD SI,10 MOV DI,OFFSET GOTBEG MOV CX,3 REP MOVSW MOV AL,DEVICE MOV PRORTY,AL RET ; DONE1: MOV DI,LEXPNT SUB DI,16 CMP DI,LEXANF JNE COMLEX ERR07: MOV AL,07H JMP ERROUT SEELEX ENDP ; ;********** DO PROCESSOR ********** ; DO1: MOV AX,INLEN MOV INVLEN,AX MOV AX,INTROM+22 MOV INVEC,AX CALL HEREIS CALL KEYIN MOV BYTE PTR [BX][DI],':' INC BX MOV GETBEG,BX ADD BX,DI MOV GETEND,BX DO2: MOV GETYPE,'A' CALL PUSHPR JMP EOCL ; ;********** DISTRIBUTOR ********** ; PROC01: CMP GETYPE,'H' JE GETCOM CALL GETNXT JMP PROC03 GETCOM: MOV AX,GOTBEG MOV OPJUMP,AX CALL OPJUMP JMP EOCL ; PROC03: CMP TYPE0,'I' JNE PROC04 CALL SEELEX PROC04: MOV AL,TYPE0 CMP AL,'A' JE VARCNS CMP AL,'N' JE VARCNS CMP AL,'H' JE VARCNS CMP AL,'O' JE OPERAT CMP AL,'[' JE PAR91 CMP AL,']' JE PAR093 CMP AL,'(' JE PAR040 CMP AL,')' JE PAR041 CMP AL,':' JE DODO0 CMP AL,'E' JE EOCL MOV AL,08H JMP ERROUT ;UNKNOWN TYPE IN LEXICON ; PAR093: JMP PAR93 PAR040: JMP PAR40 PAR041: JMP PAR41 DODO0: JMP DODO VARCNS: CALL PUSHVA JMP PROC01 EOCL: CMP PS,0 JNE GOEOCL JMP DO1 GOEOCL: CALL PULLPR CMP RS,0 JE EOCL2 CALL REPEAT EOCL2: JMP PROC01 ; ;---------- OPERATOR ---------- OPERAT: MOV DI,OS OR DI,DI JE OPPUSH MOV AL,OSTACK [DI-1] CMP AL,PRORTY JB OPPUSH CALL PULLOP CALL JUMPAD JMP OPERAT ; OPPUSH: CALL PUSHOP JMP PROC01 ; ;---------- PUSH OPENING PARENTHESIS ---------- PAR91: MOV DI,VS CMP BYTE PTR VSTACK [DI-2],'0' JE MEMIDX MOV LEXPNT,OFFSET LEXICON+30H PARPU: CALL PUSHOP JMP PROC01 MEMIDX: MOV LEXPNT,OFFSET LEXICON+20H JMP PARPU ; PAR40: MOV LEXPNT,OFFSET LEXICON+10H JMP PARPU ; ;---------- CLOSING INDEX PARANTHESIS ---------- PAR93: MOV DI,OS OR DI,DI JE ERR09 ;MISSING OPENING IDX-PAR CMP BYTE PTR OSTACK [DI-1],'0' JNE GOPAR1 CMP WORD PTR OSTACK [DI-3],OFFSET LEXICON+20H JB ERR09 CMP WORD PTR OSTACK [DI-3],OFFSET LEXICON+40H JA ERR09 SUB OS,3 MOV AX,WORD PTR OSTACK [DI-3] MOV LEXPN2,AX CALL JUMPAD JMP PROC01 ; GOPAR1: CALL PULLOP CALL JUMPAD JMP PAR93 ; ERR09: MOV AL,09H JMP ERROUT ; ;---------- CLOSING PARENTHESIS ---------- PAR41: CMP OS,0 JE ERR10 ;MISSING OPENING PAR CALL PULLOP CMP LEXPN2,OFFSET LEXICON+40H JAE GOPAR2 CMP LEXPN2,OFFSET LEXICON+10H JNE ERR10 JMP PROC01 ; ERR10: MOV AL,10H JMP ERROUT ; GOPAR2: CALL JUMPAD JMP PAR41 ; ;---------- : TERMINATOR ---------- DODO: CMP OS,0 JE VARCOM CALL PULLOP CALL JUMPAD JMP DODO ; VARCOM: CMP VS,0 JE NOCOMM CMP VS,6 JE GOCOMM CALL PARTRANS GOCOMM: CALL PUSHPR CALL VARPRO NOCOMM: CALL PUSHPR XOR AX,AX MOV VS,AX MOV VD,AX MOV AX,INTROM+26 MOV AUXBEG,AX JMP EOCL ; ;---------- JUMPAD ---------- JUMPAD PROC NEAR MOV DI,LEXPN2 MOV AX,WORD PTR [DI+10] MOV OPJUMP,AX JMP OPJUMP RET JUMPAD ENDP ; ;---------- PUSH / PULL OPERATOR ---------- PUSHOP PROC NEAR CMP OS,60 JE ERR11 ;OSTACK OVERFLOW MOV DI,OS MOV AX,LEXPNT MOV WORD PTR OSTACK [DI],AX MOV AL,PRORTY MOV BYTE PTR OSTACK [DI+2],AL ADD OS,3 RET PUSHOP ENDP ; PULLOP PROC NEAR MOV DI,OS MOV AX,WORD PTR OSTACK [DI-3] MOV LEXPN2,AX SUB OS,3 RET PULLOP ENDP ; ERR11: MOV AL,11H JMP ERROUT ; ;---------- PUSH / PULL VARIABLES ---------- PUSHVA PROC NEAR CMP VS,120 JE ERR11 ;VSTACK OVERFLOW MOV DI,OFFSET VSTACK ADD DI,VS MOV SI,OFFSET GOTBEG MOV CX,3 REP MOVSW ADD VS,6 RET PUSHVA ENDP ; ERR12: MOV AL,12H JMP ERROUT ; PULLVA PROC NEAR CMP VS,0 JE ERR13 ;VSTACK UNDERFLOW SUB VS,6 MOV SI,OFFSET VSTACK ADD SI,VS MOV DI,OFFSET GOTBEG MOV CX,3 REP MOVSW RET PULLVA ENDP ; ERR13: MOV AL,13H JMP ERROUT ; ;---------- DEQUUE VARIABLES ---------- DEQUVA PROC NEAR MOV SI,OFFSET VSTACK ADD SI,VD MOV DI,OFFSET GOTBEG MOV CX,3 REP MOVSW ADD VD,6 RET DEQUVA ENDP ; ;---------- PUSH / PULL PROCESSOR --------- PUSHPR PROC NEAR CMP PS,120 JE ERR14 ;PSTACK OVERFLOW MOV DI,OFFSET PSTACK ADD DI,PS MOV SI,OFFSET GETBEG MOV CX,3 REP MOVSW ADD PS,6 RET PUSHPR ENDP ; ERR14: MOV AL,14H JMP ERROUT ; PULLPR PROC NEAR SUB PS,6 MOV SI,OFFSET PSTACK ADD SI,PS MOV DI,OFFSET GETBEG MOV CX,3 REP MOVSW RET PULLPR ENDP ; ;---------- INTERFACE VSTACK/PSTACK ---------- VARPRO PROC NEAR SUB VS,6 MOV SI,OFFSET VSTACK ADD SI,VS MOV DI,OFFSET GETBEG MOV CX,3 REP MOVSW MOV AX,GETBEG ADD AX,GETEND MOV GETEND,AX RET VARPRO ENDP ; ;---------- REPEAT PROCESSOR ---------- REPEAT PROC NEAR MOV DI,RS MOV AX,PS CMP WORD PTR RSTACK [DI-2],AX JNE REPEND SUB WORD PTR RSTACK [DI-6],1 JNC DECEND SUB WORD PTR RSTACK [DI-4],1 JNC DECEND ZTIMES: SUB RS,6 CALL PULLPR RET ; DECEND: ADD PS,6 REPEND: RET REPEAT ENDP ; ;---------- PARAMETER TRANSFER ---------- PARTRANS PROC NEAR MOV SI,OFFSET VSTACK+6 MOV DI,OFFSET PARSTACK MOV CX,VS SUB CX,6 MOV XP,CX REP MOVSB MOV VS,6 RET PARTRANS ENDP ; ;---------- PULL PARAMETERS ---------- PULLXP PROC NEAR CMP XP,0 JE ERR82 SUB XP,6 MOV SI,OFFSET PARSTACK ADD SI,XP MOV DI,OFFSET GOTBEG MOV CX,3 REP MOVSW RET ; ERR82: MOV AL,82H JMP ERROUT PULLXP ENDP ; ;********** ERROR HANDLING ********** ERROUT: MOV ERR,AL CMP RS,0 JE ERRADD MOV DI,RS MOV AX,PS SUB AX,6 CMP WORD PTR RSTACK [DI-2],AX JNE ERRADD JMP ERRPULL ERRADD: ADD PS,6 ERRPULL: MOV AX,GETBEG CALL PULLPR MOV BX,GETBEG MOV BRKPNT,BX SUB AX,BX MOV BRKPNT+2,AX MOV GETBEG,OFFSET ERRMES MOV GETEND,OFFSET ERRMES+79 BREAK: MOV VS,0 MOV VD,0 MOV OS,0 MOV PS,0 MOV RS,0 MOV AX,INTROM+26 MOV AUXBEG,AX MOV SP,STACKR JMP DO2 ; ;---------- HERE IS ---------- HEREIS PROC NEAR CALL CRETURN MOV AL,'-' CALL OUTCH MOV AL,'>' CALL OUTCH RET HEREIS ENDP ; ;=============================================================== ; SUBTTL OPERATOR ROUTINES PAGE %OUT OPERATOR ROUTINES ;********** DEFINE ********** DEFINE_O PROC NEAR CMP VS,0 JE DEFFIN CALL DEF01 JMP DEFINE_O DEFFIN: RET ;---------------------------- DEF01: MOV AX,LEXNUM CMP AX,LEXFIN JE ERR21 ;LEXICON FULL DEF11: CALL PULLVA MOV AX,GOTBEG CMP AX,TOP JE DEFTOP CMP AH,BYTE PTR INVEC+1 JE DEFTOP CMP AH,BYTE PTR AUXBEG+1 JNE DEF03 ; DEFTOP: MOV AX,VARLEN MOV CX,AX MOV BX,TOP ADD AX,BX JC ERR22 ;MEMORY OVERFLOW MOV SI,GOTBEG MOV DI,BX REP MOVSB MOV GOTBEG,BX MOV TOP,AX ; DEF03: MOV SI,OFFSET GOTBEG MOV DI,LEXNUM ADD DI,26 MOV CX,3 REP MOVSW CALL PULLVA CMP DEVICE,'0' JNE ERR23 ;FALSE DEVICE MOV CX,VARLEN CMP CX,10 JA ERR24 ;IDENTIFIER TOO LONG MOV SI,GOTBEG ADD LEXNUM,16 MOV DI,LEXNUM REP MOVSB MOV CX,10 SUB CX,VARLEN MOV AL,32 REP STOSB DEFEND: RET DEFINE_O ENDP ; ERR21: MOV AL,21H JMP ERROUT ERR22: MOV AL,22H JMP ERROUT ERR23: MOV AL,23H JMP ERROUT ERR24: MOV AL,24H JMP ERROUT ; ;********** DELETE ********** DELETE_O PROC NEAR MOV AX,VD CMP AX,VS JE DELFIN CALL DEQUVA CALL SEELEX DEL01: MOV AX,LEXPNT DEL02: CMP AX,LEXNUM JA DEL03 ADD AX,16 MOV DELEX,AX MOV CX,8 MOV SI,AX MOV DI,LEXPNT REP MOVSW MOV LEXPNT,AX JMP DEL01 ; DEL03: SUB LEXNUM,16 JMP DELETE_O ; DELFIN: MOV VS,0 MOV VD,0 RET DELETE_O ENDP ; ;********** MOVE .= , =. ********** MOVETRANS PROC NEAR MVLEFT_O: MOV MREG,'L' JMP GOMOVE MVRGHT_O: MOV MREG,'R' ; GOMOVE: MOV AX,VS CMP AX,12 JB MOVEND MOV VSREG,AX MOV VD,6 ; GOMOV: CALL DEQUVA CMP DEVICE,'0' JE MEMTRN JMP READ0 ; MEMTRN: MOV AX,VARLEN MOV SRCLEN,AX MOV AX,GOTBEG MOV SOURCE,AX MOV VS,6 CALL PULLVA CMP DEVICE,'0' JE MEMMEM JMP WRITE0 ; MOVEND: RET ; MEMMEM: MOV AX,VARLEN SUB AX,SRCLEN MOV DIFLEN,AX JNC MEM00 ; CMP MREG,'L' JE GOLEFT MOV AX,SRCLEN SUB AX,VARLEN MOV DIFLEN,AX MOV AX,SOURCE ADD AX,DIFLEN MOV SOURCE,AX ; GOLEFT: MOV AX,VARLEN MOV SRCLEN,AX ; CALL MOVE RET ; MEM00: CMP MREG,'L' JE MOVELEFT MOVERIGHT: CALL FILL MOV CX,SRCLEN MOV SI,SOURCE ADD SI,CX DEC SI MOV DI,GOTBEG ADD DI,CX DEC DI STD REP MOVSB CLD RET ; MOVELEFT: CALL MOVE MOV AX,VD CMP AX,VSREG JE FILL MOV AX,DIFLEN MOV VARLEN,AX CALL PUSHVA JMP GOMOV ; MOVE PROC NEAR MOV CX,SRCLEN MOV SI,SOURCE MOV DI,GOTBEG REP MOVSB MOV GOTBEG,DI RET MOVE ENDP ; FILL PROC NEAR MOV AL,FILLER MOV DI,GOTBEG MOV CX,DIFLEN REP STOSB MOV GOTBEG,DI RET FILL ENDP MOVETRANS ENDP ; ;********** DISK READ WRITE ********** READ0 PROC NEAR CALL ADRDEV MOV VS,6 CALL PULLVA CMP DEVICE,'0' JNE ERR25 ;DEVICE ERROR CALL RAMNBY CALL READDISK RET READ0 ENDP ; WRITE0 PROC NEAR CALL ADRDEV MOV VD,6 WRITE01: CALL DEQUVA CMP DEVICE,'0' JNE ERR25 CALL RAMNBY CALL WRITEDISK MOV AX,VD CMP AX,VSREG JE DISKEND JMP WRITE01 ; DISKEND: RET WRITE0 ENDP ; RAMNBY PROC NEAR MOV AX,VARLEN MOV NBYTE,AX MOV AX,GOTBEG MOV RAMADR,AX RET RAMNBY ENDP ; ADRDEV PROC NEAR MOV AX,GOTBEG MOV DSKADR,AX MOV AX,VARLEN MOV DSKADR+2,AX MOV AL,DEVICE MOV AH,0 MOV HANDLE,AX RET ADRDEV ENDP ; ERR25: MOV AL,25H JMP ERROUT ; ;********** OUTPUT PRINTER ********** OUTPUT_O PROC NEAR MOV AL,OUTDEV MOV OUTFLAG,AL CALL OUTCRT_O MOV AL,STDOUT MOV OUTFLAG,AL RET OUTPUT_O ENDP ; ;********** OUTPUT CRT ? , ?? ********** OUTPUTCRT PROC NEAR MONITOR_O: MOV HREG,'M' OUTCRT_O: MOV AX,VD CMP AX,VS JE CRTEND CALL DEQUVA CMP DEVICE,'0' JNE ERR28 ;DEVICE ERROR MOV CX,VARLEN MOV SI,GOTBEG CMP HREG,'M' JE OUTHEX JCXZ OUT01 DSP01: LODSB CALL OUTCH LOOP DSP01 OUT01: JMP OUTCRT_O ; CRTEND: MOV VS,0 MOV VD,0 MOV HREG,0 RET ; ERR28: MOV AL,28H JMP ERROUT ; OUTHEX: JCXZ OUTCRT_O OUTH01: LODSB PUSH AX SHR AL,1 SHR AL,1 SHR AL,1 SHR AL,1 CALL CVBIHX POP AX AND AL,0FH CALL CVBIHX MOV AL,32 CALL OUTCH MOV AL,32 CALL OUTCH MOV AL,32 CALL OUTCH LOOP OUTH01 JMP OUTCRT_O ; CVBIHX PROC NEAR CMP AL,10 JB NUM ADD AL,7 NUM: ADD AL,48 CALL OUTCH RET CVBIHX ENDP ; OUTPUTCRT ENDP ; ;********** INDEX KLAMMER ********** INDEXDBL_O PROC NEAR MOV AX,VS SUB AX,18 JC ERR29 ;MISSING INDEX EXPRESSION MOV VD,AX CALL DEQUVA CMP DEVICE,'0' JNE ERR30 ;FALSE DEVICE MOV AX,GOTBEG MOV EFFBEG,AX ADD AX,VARLEN MOV SOURCE,AX JC ERR31 ;OVERFLOW INDEX ; CALL GETVAR SUB WORD PTR BIN,1 JC ERR32 ;INDEX UNDERFLOW MOV AX,WORD PTR BIN ADD EFFBEG,AX ; CALL GETVAR MOV AX,WORD PTR BIN MOV EFFLEN,AX ; MOV AX,EFFBEG ADD AX,EFFLEN JC ERR31 ;OVERFLOW INDEX SUB SOURCE,AX JC ERR31 ;OVERFLOW INDEX ; IDX01: MOV DI,VS SUB DI,18 MOV AX,EFFBEG MOV WORD PTR VSTACK [DI],AX MOV AX,EFFLEN MOV WORD PTR VSTACK [DI+2],AX SUB VS,12 MOV VD,0 RET ; INDEXDBL_O ENDP ; GETVAR PROC NEAR CALL DEQUVA CMP DEVICE,'0' JNE ERR30 ;DEVICE ERROR CALL CONVERT RET GETVAR ENDP ; ERR29: MOV AL,29H JMP ERROUT ERR30: MOV AL,30H JMP ERROUT ERR31: MOV AL,31H JMP ERROUT ERR32: MOV AL,32H JMP ERROUT ; ;********** INDEX PARANTHESIS SIMPLE ********** INDEXSM_O PROC NEAR MOV AX,VS SUB AX,12 JC ERR33 ;MISSING INDEX MOV VD,AX CALL DEQUVA MOV AX,GOTBEG MOV EFFBEG,AX MOV AX,VARLEN MOV EFFLEN,AX CALL GETVAR MOV AX,WORD PTR BIN MOV BX,WORD PTR BIN+2 SUB AX,1 SBB BX,0 ADD EFFBEG,AX ADC EFFLEN,BX JC ERR31 ADD VS,6 JMP IDX01 INDEXSM_O ENDP ; ERR33: MOV AL,33H JMP ERROUT ; ;********** REPEAT ********** REPEAT_O PROC NEAR CALL DEQUVA CALL CONVERT MOV DI,RS CMP DI,60 JE ERR34 MOV AX,WORD PTR BIN MOV WORD PTR RSTACK [DI],AX MOV AX,WORD PTR BIN+2 MOV WORD PTR RSTACK [DI+2],AX MOV AX,PS ADD AX,6 MOV WORD PTR RSTACK [DI+4],AX ADD RS,6 CALL PULLVA MOV VS,0 CALL PUSHVA RET ; ERR34: MOV AL,34H JMP ERROUT REPEAT_O ENDP ; ;********** EXIT ********** EXIT_O PROC NEAR CMP RS,0 JE EXTOT MOV DI,RS MOV AX,WORD PTR RSTACK[DI-2] MOV PS,AX SUB RS,6 RET ; EXTOT: MOV PS,0 RET EXIT_O ENDP ; ;********** NEXT ********** NEXT_O PROC NEAR CMP RS,0 JE EXTOT MOV DI,RS MOV AX,WORD PTR RSTACK [DI-2] MOV PS,AX ADD PS,6 RET NEXT_O ENDP ; ;********** BREAK ********** BREAK_O PROC NEAR CALL PULLPR MOV AX,GETBEG MOV GETEND,AX RET BREAK_O ENDP ; ;********** MISSING CLOSING PARENTHESIS ********** MISCL_O PROC NEAR MOV AL,17H JMP ERROUT MISCL_O ENDP ; ;********** IF ********** IF_O PROC NEAR GOIF: MOV AX,VD CMP AX,VS JE IFFIN CALL DEQUVA MOV DI,GOTBEG CMP BYTE PTR [DI],'1' JE TRUEIF MOV AX,VD CMP AX,VS JE IFFIN CALL DEQUVA JMP GOIF ; TRUEIF: CALL DEQUVA MOV VS,0 MOV VD,0 CALL PUSHVA RET ; IFFIN: MOV VS,0 MOV VD,0 RET IF_O ENDP ; ;********** > < >= <= = <> ********** COMPARE PROC NEAR ; EQUAL_O: CALL COMPRE OR AL,AL JE VALID JMP NEGADO ; GREATER_O: CALL COMPRE CMP AL,1 JE VALID JMP NEGADO ; LESS_O: CALL COMPRE CMP AL,2 JE VALID JMP NEGADO ; GRTEQU_O: CALL COMPRE CMP AL,2 JE NEGADO JMP VALID ; LESSEQU_O: CALL COMPRE CMP AL,1 JE NEGADO JMP VALID ; NOTEQU_O: CALL COMPRE OR AL,AL JE NEGADO JMP VALID ; VALID: MOV AL,'1' JMP STOREA NEGADO: MOV AL,'0' STOREA: MOV DI,AUXBEG MOV BYTE PTR [DI],AL MOV GOTBEG,DI CMP DI,AUXFIN JAE ERR35 INC AUXBEG MOV VARLEN,1 CALL PUSHVA RET ; ERR35: MOV AL,35H JMP ERROUT ;********* AND OR NOT ********** ; AND_O: CALL GETBOL CMP BOOL,3131H JNE NEGADO JMP VALID ; OR_O: CALL GETBOL CMP BOOL,3030H JE NEGADO JMP VALID ; NOT_O: CALL PULLVA MOV DI,GOTBEG CMP BYTE PTR [DI],'0' JE NEGADO JMP VALID ; GETBOL PROC NEAR CALL PULLVA MOV DI,GOTBEG MOV AL,BYTE PTR [DI] CALL PULLVA MOV DI,GOTBEG MOV AH,BYTE PTR [DI] MOV BOOL,AX RET GETBOL ENDP ; COMPARE ENDP ; ;---------- COMPARE ---------- COMPRE PROC NEAR PUSH VS CALL PULLVA CMP TYPE0,'N' JE NUMBER0 CALL PULLVA CMP TYPE0,'N' JE NUMBER0 ; STRING: POP VS CALL PULLVA ;OP2 MOV AX,GOTBEG MOV SOURCE,AX MOV AX,VARLEN MOV SRCLEN,AX CALL PULLVA ;OP1 MOV AX,VARLEN SUB AX,SRCLEN MOV DIFLEN,AX JC OP2LEN MOV LONGER,1 CMP AX,0000H JNE STOLEN DEC LONGER STOLEN: MOV AX,SRCLEN MOV DIFLEN,AX JMP COMSTR ; OP2LEN: MOV LONGER,2 MOV AX,VARLEN MOV DIFLEN,AX JMP COMSTR ;----------------------------------- ; NUMBER0: POP VS CALL SUBTRACT_O SUB VS,6 MOV DI,OFFSET RES CMP BYTE PTR [DI],'-' JE NUM2 MOV CX,PRE2 ZCHECK: INC DI XOR AL,AL REPE SCASB JNE NUM1 NUMEQU: RET NUM1: MOV AL,1 RET NUM2: MOV AL,2 NUMFIN: RET ; ;----------- COMPARE STRINGS ---------- COMSTR: MOV CX,DIFLEN MOV SI,SOURCE MOV DI,GOTBEG REPE CMPSB JE EQUAL0 ; NOTEQUAL: JB OP1BIG MOV AL,2 JMP COMFIN OP1BIG: MOV AL,1 JMP COMFIN EQUAL0: MOV AL,LONGER COMFIN: RET COMPRE ENDP ; ;********** POS ********* POS_O PROC NEAR CALL PULLVA MOV AX,GOTBEG MOV SOURCE,AX MOV AX,VARLEN MOV SRCLEN,AX MOV AL,DEVICE CALL PULLVA MOV AH,DEVICE CMP AX,'00' JNE ERR36 ;FALSE DEVICE MOV SI,GOTBEG MOV DI,SOURCE MOV DX,DI ADD DX,SRCLEN SUB DX,VARLEN LODSB SEARCH: MOV CX,DX SUB CX,DI INC CX REPNE SCASB JNE NOTFND MOV CX,VARLEN DEC CX PUSH DI PUSH SI REPE CMPSB POP SI POP DI JNE SEARCH ; PDFOUND: SUB DI,SOURCE MOV WORD PTR BIN,DI PFOUND1: MOV WORD PTR BIN+2,0 CALL BIND00 CALL PUSHVA RET NOTFND: MOV WORD PTR BIN,0 JMP PFOUND1 POS_O ENDP ; ERR36: MOV AL,36H JMP ERROUT ; ;********** D O ********** DO_O PROC NEAR CMP VS,0 JE DO_END CALL PARTRANS CALL PULLVA MOV DI,AUXBEG MOV DX,DI MOV SI,GOTBEG MOV CX,VARLEN REP MOVSB CMP DI,AUXFIN JAE ERR37 ;AUXOVERFLOW MOV AL,0 STOSB CALL OVERLAY CALL PUSHTP MOV AX,TOP MOV GOTBEG,AX ADD AX,VARLEN JC ERR38 MOV TOP,AX MOV TYPE0,'A' MOV DEVICE,'0' CALL PUSHVA DO_END: RET DO_O ENDP ; ERR37: MOV AL,37H JMP ERROUT ERR38: MOV AL,38H JMP ERROUT ; ;---------- PUSHTP ---------- PUSHTP PROC NEAR CMP TS,60 JE ERR39 ;TOP-STACK OVERFLOW MOV DI,TS MOV AX,TOP MOV WORD PTR TSTACK [DI],AX MOV AX,LEXNUM MOV WORD PTR TSTACK [DI+2],AX ADD TS,4 RET ; ERR39: MOV AL,39H JMP ERROUT PUSHTP ENDP ; ;********** CLEAR ********** CLEAR_O PROC NEAR CMP TS,0 JE CLEAREND MOV DI,TS MOV AX,WORD PTR TSTACK [DI-4] MOV TOP,AX MOV AX,WORD PTR TSTACK [DI-2] MOV LEXNUM,AX SUB TS,4 CLEAREND: RET CLEAR_O ENDP ; ;********** HEAD ********** HEAD_O PROC NEAR CALL PUSHPR CALL VARPRO CALL GETNXT CALL PUSHVA CALL PULLPR RET HEAD_O ENDP ; ;********** TAIL ********** TAIL_O PROC NEAR CALL PUSHPR CALL VARPRO CALL GETNXT MOV AL,GETYPE MOV TYPE0,AL MOV AX,GETBEG MOV GOTBEG,AX MOV BX,GETEND SUB BX,AX MOV VARLEN,BX CALL PUSHVA CALL PULLPR RET TAIL_O ENDP ; ;********** CASE ********** CASE_O PROC NEAR CALL PUSHPR CALL VARPRO CALL PULLVA CALL CONVERT CMP VARLEN,2 JA ERR40 ;N TOO HIGH ; MOV CX,WORD PTR BIN JCXZ CASFIN CASELOOP: PUSH CX CALL GETNXT POP CX LOOP CASELOOP ; CASFIN: CMP TYPE0,'E' JNE CASFIN0 MOV AX,GETEND MOV GOTBEG,AX MOV VARLEN,0 CASFIN0: CALL PUSHVA CALL PULLPR RET ; ERR40: MOV AL,40H JMP ERROUT CASE_O ENDP ; ;********** PASS ********** PASS_O PROC NEAR PASS01: CMP VS,0 JE PASSFIN CALL PULLXP CALL PUSHVA CALL DEF01 JMP PASS01 PASSFIN: RET PASS_O ENDP ; ;********** BIN / DEC ********** BIN_O PROC NEAR CALL PULLVA CMP DEVICE,'0' JNE ERR41 CALL CONVERT CNVOUT: CALL PUSHVA RET BIN_O ENDP ; ERR41: MOV AL,41H JMP ERROUT ; DEC_O PROC NEAR CALL PULLVA CMP DEVICE,'0' JNE ERR41 CALL BINDEC JMP CNVOUT DEC_O ENDP ; ;********** INLINE / EDIT ********** EDIT_O PROC NEAR CALL INL0 MOV CX,VARLEN JCXZ EDITEND MOV SI,GOTBEG MOV DI,INVEC INC DI TRNOUT: MOV AL,[SI] CALL OUTCH MOVSB LOOP TRNOUT ; CALL GOINL CALL IN00 CALL INLEND EDITEND: RET EDIT_O ENDP ; ;---------- INLINE ---------- INLINE_O PROC NEAR CALL INL0 MOV CX,VARLEN JCXZ INLINEND INFILL: MOV AL,PROMPT CALL OUTCH LOOP INFILL ; MOV CX,VARLEN MOV AL,CRTBLK INBACK: CALL OUTCH LOOP INBACK ; CALL GOINL CALL KEYIN CALL INLEND INLINEND: RET INLINE_O ENDP ;---------------------------- INL0 PROC NEAR CALL PULLVA CALL PUSHVA CMP VARLEN,0FFH JA ERR42 ;TOO LONG CMP DEVICE,'0' JNE ERR43 ;FALSE DEVICE MOV AX,AUXBEG MOV INVEC,AX MOV AL,PROMPT MOV SPACE,AL RET INL0 ENDP ; GOINL PROC NEAR MOV DI,VARLEN MOV INVLEN,DI MOV INPLEN,DI MOV BX,INVEC MOV GOTBEG,BX RET GOINL ENDP ; INLEND PROC NEAR MOV SPACE,32 MOV DI,INPLEN DEC DI CMP DI,0 JE INPEND MOV VARLEN,DI INC GOTBEG CALL PUSHVA CALL MVLEFT_O RET INPEND: CALL PULLVA RET INLEND ENDP ERR42: MOV AL,42H JMP ERROUT ERR43: MOV AL,43H JMP ERROUT ; ;********** INPUT ********** INPUT_O PROC NEAR MOV AL,INDEV MOV INFLAG,AL INPUT01: MOV AX,VD CMP AX,VS JE INPUTEND CALL DEQUVA CMP DEVICE,'0' JNE ERR44 MOV CX,VARLEN JCXZ INPUT01 MOV DI,GOTBEG INPUT02: CALL INPCH STOSB LOOP INPUT02 JMP INPUT01 INPUTEND: MOV AL,STDIN MOV INFLAG,AL MOV VD,0 MOV VS,0 RET INPUT_O ENDP ; ERR44: MOV AL,44H JMP ERROUT ; ;********** LEN ********** LEN_O PROC NEAR CALL PULLVA CMP DEVICE,'0' JE GOLEN MOV VARLEN,0 GOLEN: MOV WORD PTR BIN+2,0 MOV AX,VARLEN MOV WORD PTR BIN,AX CALL BIND00 MOV DEVICE,'0' CALL PUSHVA RET LEN_O ENDP ; ;********** ADR ********** ADR_O PROC NEAR MOV WORD PTR BIN+2,0 CALL PULLVA CMP DEVICE,'0' JE GOADR MOV AX,VARLEN MOV WORD PTR BIN+2,AX GOADR: MOV AX,GOTBEG MOV WORD PTR BIN,AX CALL BIND00 MOV DEVICE,'0' CALL PUSHVA RET ADR_O ENDP ; ;********** TYPE ********** TYPE_O PROC NEAR CALL PULLVA MOV DI,AUXBEG MOV GOTBEG,DI MOV AL,TYPE0 MOV [DI],AL ADD DI,1 CMP DI,AUXFIN JAE ERR45 MOV AUXBEG,DI MOV TYPE0,'A' MOV VARLEN,1 MOV DEVICE,'0' CALL PUSHVA RET TYPE_O ENDP ; ERR45: MOV AL,45H JMP ERROUT ; ;********** IND ********** IND_O PROC NEAR PUSH LEXPNT PUSH WORD PTR RPTFLG ;PRORTY CALL PULLVA CALL SEELEX CALL PUSHVA POP WORD PTR RPTFLG POP LEXPNT RET IND_O ENDP ; ;********** CURSOR ********** CURSOR_O PROC NEAR MOV EFFLEN,0 CMP VS,18 JB GOCURSOR CALL PULLVA MOV AX,GOTBEG MOV EFFBEG,AX MOV AX,VARLEN MOV EFFLEN,AX GOCURSOR: CALL PULLVA CALL CONVERT MOV DL,BIN PUSH DX CALL PULLVA CALL CONVERT POP DX MOV DH,BIN MOV CX,EFFLEN JCXZ ENDCURS MOV DI,EFFBEG MOV BX,0 CURSPOS: CALL POSCURSOR MOV BL,[DI] PUSH CX MOV CX,1 CALL WRITEATTR POP CX INC DL INC DI LOOP CURSPOS SUB DL,BYTE PTR EFFLEN ENDCURS: CALL POSCURSOR RET CURSOR_O ENDP ; ;********** CONTENTS ********** CONTENTS_O PROC NEAR CALL PULLVA MOV DI,GOTBEG DEC DI ADD DI,VARLEN MOV AL,FILLER MOV CX,VARLEN STD REPE SCASB CLD JE CONT01 INC CX CONT01: MOV VARLEN,CX CALL PUSHVA RET CONTENTS_O ENDP ; .LIST ;********** BIOS ********** BIOS_O PROC NEAR CALL PULLVA CMP VARLEN,9 JNE BIOS_END MOV DI,GOTBEG MOV AL,BYTE PTR [DI+8] MOV BYTE PTR INTLOC+1,AL MOV AX,WORD PTR [DI] MOV BX,WORD PTR [DI+2] MOV CX,WORD PTR [DI+4] MOV DX,WORD PTR [DI+6] INTLOC: INT 0 MOV DI,GOTBEG MOV WORD PTR [DI],AX MOV WORD PTR [DI+2],BX MOV WORD PTR [DI+4],CX MOV WORD PTR [DI+6],DX BIOS_END: RET BIOS_O ENDP ; ;********** RND ********** RANDOM_O PROC NEAR MOV AX,RANDOM MOV CX,5 MUL CX MOV RANDOM,AX MOV CX,100 MUL CX MOV WORD PTR BIN,DX MOV WORD PTR BIN+2,0 CALL BIND00 CALL PUSHVA RET RANDOM_O ENDP ; ;********** SORT ********** SORT_O PROC NEAR CALL PULLVA CALL CONVERT MOV BX,WORD PTR BIN PUSH BX CALL PULLVA CALL CONVERT MOV AX,WORD PTR BIN ;FIELD LENGTH XOR DX,DX POP BX DIV BX MOV NN,AX ;NO OF KEYS MUL BX MOV LOFF,AX PUSH BX CALL PULLVA CALL SETUPSEG MOV GOTBEG,DX ;OFFSET POP BX ADD LOFF,DX MOV DS,AX MOV ES,AX ; SORT10: SAR CS:NN,1 CMP CS:NN,0 JE SORTEND MOV AX,CS:NN MUL BX MOV BP,AX ;M-OFFSET MOV AX,CS:LOFF SUB AX,BP MOV CS:KOFF,AX MOV AX,CS:GOTBEG SORT15: MOV CS:JOFF,AX ; SORT20: MOV DI,AX MOV SI,DI ADD SI,BP MOV CX,BX REPE CMPSB JAE SORT50 MOV SI,AX MOV DI,SI ADD DI,BP MOV CX,BX SWAPLOOP: MOV DL,[DI] MOV DH,[SI] MOV [DI],DH MOV [SI],DL INC DI INC SI LOOP SWAPLOOP ; SUB AX,BP JC SORT50 CMP AX,CS:GOTBEG JAE SORT20 SORT50: MOV AX,CS:JOFF ADD AX,BX CMP AX,CS:KOFF JAE SORT10 JMP SORT15 SORTEND: MOV AX,CS MOV DS,AX MOV ES,AX RET ; SORT_O ENDP ; ;------------ MERGE --------- ; MERGE_O PROC NEAR CALL PULLVA CALL CONVERT MOV AX,WORD PTR BIN MOV KEYL,AX ;KEYLENGTH ; CALL PULLVA CALL CONVERT MOV AX,WORD PTR BIN MOV N,AX ;N OF KEYS EN SOURCE BUFFERS ; SAL AX,1 MOV NN,AX ;N OF KEYS IN TARGET BUFFER ; CALL PULLVA CALL SETUPSEG MOV JSEG,AX MOV JOFF,DX ; CALL PULLVA CALL SETUPSEG MOV LSEG,AX MOV LOFF,DX ; CALL PULLVA CALL SETUPSEG MOV KSEG,AX MOV KOFF,DX ; MOV K,1 MOV L,1 MOV J,1 ; MERGE01: MOV AX,N CMP L,AX JBE MERGE02 CALL K_TO_J JMP MERGE05 MERGE02: MOV AX,N CMP K,AX JBE MERGECOMP CALL L_TO_J JMP MERGE05 MERGECOMP: LES DI,CS:DWORD PTR KOFF LDS SI,CS:DWORD PTR LOFF MOV CX,CS:KEYL REPZ CMPSB JAE MERGE04 CALL L_TO_J JMP MERGE05 MERGE04: CALL K_TO_J MERGE05: MOV AX,CS MOV ES,AX MOV DS,AX MOV AX,J CMP AX,NN JBE MERGE01 RET MERGE_O ENDP ;----------------------------------- ; L_TO_J PROC NEAR LES DI,CS:DWORD PTR JOFF LDS SI,CS:DWORD PTR LOFF MOV CX,CS:KEYL REP MOVSB INC CS:L INC CS:J ; MOV AX,CS:KEYL ADD CS:LOFF,AX ADD CS:JOFF,AX ; CMP CS:LOFF,0FF00H JB LTOJ01 SUB CS:LOFF,0FF00H ADD CS:LSEG,0FF0H LTOJ01: CMP CS:JOFF,0FF00H JB LTOJ02 SUB CS:JOFF,0FF00H ADD CS:JSEG,0FF0H LTOJ02: RET L_TO_J ENDP ; K_TO_J PROC NEAR LES DI,CS:DWORD PTR JOFF LDS SI,CS:DWORD PTR KOFF MOV CX,CS:KEYL REP MOVSB INC CS:K INC CS:J ; MOV AX,CS:KEYL ADD CS:KOFF,AX ADD CS:JOFF,AX ; CMP CS:KOFF,0FF00H JB KTOJ01 SUB CS:KOFF,0FF00H ADD CS:KSEG,0FF0H KTOJ01: CMP CS:JOFF,0FF00H JB KTOJ02 SUB CS:JOFF,0FF00H ADD CS:JSEG,0FF0H KTOJ02: RET K_TO_J ENDP ; ; SETUPSEG PROC NEAR MOV AX,GOTBEG MOV DX,AX MOV CL,4 SHR AX,CL MOV BX,VARLEN MOV CL,12 SAL BX,CL ADD AX,BX AND DX,000FH RET SETUPSEG ENDP ; ;********** FIND ************ FIND_O PROC NEAR CALL PULLVA CALL CONVERT MOV AX,WORD PTR BIN ;N OF TIMES MOV N,AX CALL PULLVA CALL SETUPSEG MOV JSEG,AX MOV JOFF,DX ;MPTR CALL PULLVA CALL CONVERT MOV BX,WORD PTR BIN ;RECLENGTH CALL PULLVA MOV DX,0 ;KEY ; FCOMP: INC DX MOV CX,VARLEN LES DI,DWORD PTR JOFF MOV SI,GOTBEG REPZ CMPSB JE FFOUND CMP DX,N JE NOTFFOUND ADD JOFF,BX CMP JOFF,0FF00H JB FCOMP SUB JOFF,0FF00H ADD JSEG,0FF0H JMP FCOMP ; NOTFFOUND: MOV WORD PTR BIN,0 JMP FINDFIN FFOUND: MOV WORD PTR BIN,DX FINDFIN: MOV WORD PTR BIN+2,0 MOV AX,CS MOV ES,AX CALL BIND00 MOV DEVICE,'0' CALL PUSHVA RET ; FIND_O ENDP ; ;********** SYSTEM ********** SYSTEM_O PROC NEAR INT 20H SYSTEM_O ENDP ; ;********** INIT ******** INIT_O PROC NEAR CALL PARSETUP JMP OUT_MSSG INIT_O ENDP ; ;============================================================== ; SUBTTL MATH ROUTINES %OUT MATH ROUTINES PAGE ;********** CONVERT ASCII TO BINARY ********** CONVERT PROC NEAR MOV WORD PTR BIN,0 MOV WORD PTR BIN+2,0 ; CONV01: CMP TYPE0,'H' JNE GOCONV JMP CNVHEX ; GOCONV: MOV CX,VARLEN MOV SI,GOTBEG CONV02: JCXZ CNVEND DEC CX LODSB CMP AL,'1' JB CONV02 CMP AL,':' JAE CONV02 MOV BX,000AH MOV BP,0 ; CONV03: SUB AL,48 MOV TEMP,AL OR BP,BP JE CONV04 MPY10: MOV AX,WORD PTR BIN MUL BX MOV WORD PTR BIN,AX PUSH DX MOV AX,WORD PTR BIN+2 MUL BX POP DX ADD AX,DX MOV WORD PTR BIN+2,AX CONV04: XOR AH,AH MOV AL,TEMP ADD WORD PTR BIN,AX JNC CONV05 INC WORD PTR BIN+2 ; CONV05: JCXZ CNVEND DEC CX LODSB CMP AL,'0' JB CNVEND CMP AL,':' JAE CNVEND INC BP JMP CONV03 ; CNVEND: STD MOV CX,4 MOV DI,OFFSET BIN+4 MOV AL,0 REPE SCASB JZ ONEINC INC CX ONEINC: INC CX MOV BX,CX CLD CNVEN1: MOV SI,OFFSET BIN MOV DI,AUXBEG CMP DI,AUXFIN JA ERR51 ;AUX OVERFLOW MOV GOTBEG,DI REP MOVSB MOV VARLEN,BX ADD AUXBEG,BX MOV TYPE0,'H' RET ; CNVHEX: MOV CX,VARLEN MOV SI,GOTBEG MOV DI,OFFSET BIN REP MOVSB JMP CNVEND ; CONVERT ENDP ; ERR51: MOV AL,51H JMP ERROUT ; ;********** CONVERT BINARY TO ASCII DECIMAL ********** BINDEC PROC NEAR MOV WORD PTR BIN,0 MOV WORD PTR BIN+2,0 MOV CX,VARLEN MOV DI,OFFSET BIN MOV SI,GOTBEG BINLOP: REP MOVSB ; BIND00: MOV DI,OFFSET BINASC+9 MOV BP,10 UNSPD: MOV CX,10 BIND01: XOR DX,DX MOV AX,WORD PTR BIN+2 DIV BP MOV WORD PTR BIN+2,AX MOV AX,WORD PTR BIN DIV BP MOV WORD PTR BIN,AX ADD DL,48 MOV [DI],DL DEC DI LOOP BIND01 ; MOV CX,10 MOV BX,AUXBEG CMP BX,AUXFIN JA ERR52 ;AUX OVERFLOW MOV GOTBEG,BX XOR DI,DI MOV BYTE PTR [BX] [DI],' ' INC DI MOV SI,OFFSET BINASC PULLAS: LODSB CMP AL,'0' LOOPE PULLAS BIND03: MOV BYTE PTR [BX] [DI],AL INC DI JCXZ BIND04 LODSB LOOP BIND03 JMP BIND03 BIND04: MOV VARLEN,DI ADD BX,DI MOV AUXBEG,BX MOV TYPE0,'N' RET ; BINDEC ENDP ; ERR52: MOV AL,52H JMP ERROUT ; ;********** ADD, SUBTRACT ********** ADDSUB PROC NEAR ADD_O: MOV SIGNS,0 JMP ADDSUB01 SUBTRACT_O: MOV SIGNS,4 ADDSUB01: CALL SETUP ; MOV BX,OFFSET SIGNTABLE MOV AL,SIGNS XLAT CMP AL,1 JE ADDSTD CMP AL,2 JE SUBSTD CMP AL,3 JE ADDREV ; SUBREV: CALL SUB0 JMP SIGNREV ADDREV: CALL ADD0 JMP SIGNREV ADDSTD: CALL ADD0 JMP CLCFIN SUBSTD: CALL SUB0 JMP CLCFIN ; SIGNREV: MOV BX,OFFSET RES CMP BYTE PTR [BX],' ' JE SPACE0 MOV BYTE PTR [BX],' ' JMP CLCFIN SPACE0: MOV BYTE PTR [BX],'-' JMP CLCFIN ; ;---------- ADD ---------- ADD0 PROC NEAR MOV CX,PRE2 MOV DI,CX CLC ADDLOOP: MOV AL,OFFSET OP1 [DI] ADC AL,OFFSET OP2 [DI] AAA MOV OFFSET RES [DI],AL DEC DI LOOP ADDLOOP MOV OFFSET RES [DI],' ' RET ADD0 ENDP ; ;---------- SUB ---------- SUB0 PROC NEAR MOV CX,PRE2 MOV DI,CX CLC SUBLOOP: MOV AL,OFFSET OP1 [DI] SBB AL,OFFSET OP2 [DI] AAS MOV OFFSET RES [DI],AL DEC DI LOOP SUBLOOP JNC SUB0END MOV CX,PRE2 MOV DI,CX CLC SUBLOOP2: MOV AL,OFFSET OP2 [DI] SBB AL,OFFSET OP1 [DI] AAS MOV OFFSET RES [DI],AL DEC DI LOOP SUBLOOP2 MOV OFFSET RES [DI],'-' RET SUB0END: MOV OFFSET RES [DI],' ' RET SUB0 ENDP ; ADDSUB ENDP ; ;********** MULTIPLY ********** MULTIPLY_O PROC NEAR MOV SIGNS,0 CALL SETUP MOV CX,SPRE MOV SFTLEN,CX MOV AX,OFFSET RES MOV SHIFT,AX MOV DI,AX ADD AX,FIX1 MOV BX,AX ;BX FOR RESULT MOV AL,0 INC CX INSFT: REP STOSB CALL MLTPLY JMP MPDVFIN ; MLTPLY PROC NEAR MOV BP,1 ;DIGPOS MULTIP: MOV DI,BP MOV DL,OP2 [DI] ; MPYNEXT: CMP DL,0 JE GO_MPY MOV CX,PRE2 MOV DI,CX CLC MPYADD: MOV AL,[BX] [DI] ADC AL,OFFSET OP1 [DI] AAA MOV [BX] [DI],AL DEC DI LOOP MPYADD DEC DL JMP MPYNEXT ; GO_MPY: CMP BP,PRE2 JE MPYFIN INC BP CALL SHIFTL JMP MULTIP MPYFIN: RET MLTPLY ENDP MULTIPLY_O ENDP ; ;---------- SHIFT LEFT ---------- SHIFTL PROC NEAR MOV SI,SHIFT INC SI MOV DI,SI INC SI MOV CX,SFTLEN DEC CX REP MOVSB MOV BYTE PTR [DI],0 RET SHIFTL ENDP ; ;---------- MULTIPLY DIVIDE FIN ---------- MPDVFIN: CMP SIGNS,0 JE POSRES CMP SIGNS,1 JE NEGRES CMP SIGNS,2 JE NEGRES CMP SIGNS,3 JE POSRES ; NEGRES: MOV AL,'-' JMP SIGRES POSRES: MOV AL,' ' SIGRES: MOV BYTE PTR RES,AL ; JMP CLCFIN ; ;********** DIVIDE ********** DIVIDE_O PROC NEAR MOV SIGNS,0 CALL SETUP MOV CX,PRE2 MOV SFTLEN,CX INC CX MOV DI,OFFSET RES MOV AL,0 INRES: REP STOSB ; DIVIDE: CALL DIV00 JMP MPDVFIN ; DIV00 PROC NEAR MOV AX,OFFSET OP2 MOV SHIFT,AX MOV BX,APRE1 DIV01: MOV CX,PRE2 MOV DI,CX CLC DSLOOP: MOV AL,OFFSET OP1 [DI] SBB AL,OFFSET OP2 [DI] DEC DI LOOP DSLOOP JC DIV02 DEC BX OR BX,BX JE ERR53 ;OVERFLOW CALL SHIFTL JMP DIV01 ; DIV02: INC BX MOV AX,OFFSET OP1 MOV SHIFT,AX DIV04: CALL SHIFTL MOV DL,0 DIV05: CMP DL,10 JE ERR53 SUBDIV: MOV CX,PRE2 MOV DI,CX CLC DIVLOOP: MOV AL,OFFSET OP1 [DI] SBB AL,OFFSET OP2 [DI] AAS MOV OFFSET OP1 [DI],AL DEC DI LOOP DIVLOOP JC DIV07 INC DL JMP DIV05 ; DIV07: MOV CX,PRE2 MOV DI,CX CLC RESOPLOOP: MOV AL,OFFSET OP1 [DI] ADC AL,OFFSET OP2 [DI] AAA MOV OFFSET OP1 [DI],AL DEC DI LOOP RESOPLOOP ; MOV OFFSET RES [BX],DL ;BX = DIGPOS CMP BX,PRE2 JE ENDDIV INC BX JMP DIV04 ; ENDDIV: RET DIV00 ENDP ; ERR53: MOV AL,53H JMP ERROUT ; DIVIDE_O ENDP ;********** ASCII / BCD ********* ASCBCD PROC NEAR MOV CX,PRE3 MOV DI,BCD MOV AL,0 REP STOSB ; MOV CX,VARLEN MOV BX,GOTBEG MOV DI,0FFFFH ; LEADCH: INC DI CMP DI,CX JE ENDPC MOV AL,[BX] [DI] CMP AL,'-' JE MINUS CMP AL,'0' JB LEADCH MOV START0,DI DEC DI JMP DIGITS ; ENDPC: RET ; MINUS: MOV BP,DI MOV DI,BCD MOV [DI],AL MOV DI,BP INC DI MOV START0,DI DEC DI ; DIGITS: INC DI CMP DI,CX JE ENDCHA MOV AL,[BX] [DI] CMP AL,'.' JE PNTPOS CMP AL,'0' JB ENDCHA CMP AL,':' JB DIGITS ; ENDCHA: MOV POINT0,DI ENDCHB: MOV END0,DI JMP PACK ; PNTPOS: MOV POINT0,DI DIGIT: INC DI CMP DI,CX JE ENDCHB MOV AL,[BX] [DI] CMP AL,'0' JB ENDCHB CMP AL,':' JB DIGIT JMP ENDCHB ; PACK: MOV DX,POINT0 SUB DX,START0 CMP DX,APRE ;USER PREPOINT PRECISION JA ERR54 ;PRECISION OVERFLOW ; PREPOINT: MOV SI,BX ADD SI,START0 MOV DI,BCD ADD DI,APRE1 INC DI SUB DI,DX MOV CX,POINT0 SUB CX,START0 JCXZ POSTPOINT PREMOVE: LODSB AND AL,0FH STOSB LOOP PREMOVE ; POSTPOINT: MOV CX,END0 SUB CX,POINT0 CMP CX,1 JBE ENDPACK DEC CX CMP CX,FIX1 JBE POSTGO MOV CX,FIX1 POSTGO: INC SI POSTMOVE: LODSB AND AL,0FH STOSB LOOP POSTMOVE ; ENDPACK: RET ; ERR54: MOV AL,54H JMP ERROUT ; ASCBCD ENDP ; ;********** BCD / ASCII ********** BCDASC PROC NEAR MOV SI,BCD MOV DI,ASCI MOVSB ;SIGN CMP BYTE PTR [SI],0 JNE ERR56 ;PRECISION OVERFLOW ; MOV CX,APRE1 BCASLOOP: LODSB OR AL,30H CMP AL,'0' LOOPE BCASLOOP STOSB JCXZ POSTBCAS BCASLOOP1: LODSB OR AL,30H STOSB LOOP BCASLOOP1 ; POSTBCAS: CMP FIX,0 JE FINPOST MOV AL,'.' STOSB MOV CX,FIX POSTLOOP: LODSB OR AL,30H STOSB LOOP POSTLOOP ; FINPOST: SUB DI,ASCI MOV VARLEN,DI MOV AX,AUXBEG MOV GOTBEG,AX ADD AX,DI CMP AX,AUXFIN JAE ERR59 ;AUX OVERFLOW MOV AUXBEG,AX RET ; ERR56: MOV AL,56H JMP ERROUT ERR59: MOV AL,59H JMP ERROUT ; BCDASC ENDP ;********** SET UP FOR ARITHMETIK ********** SETUP PROC NEAR ; CALL PULLVA MOV BCD,OFFSET OP2 CALL ASCBCD MOV BX,BCD MOV AL,[BX] AND AL,1 OR SIGNS,AL ; CALL PULLVA MOV BCD,OFFSET OP1 CALL ASCBCD MOV BX,BCD MOV AL,[BX] AND AL,1 SAL AL,1 OR SIGNS,AL RET SETUP ENDP ; ;********** RETURN FROM ARITHMETIK ********** CLCFIN PROC NEAR MOV AX,OFFSET RES MOV BCD,AX MOV AX,AUXBEG CMP AX,AUXFIN JAE ERR57 ;AUX OVERFLOW MOV ASCI,AX CALL BCDASC MOV TYPE0,'N' CALL PUSHVA RET CLCFIN ENDP ; ERR57: MOV AL,57H JMP ERROUT ; ;********** FIX ********** FIX_O PROC NEAR CALL PULLVA CALL CONVERT MOV AX,WORD PTR BIN CMP AX,30 JBE FIXEND MOV AX,30 FIXEND: MOV FIX,AX INC AX MOV FIX1,AX JMP PREFIX FIX_O ENDP ; ;********** PRECISION ********** PRECISION_O PROC NEAR CALL PULLVA CALL CONVERT MOV AX,WORD PTR BIN CMP AX,30 JBE GOPREC MOV AX,30 GOPREC: MOV PRE,AX ADD AX,2 MOV PRE2,AX INC AX MOV PRE3,AX ; PREFIX: MOV AX,PRE SUB AX,FIX JC ERR58 ;PRECISION FIX / CLASH MOV APRE,AX INC AX MOV APRE1,AX MOV AX,PRE2 ADD AX,FIX1 MOV SPRE,AX RET ; ERR58: MOV AL,58H JMP ERROUT PRECISION_O ENDP ; PROGRAM ENDP MAINSEG ENDS END PROGRAM