Category : Modula II Source Code
Archive   : MLIFE.ZIP
Filename : UTILITY.DEF

 
Output of file : UTILITY.DEF contained in archive : MLIFE.ZIP
DEFINITION MODULE Utility;

(*
Title: UTILITY.DEF

Author: Randall A. Maddox
12209 M Peach Crest Drive
Germantown, MD 20874
(301) 428-9581

System: LOGITECH MODULA-2, MS/PCDOS, Version 3.0, August 1987

Description: This module contains the definitions of the procedures
implemented in UTILITY.MOD. Some are MS/PCDOS-specific
procedures and those require DOS version 2.0 or higher.

CapStr - returns string in uppercase
TrimLT - trims off leading/trailing spaces
TrimOne - trims all multiple spaces to single spaces
TrimAll - trims out all spaces
GetDate - returns date formatted as Day Mon dd, yyyy
GetTime - returns time formatted as hh:mm:ss _M
GetEnvVar - returns value of environment variable
ParmCnt - number of command line parameters
GetCmdParm - returns single command line parameter
GetCmdLn - returns command-line as string
KeyPressed - returns TRUE if character ready

This module also exports a number of constants to be used
in CODE statements. These constants are the hex values of
assembly language instructions to PUSH and POP registers,
LOAD AH from FLAGS, STORE AH in FLAGS, Return from Interrupt,
CLEAR (disable) and ENABLE Interrupts, and, last but not
least, the constant Dos is for use is SWI statements that
call the DOS services on Int 21H. As per the Logitech
Modula-2 documentation, you should always use PushBP
immediately prior to SWI and PopBP immediately following.
If you use several GETREG statements, you will also want
to push the registers you will be getting and then pop
each one before getting it. For example, assuming that
AXwd, BXwd, CXwd and DXwd are WORD variables with the
appropriate values, you might use something like this:

SETREG(AX,AXwd); (* set up for call to DOS *)
SETREG(CX,CXwd);
CODE(PushBP); (* save BP register *)
SWI(Dos); (* call DOS *)
CODE(PopBP,PushDX,PushCX); (* restore BP, save DX, CX *)
GETREG(BX,BXwd); (* get value in BX *)
(* NOTE: Pop in reverse order from Pushes!!!!! *)
CODE(PopCX); (* restore CX *)
GETREG(CX,CXwd); (* get value in CX *)
CODE(PopDX); (* restore DX *)
GETREG(DX,DXwd); (* get value in DX *)

The LAHF instruction is particularly handy for all those
DOS calls that set the carry flag to indicate an error.
Just CODE(LAHF) and then GETREG(AX,AXwd). To check for
error use (assuming Err is CARDINAL):
Err := CARDINAL(BITSET(AXwd) * ErrMask));
IF (Err <> 0) THEN (* error occured *)
Err := CARDINAL(BITSET(AXwd) * LoMask) (* get AL *)
END; (* if *)
After this, Err will be 0 if no error occurred, or
it will be set to the error code returned by DOS in
AL.



Update History:
Originally written: 10/6/87
Modified GetEnvVar, added GetCmdLn: 7/2/88
Added assembly constants: 7/3/88
Added TrimLt and TrimAll: 7/3/88
Added GetCmdParm, ParmCnt, TrimOne: 7/4/88
Added CapStr: 7/5/88
Made ParmCnt function: 7/6/88
Added KeyPressed: 11/25/88
*)

EXPORT QUALIFIED

(* constants *)
PushAX, PopAX, PushCX, PopCX, PushDX, PopDX, PushBX, PopBX,
PushSP, PopSP, PushBP, PopBP, PushSI, PopSI, PushDI, PopDI,
PushES, PopES, PushDS, PopDS, PushCS, PushSS, PopSS,
PushFL, PopFL, LAHF, SAHF, IRET, CLI, STI, Dos,
ErrMask, ZMask, LoMask, HiMask,

(* data types *)
Date, Time,

(* procedures *)
CapStr, TrimLT, TrimOne, TrimAll, GetDate, GetTime, GetEnvVar,
ParmCnt, GetCmdParm, GetCmdLn, KeyPressed;

