Category : Miscellaneous Language Source Code
Archive   : FORTRDOS.ZIP
Filename : FORTRDOS.ASM

PAGE 60,132
TITLE FORT_4BH.ASM ... DOS CALL FROM MS FORTRAN
;
; by: John R. Petrocelli
; 3890 Carman Road
; Schenectady, N.Y. 12303
;
;-----------------------------------------------------------------------
; THIS WILL ENABLE THE USER TO EXECUTE DOC COMMANDS FROM MS FORTRAN.
; IT FUNCTIONS VERY MUCH IN THE MANNER OF THE BASICA "SHELL" COMMAND.
;
; THE SAMPLE MS FORTRAN CALL FOLLOWS:
;
; CHARACTER*75 COMND
; INTEGER*2 IRC
; IRC=0
; COMND='CHKDSK'
; CALL DOSEXE(COMND,IRC)
; | |
; | |---RETURN CODE/OPTION CODE
; | ON ENTRY IF = 0 THEN WILL LOOK FOR A
; | COMMAND TO PROCESS
; | IF <> 0 THEN WILL JUST RELOAD THE
; | COMMAND PROCESSOR AND
; | ENTER DOS. USE "EXIT"
; | TO RETURN TO THE CALLING
; | PROCEDURE
; |
; |
; |---- THE COMMAND TO BE EXECUTED IF OPTION 0
; SELECTED
;
;
;-----------------------------------------------------------------------
; PROGRAM PREPARATION
; MASM ADOS4BH,ADOS4BH,ADOS4BH;
; FOR1 yourpgm;
; PAS2
; LINK yourpgm+ADOS4BH,yourpgm;
;
;-----------------------------------------------------------------------
; RETURN CODES
; 0 = CALL SUCCESSFUL
; 128 = LESS THAN 64K AVAILABLE
; 255 = FREE MEMORY UNSUCCESSFUL
; OTHER CODES ARE FOUND ON PAGE D-14 OF DOS 2.0 MANUAL
;
;-----------------------------------------------------------------------

;-----------------------------------------------------------------------
; EQUATES FOLLOW
;-----------------------------------------------------------------------

CR EQU 0DH ; CARRAGE RETURN
LF EQU 0AH ; LINE FEED
EOM EQU '$' ; END OF MESSAGE
CMDLEN EQU 75 ; MAX COMMAND LENGTH
CMDLEN2 EQU CMDLEN+2 ; MAX COMMAND LENGTH+2
ASCII0 EQU 30H ; ASCII 0 CHARACTER
SETBLK EQU 4A00H ; DOS SET BLOCK FUNCTION
DOSEXEC EQU 4B00H ; DOS LOAD AND EXECUTE FUNCTION
DOSCALL EQU 21H ; DOS CALL
PRINTF EQU 0900H ; DOS PRINT FUNCTION
KEYCW EQU 0C07H ; DOS CLEAR KEYBOARD BUFFER
; WAIT FOR INPUT WITHOUT ECHO

;-----------------------------------------------------------------------
; MAXMEM/HIMEM SEGMENT
;-----------------------------------------------------------------------

MAXMEM SEGMENT PUBLIC 'HIMEM' ; HIMEM IS THE HIGHEST MEMORY
MAXMEM ENDS ; ADDRESS USED BY THE PROGRAM

;-----------------------------------------------------------------------
; DATA SEGMENT
;-----------------------------------------------------------------------

DATA SEGMENT PUBLIC 'DATA' ; DATASEGMENT POINTS TO DATA GROUP
EXTRN CESXQQ:WORD ; CESXQQ IS THE LOCATION OF THE
; ORIGINAL ES REGISTER POINTING TO
DATA ENDS ; THE PSP

;-----------------------------------------------------------------------
; CODE BEGINS HERE
;-----------------------------------------------------------------------

DGROUP GROUP DATA ; DGROUP POINTS TO DATA GROUP
CODE SEGMENT 'CODE' ; CODE SEGMENT GROUPED WITH CODE
ASSUME CS:CODE,DS:DGROUP,SS:DGROUP

PUBLIC DOSEXE ; MAKE THIS PROCEDURE CALLABLE
DOSEXE PROC FAR
JMP RUNNER ; JUMP OVER DATA AREA IN CODE SEG

STACK_SEG DW ? ; SAVE ADDR FOR STACK SEGMENT
STACK_PTR DW ? ; SAVE ADDR FOR STACK POINTER

PSP_ENT DW 0 ; STORAGE FOR SEG OF PSP
MAX_FREE DW 0 ; STORAGE FOR # BYTES TO BE FREE
; AFTER DOS CALL 4AH