CONST
PushAX = 50H; (* assembly instruction to Push AX register *)
PopAX = 58H; (* assembly instruction to Pop AX register *)
PushCX = 51H; (* assembly instruction to Push CX register *)
PopCX = 59H; (* assembly instruction to Pop CX register *)
PushDX = 52H; (* assembly instruction to Push DX register *)
PopDX = 5AH; (* assembly instruction to Pop DX register *)
PushBX = 53H; (* assembly instruction to Push BX register *)
PopBX = 5BH; (* assembly instruction to Pop BX register *)
PushSP = 54H; (* assembly instruction to Push SP register *)
PopSP = 5CH; (* assembly instruction to Pop SP register *)
PushBP = 55H; (* assembly instruction to Push BP register *)
PopBP = 5DH; (* assembly instruction to Pop BP register *)
PushSI = 56H; (* assembly instruction to Push SI register *)
PopSI = 5EH; (* assembly instruction to Pop SI register *)
PushDI = 57H; (* assembly instruction to Push DI register *)
PopDI = 5FH; (* assembly instruction to Pop DI register *)
PushES = 06H; (* assembly instruction to Push ES register *)
PopES = 07H; (* assembly instruction to Pop ES register *)
PushDS = 1EH; (* assembly instruction to Push DS register *)
PopDS = 1FH; (* assembly instruction to Pop DS register *)
PushCS = 0EH; (* assembly instruction to Push CS register *)
PushSS = 16H; (* assembly instruction to Push SS register *)
PopSS = 17H; (* assembly instruction to Pop SS register *)
PushFL = 9CH; (* assembly instruction to Push Flags register *)
PopFL = 9DH; (* assembly instruction to Pop Flags register *)
LAHF = 9FH; (* assembly instruction Load Flags into AH register *)
SAHF = 9EH; (* assembly instruction Store AH into Flags register *)
IRET = 0CFH; (* assembly instruction Interrupt ReTurn from *)
CLI = 0FAH; (* assembly instruction CLear Interrupt flag, disable *)
STI = 0FBH; (* assembly instruction Set To enable Interrupts *)
Dos = 21H; (* DOS services interrupt *)
(* bit masks *)
ErrMask = BITSET(0100H); (* mask Carry Flag from AH after LAHF *)
ZMask = BITSET(4000H); (* mask Zero Flag from AH after LAHF *)
LoMask = BITSET(00FFH); (* mask off low byte of WORD *)
HiMask = BITSET(0FF00H); (* mask off high byte of WORD *)

TYPE
Date = ARRAY[0..16] OF CHAR;
Time = ARRAY[0..11] OF CHAR;

(**************************************************************************)

PROCEDURE CapStr(VAR Str : ARRAY OF CHAR);

(* This procedure returns Str with all lowercase letters converted
to uppercase.
*)

(**************************************************************************)

PROCEDURE TrimLT(VAR Str : ARRAY OF CHAR);

(* This procedure trims off any leading or trailing spaces from
Str.
*)

(**************************************************************************)

PROCEDURE TrimOne(VAR Str : ARRAY OF CHAR);

(* This procedure trims all occurrences of multiple consecutive
spaces in Str to single spaces.
*)

(**************************************************************************)

PROCEDURE TrimAll(VAR Str : ARRAY OF CHAR);

(* This procedure removes all spaces from Str.
*)

(******************************************************************************)

PROCEDURE GetDate(VAR DateStr : Date);

(* This procedure gets the current system date and returns it in the
form: Day Mon dd, yyyy in the variable DateStr.
*)

(**************************************************************************)

PROCEDURE GetTime(VAR TimeStr : Time);

(* This procedure gets the current system time and returns it in the
form: hh:mm:ss _M in the variable TimeStr.
*)


(******************************************************************************)

PROCEDURE GetEnvVar(VarName : ARRAY OF CHAR;
VAR VarValue : ARRAY OF CHAR);

(* This procedure searches the current environment variables for the one
specified in VarName. If that variable is found, then its value is
returned in VarValue. If VarValue is not long enough to hold the entire
value of VarName, then the truncated value is returned with no error
indicated. If the variable specified in VarName is NOT found, then
VarValue is returned with VarValue[0] = nul.

Procedure assumes that at least one environment variable is present,
and this should be a safe assumption since DOS will at least set
COMSPEC even if the user sets nothing else.
*)

(**************************************************************************)

PROCEDURE ParmCnt() : CARDINAL;

(* This procedure returns the number of command line parameters
present.
*)

(**************************************************************************)

PROCEDURE GetCmdParm(N : CARDINAL;
VAR Str : ARRAY OF CHAR);

(* This procedure returns the command line parameter number N in
the variable Str. Parameters start with 1 as the first. If
Str is not long enough to contain the requested parameter,
then the truncated part that does fit is returned. If parameter
N does not exist, then Str is returned with Str[0] = nul.
*)

(**************************************************************************)

PROCEDURE GetCmdLn(VAR CmdStr : ARRAY OF CHAR);

(* This procedure returns the command-line found at offset 81H in
the PSP in the variable CmdStr. CmdStr[0] will be set to ASCII
nul if no command line present. If CmdStr is not long enough
to hold the entire command line, then only the truncated portion
that fits is returned. The command line is returned with all
leading and trailing spaces removed and each parameter separated
from the others by a single space. Any parsing of the command line
contents is the responsibility of the calling program.
*)

(**************************************************************************)

PROCEDURE KeyPressed() : BOOLEAN;

(* This procedure returns TRUE if a keyboard input character is ready
and FALSE if not. This is a look-ahead operation in that a waiting
character is not consumed by the test.
*)

(**************************************************************************)

END Utility.

(* end of this file *)


  3 Responses to “Category : Modula II Source Code
Archive   : MLIFE.ZIP
Filename : UTILITY.DEF

  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: http://www.os2museum.com/wp/mtswslnk/