ENV_SEG DW 0 ; ENVIRONMENT SEGMENT..ES:BX POINTS
; HERE FOR DOS FUNCTION 4BH
CMD_OFF DW 0 ; OFFSET OF COMMAND LINE TO PROCESS
CMD_SEG DW 0 ; SEGMENT OF COMMAND LINE TO PROCESS
FCB1_OFF DW 0 ; OFFSET OF DUMMY FCB #1
FCB1_SEG DW 0 ; SEGMENT OF DUMMY FCB #1
FCB2_OFF DW 0 ; OFFSET OF DUMMY FCB #2
FCB2_SEG DW 0 ; SEGMENT OF DUMMY FCB #2

NO_CMD_LINE DB 0 ; DUMMY 0 LENGTH COMMAND LINE WHERE
NO_CMD_TAIL DB CR,0 ; CMD_OFF/SEG POINTS IF NO CMD LINE

CMD_LINE DB CMDLEN2,'/C ' ; CMD LINE TO BE FILLED WITH PASSED
THE_CMD DB CMDLEN DUP (' ') ; CMD...MAX LENGTH
CMD_TAIL DB CR,0

EXEC_OPT DW 0 ; STORAGE FOR EXEC OPTION....
; =0 PROCESS COMMAND
; <>0 LOAD COMMAND PROCESSOR ONLY

FCB1 DB 0 ; DUMMY FCB #1
DB 11 DUP ('?')
DB 25 DUP (0)

FCB2 DB 0 ; DUMMY FCB #2
DB 11 DUP (' ')
DB 25 DUP (0)

COMSPEC DB 'COMSPEC=' ; STRING TO SEARCH FOR IN THE
; ENVIRONMENT TO FIND COMMAND.COM


PAUS_MSG DB CR,LF,'PRESS ANY KEY TO CONTINUE'
DB CR,LF,EOM
STAT_MSG DB CR,LF,'MS FORTRAN DOS CALL RETURN CODE='
STAT_RCH DB ASCII0
STAT_RCL DB ASCII0
DB CR,LF,EOM
NO_64K DB CR,LF,'LESS THAN 64K OF MEMORY AVAILABLE',CR,LF,EOM
NO_COMSPEC_MSG DB CR,LF,'UNABLE TO FIND COMSPEC',CR,LF,EOM
NOT_FREE DB CR,LF,'FREE MEMORY FAILED',CR,LF,EOM
AUTHOR DB CR,LF,'MS FORTRAN/DOS EXEC INTERFACE',CR,LF
DB ' by: John R. Petrocelli 3090 Carman Rd. '
DB ' Schenectady,N.Y. 12303 ',CR,LF,EOM

RUNNER:
INT 3 ; USED FOR DEBUG TO CHECK PROCESS
PUSH AX ; PUSH REGISTERS
PUSH BX
PUSH CX
PUSH DX
PUSH DS
PUSH ES
PUSH DI
PUSH SI
PUSH BP
MOV BP,SP ; LOAD BP FOR ADDRESSING

MOV AX,CS
MOV DS,AX ; MAKE DS POINT TO CODE SEGMENT
MOV ES,AX ; MAKE ES POINT TO CODE SEGMENT

LEA DX,AUTHOR ; DS:DX POINTS TO AUTHOR MESSAGE
MOV AX,PRINTF ; LOAD AX WITH DOS PRINT FUNCTN
INT DOSCALL ; PRINT IT

LDS BX,DWORD PTR [BP+22] ; DS:BX=ADDR OF OPTION WHICH WILL
; ALSO BE USED TO PASS A RETURN
; CODE TO CALLING PROGRAM
MOV BX,[BX] ; BX=OPTION CODE
MOV EXEC_OPT,BX ; SAVE EXEC OPTION

CMP BX,0 ; IS OPTION = 0
JNZ NO_CMD1 ; NO THEN NO COMMAND TO PROCESS

LEA DI,THE_CMD ; ELSE MOVE THE COMMAND TO PROCESS
LDS BX,DWORD PTR [BP+26] ; (ADDR=ES:BX) INTO COMMAND AREA
MOV SI,BX ; DS:DI TO ES:SI
MOV CX,CMDLEN ; LOAD CX WITH MAX COMMAND LENGTH
CLD ; FOWARD DIRECTION
REPNZ MOVSB ; MOVE CX CHARACTERS

NO_CMD1:

MOV AX,CESXQQ ; AX = SEGMENT OF PSP
; THIS IS UNIQUE TO MS FORTRAN
; AND IS THE ORIGINAL ES VALUE
; WHICH IS THE SAME AS THE PSP
MOV PSP_ENT,AX ; SAVE PSP SEGMENT

MOV ES,AX ; ES ALSO POINTS TO PSP
MOV DX,ES:[002CH] ; DX EQUALS SEG OF ENVIRONMENT
MOV ENV_SEG,DX ; SAVE ENV SEG IN PARM BLOCK AREA

MOV DX,ES:[0002H] ; DX = MAX MEMORY INSTALLED
MOV MAX_FREE,DX ; SAVE MAX MEMORY FOR LATER


MOV DX,PSP_ENT ; LOAD DX WITH PSP SEGMENT
MOV ES,DX ; AND MAKE ES POINT TO IT

MOV BX,MAXMEM ; BX=HIGHEST MEMORY USED BY PGM
; THIS IS UNIQUE TO MS FORTRAN
; AND IS THE HIGHEST MEMORY
; LOCATION USED BY THE PROGRAM

ADD BX,40H ; ADD 1024 BYTES FOR PAD THIS IS
; EQUIVALENT TO 400H BYTES
; DUE TO 20 BIT ADDRESSING


MOV AX,ES
SUB CS:MAX_FREE,BX ; SUB BX FROM MAX MEM
SUB BX,AX ; SET BX TO NEW REQUESTED
; MEMORY SIZE IE. THE SIZE OF
; CALLING PROGRAM + PAD

CMP CS:MAX_FREE,1000H ; IS 64K FREE
JAE ENOUGH_MEMORY ; YES CONTINUE
; ELSE PRINT ERROR MSG AND EXIT
PUSH CS ; MAKE DS POINT TO
POP DS ; CODE SEGMENT
LEA DX,NO_64K ; LOAD MSG ADDR IN DX
MOV AX,PRINTF ; LOAD AX TO PRINT
INT DOSCALL ; PRINT IT
LES BX,DWORD PTR[BP+22] ; ES:BX=ADDRESS OF RETURN CODE
; TO PASS BACK TO CALLING PROGRAM
MOV DWORD PTR ES:[BX],128 ; LOAD RETURN CODE FOR RETURN TO
; CALLING PROGRAM
JMP EXIT ; EXIT

ENOUGH_MEMORY:
MOV AX,SETBLK ; SETBLOCK MEMORY ABOVE BX WILL
INT DOSCALL ; BE RELEASED TO DOS
JNC OK_FREE ; IF NO CARRY THEN FREE SUCCESSFUL


PUSH CS
POP DS
LEA DX,NOT_FREE ; ELSE LOAD DX WITH NOT_FREE MSG
MOV AX,PRINTF ; LOAD AX WITH PRINT FUNCTION
INT DOSCALL ; PRINT
LES BX,DWORD PTR[BP+22] ; ES:BX=ADDRESS OF RETURN CODE
; TO PASS BACK TO CALLING PROGRAM
MOV DWORD PTR ES:[BX],255 ; LOAD RETURN CODE FOR RETURN TO
; CALLING PROGRAM
JMP EXIT ; QUIT

OK_FREE: ; FREE MEMMORY AOK
MOV DX,CS ; DX=CODE SEGMENT
MOV CMD_SEG,DX ; COMMAND SEG, FCB1 SEG AND
MOV FCB1_SEG,DX ; FCB2 SEG ALL POINT THE THE
MOV FCB2_SEG,DX ; CODE SEGMMENT FOR THE PARM BLOCK

LEA DX,CMD_LINE ; LOAD PARM BLOCK WITH OFFSET OF
MOV CMD_OFF,DX ; THE COMMAND LINE

LEA DX,FCB1 ; LOAD PARM BLOCK WITH OFFSET OF
MOV FCB1_OFF,DX ; THE DUMMY FCB #1

LEA DX,FCB2 ; LOAD PARM BLOCK WITH OFFSET OF
MOV FCB2_OFF,DX ; THE DUMMY FCB #2

PUSH CS
POP ES ; ES POINTS TO SEARCH STRING
MOV AX,ENV_SEG ;
MOV DS,AX ; DS POINTS TO ENVIRONMENT SEGMENT
MOV BX,0 ; BX=OFFSET START INTO ENVIRONMENT
MOV DX,248 ; DX=MAX LENGTH OF ENVIRONMENT-8
COMPARE:
MOV SI,BX ; DS:SI=OFFSET START OF SCAN/SEARCH
; IN ENVIRONMENT AREA
LEA DI,COMSPEC ; ES:DI=WHAT WE ARE SEARCHING FOR
MOV CX,8 ; CX=LENGTH TO SEARCH
REPE CMPSB ; DO COMPARE
JZ MATCH ; IF CX=0 WE MATCHED & DI IS OFFSET
; INTO ENVIRONMENT SEGMENT

INC BX ; INCREMENT BX - START OF SEARCH

DEC DX ; DECREMENT LENGTH OF ENV LEFT
JZ NO_MATCH ; IF DX=0 NO COMSPEC FOUND AND
; NO ENVIROMENT LEFT TO SEARCH

JMP COMPARE ; LET'S TRY AGAIN

NO_MATCH:
PUSH CS
POP DS
LEA DX,NO_COMSPEC_MSG ;DS:DX=ADDRESS OF NO_COMSPEC MSG
MOV AX,PRINTF ; LOAD AX WITH DOS PRINT FUNCTN
INT DOSCALL ; PRINT IT
JMP EXIT ; QUIT

MATCH:

CMP EXEC_OPT,0 ; IF OPT=0 THEN THERE IS A COMMAND
JZ IS_COMMAND ; TO PROCESS
LEA DX,NO_CMD_LINE ; ELSE SET DX TO ZERO LENGTH COMND
MOV CMD_OFF,DX ; LINE AND LOAD ADDR IN PARM BLOCK

IS_COMMAND:
MOV DX,SI ; DS:DX=COMSPEC IE: A:\COMMAND.COM
LEA BX,ENV_SEG ; ES:BX=PARAMETER BLOCK FOR EXEC

PUSH BP ; SAVE THE REGISTERS
PUSH DS
PUSH ES
PUSH BX
PUSH CX
PUSH DX

MOV CS:STACK_SEG,SS ; SAVE THE STACK SEGMENT
MOV CS:STACK_PTR,SP ; SAVE THE STACK POINTER

MOV AX,DOSEXEC ; DOS LOAD AND EXECUTE FUNCTION
INT DOSCALL ; CALL DOS TO EXECUTE PGM

MOV SS,CS:STACK_SEG ; RESTORE THE STACK SEGMENT
MOV SP,CS:STACK_PTR ; RESTORE THE STACK POINTER

POP DX ; RESTORE REGISTERS
POP CX
POP BX
POP ES
POP DS
POP BP
PUSH CS ; BE SURE DS POINTS TO THE
POP DS ; CODE SEGMENT

JNC AOK ; IF CARRY FLAG NOT SET THEN
; EXEC WAS AOK
CLC ; CLEAR THE CARRY FLAG

LES BX,DWORD PTR[BP+22] ; ES:BX=ADDRESS OF RETURN CODE
; TO PASS BACK TO CALLING PROGRAM
MOV DH,0
MOV DL,AL
MOV DWORD PTR ES:[BX],DX ; LOAD RETURN CODE FOR RETURN TO
; CALLING PROGRAM

AAM ; MAKE RETURN CODE IN AL
ADD AX,3030H ; FULL WORD AND ASCII
MOV STAT_RCH,AH ; PLACE AH IN MESSAGE AREA
MOV STAT_RCL,AL ; PLACE AL IN MESSAGE AREA

JMP PRINT_STATUS
AOK:
LES BX,DWORD PTR[BP+22] ; ES:BX=ADDRESS OF RETURN CODE
; TO PASS BACK TO CALLING PROGRAM
MOV DWORD PTR ES:[BX],0 ; LOAD RETURN CODE FOR RETURN TO
; CALLING PROGRAM

PRINT_STATUS:
LEA DX,STAT_MSG ; DS:DX ADDR OF STATUS MSG
MOV AX,PRINTF ; LOAD AX WITH DOS PRINT FUNCTN
INT DOSCALL ; PRINT IT


EXIT: ; EXITING
LEA DX,PAUS_MSG ; DS:DX=ADDR OF PAUSE MSG
MOV AX,PRINTF ; LOAD AX TO PRINT
INT DOSCALL ; PRINT IT
MOV AX,0C07H ; KEYBOARD INPUT...CLEAR BUFFER
INT DOSCALL ; AND WAIT FOR INPUT WITHOUT ECHO

POP BP
POP SI
POP DI
POP ES ; POP REGISTERS
POP DS
POP DX
POP CX
POP BX
POP AX
RET 08H

DOSEXE ENDP
CODE ENDS
;-----------------------------------------------------------------------
; CODE ENDS
;-----------------------------------------------------------------------
END
------------------------