diff --git a/Logitech Modula-2 v1/ASCII.DEF b/Logitech Modula-2 v1/ASCII.DEF new file mode 100644 index 0000000..d37ba40 --- /dev/null +++ b/Logitech Modula-2 v1/ASCII.DEF @@ -0,0 +1,26 @@ +DEFINITION MODULE ASCII; +(* + Symbolic constants for non-printing ASCII characters +*) + +EXPORT QUALIFIED nul, soh, stx, etx, eot, enq, ack, bel, + bs, ht, lf, vt, ff, cr, so, si, + dle, dc1, dc2, dc3, dc4, nak, syn, etb, + can, em, sub, esc, fs, gs, rs, us, + del; + + + CONST + nul = 00C; soh = 01C; stx = 02C; etx = 03C; + eot = 04C; enq = 05C; ack = 06C; bel = 07C; + bs = 10C; ht = 11C; lf = 12C; vt = 13C; + ff = 14C; cr = 15C; so = 16C; si = 17C; + dle = 20C; dc1 = 21C; dc2 = 22C; dc3 = 23C; + dc4 = 24C; nak = 25C; syn = 26C; etb = 27C; + can = 30C; em = 31C; sub = 32C; esc = 33C; + fs = 34C; gs = 35C; rs = 36C; us = 37C; + del = 177C; + + +END ASCII. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/ASCII.LNK b/Logitech Modula-2 v1/ASCII.LNK new file mode 100644 index 0000000..3a3c836 Binary files /dev/null and b/Logitech Modula-2 v1/ASCII.LNK differ diff --git a/Logitech Modula-2 v1/ASCII.REF b/Logitech Modula-2 v1/ASCII.REF new file mode 100644 index 0000000..72b8fa4 Binary files /dev/null and b/Logitech Modula-2 v1/ASCII.REF differ diff --git a/Logitech Modula-2 v1/ASCII.SYM b/Logitech Modula-2 v1/ASCII.SYM new file mode 100644 index 0000000..3e39e89 Binary files /dev/null and b/Logitech Modula-2 v1/ASCII.SYM differ diff --git a/Logitech Modula-2 v1/CARDINAL.DEF b/Logitech Modula-2 v1/CARDINAL.DEF new file mode 100644 index 0000000..53ebf82 --- /dev/null +++ b/Logitech Modula-2 v1/CARDINAL.DEF @@ -0,0 +1,51 @@ +DEFINITION MODULE CardinalIO; +(* + Terminal input/output of CARDINALs in decimal and hex + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +*) + +EXPORT QUALIFIED ReadCardinal, WriteCardinal, ReadHex, WriteHex; + + +PROCEDURE ReadCardinal (VAR c: CARDINAL); +(*- Read an unsigned decimal number from the terminal. +out: c the value that was read. + +The read terminates only on ESC, EOL, or blank, and the terminator +must be re-read, for example with Terminal.Read. + +If the read encounters a non-digit, or a digit which would cause the +number to exceed the maximum CARDINAL value, the bell is sounded and +that character is ignored. No more than one leading '0' is allowed. +*) + +PROCEDURE WriteCardinal (c: CARDINAL; w: CARDINAL); +(*- Write a CARDINAL in decimal format to the terminal. +in: c value to write, + w minimum field width. + +The value of c is written, even if it takes more than w digits. +If it takes fewer digits, leading blanks are output to make the +field w characters wide. +*) + +PROCEDURE ReadHex (VAR c: CARDINAL); +(*- Read a CARDINAL in hexadecimal format from the terminal. + [see ReadCardinal above] +*) + +PROCEDURE WriteHex (c: CARDINAL; digits: CARDINAL); +(*- Write a CARDINAL in hexadecimal format to the terminal. + [see WriteCardinal above] +*) + +END CardinalIO. + +AL); +(*- Write a CARDINAL in hexadecimal format to the terminal. + [see WriteCardinal above] +*) + +EN \ No newline at end of file diff --git a/Logitech Modula-2 v1/CARDINAL.LNK b/Logitech Modula-2 v1/CARDINAL.LNK new file mode 100644 index 0000000..fc593a8 Binary files /dev/null and b/Logitech Modula-2 v1/CARDINAL.LNK differ diff --git a/Logitech Modula-2 v1/CARDINAL.REF b/Logitech Modula-2 v1/CARDINAL.REF new file mode 100644 index 0000000..84928cf Binary files /dev/null and b/Logitech Modula-2 v1/CARDINAL.REF differ diff --git a/Logitech Modula-2 v1/CARDINAL.SYM b/Logitech Modula-2 v1/CARDINAL.SYM new file mode 100644 index 0000000..98270ef Binary files /dev/null and b/Logitech Modula-2 v1/CARDINAL.SYM differ diff --git a/Logitech Modula-2 v1/COMP.LNK b/Logitech Modula-2 v1/COMP.LNK new file mode 100644 index 0000000..63c1e69 Binary files /dev/null and b/Logitech Modula-2 v1/COMP.LNK differ diff --git a/Logitech Modula-2 v1/COMP.LOD b/Logitech Modula-2 v1/COMP.LOD new file mode 100644 index 0000000..7d75e6b Binary files /dev/null and b/Logitech Modula-2 v1/COMP.LOD differ diff --git a/Logitech Modula-2 v1/COMP.MAP b/Logitech Modula-2 v1/COMP.MAP new file mode 100644 index 0000000..3e70780 --- /dev/null +++ b/Logitech Modula-2 v1/COMP.MAP @@ -0,0 +1,61 @@ +Modula-2/86 Linker V1.0 - (c) 1983 Logitech + +Output file name: a:comp.LOD + +++ Program map (13 modules included in this layer): + Modules are listed in order of module code execution. + ++ MOD= System KEY= A78702280DFC FILE= A:System.LNK + CODE= 05B1 DATA= 07EF + PROC-TABLE= 0002 ++ MOD= Keyboard KEY= A787026FE9FC FILE= A:Keyboard.LNK + CODE= 0594 DATA= 07E6 + PROC-TABLE= 0002 ++ MOD= Display KEY= A6ED00811F68 FILE= C:\m2lib\lnk\Display.LNK + CODE= 058C DATA= 07E6 + PROC-TABLE= 0002 ++ MOD= Termbase KEY= A787024FACBC FILE= A:Termbase.LNK + CODE= 0551 DATA= 07DF + PROC-TABLE= 0002 ++ MOD= ASCII KEY= A6ED007F8F20 FILE= C:\m2lib\lnk\ASCII.LNK + CODE= 054F DATA= 07DF + PROC-TABLE= 0002 ++ MOD= Terminal KEY= A02101346662 FILE= A:Terminal.LNK + CODE= 052D DATA= 07DE + PROC-TABLE= 0002 ++ MOD= ProgMessage KEY= A7880049D782 FILE= C:\m2lib\lnk\ProgMess.LNK + CODE= 04ED DATA= 07DE + PROC-TABLE= 01CC ++ MOD= DiskFiles KEY= A02102DCA83E FILE= A:DiskFile.LNK + CODE= 03A2 DATA= 0620 + PROC-TABLE= 0006 ++ MOD= FileSystem KEY= A02102D58DCC FILE= A:FileSyst.LNK + CODE= 022C DATA= 0607 + PROC-TABLE= 0007 ++ MOD= Storage KEY= A6ED00830B7C FILE= C:\m2lib\lnk\Storage.LNK + CODE= 01AD DATA= 0606 + PROC-TABLE= 0002 ++ MOD= Program KEY= A021002B9F06 FILE= A:Program.LNK + CODE= 0062 DATA= 0600 + PROC-TABLE= 0002 ++ MOD= DiskDirectory KEY= A02102DE2F80 FILE= A:DiskDire.LNK + CODE= 0041 DATA= 0600 + PROC-TABLE= 0002 ++ MOD= Comint KEY= A6ED008351F4 FILE= a:comp.LNK + CODE= 0000 DATA= 05F8 + PROC-TABLE= 004E + +++ Base (0 modules assumed to be in base layers): + + + +Length of code (in paragraphs): 05F8 +Length of data (in paragraphs): 0207 + KEY= A02102DE2F80 FILE= A:DiskDire.LNK + CODE= 0041 DATA= 060B + PROC-TABLE= 0002 ++ MOD= Comint KEY= A6ED008351F4 FILE= a:comp.LNK + CODE= 0000 DATA= 0603 + PROC-TABLE= 004E + +++ Base (0 m \ No newline at end of file diff --git a/Logitech Modula-2 v1/COMPFILE.LNK b/Logitech Modula-2 v1/COMPFILE.LNK new file mode 100644 index 0000000..d078583 Binary files /dev/null and b/Logitech Modula-2 v1/COMPFILE.LNK differ diff --git a/Logitech Modula-2 v1/COMPPARA.DEF b/Logitech Modula-2 v1/COMPPARA.DEF new file mode 100644 index 0000000..24c6107 --- /dev/null +++ b/Logitech Modula-2 v1/COMPPARA.DEF @@ -0,0 +1,182 @@ +(**************************************** +* * +* MODULA-2 Multi-Pass Compiler * +* **************************** * +* * +* Implementation for Intel 8086 * +* * +* Resident Compiler * +* * +* * +* M86CompPara: * +* * +* parameter module to configurate * +* the Modula-2 compiler * +* implementation module may be * +* changed by the user * +* * +* Version: * +* 1.0 Dec 14, 1983 * +* * +* * +* Copyright: * +* (C) 1983 * +* LOGITECH S.A. * +* CH-1143 Apples (Switzerland) * +* * +****************************************) +DEFINITION MODULE CompPara; + + EXPORT QUALIFIED + CPpageLength, CPpageWidth, (* listing definition *) + CPffAtEnd, CPffAtBegin, + CPheader, CPdate, + CPfooter, CPfooterText, + CPpriorityLevels, (* interrupt system definition: 8259A *) + CPRTSfunctVector, (* interrupt vector to access to RTS functions *) + CPemulator, (* default settings of compiler options *) + CPinteractiv, + CPquery, CPautoquery, + CPdebug, CPversion, + CPlister, CPerrorLister, + CPafterPass1, CPafterPass2,(* defines moment of listing generation *) + CPstacktest, CPrangetest, (* default settings of program-source options *) + CParithmetictest; + + VAR + + (* the following variables are used to define the format of *) + (* the listing generated by the compiler *) + + CPpageLength, + (* number of lines per page : initial value is 60 *) + (* valid range: 40..65535 (if out of range: 60 is taken) *) + + CPpageWidth: CARDINAL; + (* number of characters per line : initial value is 79 *) + (* valid range: 50..150 (if out of range: 79 is taken) *) + + (* the next two parameters are used to define the page eject *) + + CPffAtEnd: BOOLEAN; + (* defines whether a formfeed at last character *) + (* is generated or not: initial value is TRUE *) + + CPffAtBegin: BOOLEAN; + (* defines whether a formfeed at first character *) + (* is generated or not: initial value is FALSE *) + + (* the next two parameters define the header of each page *) + + CPheader: BOOLEAN; + (* defines whether a headerline is generated on each *) + (* page or not: initial value is TRUE *) + + CPdate: BOOLEAN; + (* defines whether date in headerline is generated *) + (* or not: initial value is FALSE *) + + + (* a header line has the following format: *) + (* Modula-2/86 filename.ext Date Page n *) + (* e.g. *) + (* Modula-2/86 COMPPARA.DEF Nov 16'83 Page 1 *) + + + (* the next two parameters define the footer of each page *) + + CPfooter: BOOLEAN; + (* defines whether a footerline is generated on each *) + (* page or not: initial value is FALSE *) + + CPfooterText: ARRAY [0..149] OF CHAR; + (* string of pagewidth characters that defines the footerline *) + (* normally used for Copyright text: initially an empty string *) + + + (* definition of interrupt system: number of priority levels *) + + CPpriorityLevels: CARDINAL; + (* initial value of distributed version is 8: *) + (* defined by the (8259A) interrupt controller(s) *) + + + (* definition of interface to Run-Time-Support system *) + + CPRTSfunctVector: CARDINAL; + (* defines the interrupt vector to acces the RTS *) + (* RTS: Runtime Support: Assembley part of Modula-2/86 System *) + (* normally 228: may be only changed if RTS is changed *) + + + (* the following boolean variable defines whether code for an *) + (* 8087 coprocessoror an 8087 emulator is generated by the compiler *) + + CPemulator: BOOLEAN; (* initial value is FALSE *) + + (* the following options define the interactive behaviour of the compiler *) + + CPinteractiv: BOOLEAN; (* initial value is TRUE *) + (* whether compiler may be stopped by typing a key *) + + CPquery: BOOLEAN; (* initial value is FALSE *) + (* whether compiler asks for the symbol files of *) + (* the imported modules or tries to find them by *) + (* the default strategy: *) + (* build filename from module name by taking *) + (* the 8 first characters and the extension 'SYM' *) + + CPautoquery: BOOLEAN; (* initial value is TRUE *) + (* whether compiler falls automatically in query mode *) + (* if it didn't find the file by the default mechanism *) + + CPdebug: BOOLEAN; (* initial value is TRUE *) + (* whether compiler generates a reference file *) + (* that would be used by the debugger, or not *) + + CPversion: BOOLEAN; (* initial value is FALSE *) + (* whether compiler displays version info or not *) + + CPlister: BOOLEAN; (* initial value is FALSE *) + (* whether compiler generates a listing file or not *) + + CPerrorLister: BOOLEAN; (* initial value is TRUE *) + (* whether compiler generates automatically an *) + (* error listing if errors occured or not *) + + (* moment of listing generation in case of errors *) + + (* if both variables are set to FALSE the listing *) + (* will be generated after pass3 *) + (* the functions of the different passes are: *) + (* pass1 checks syntactic of program *) + (* pass2 checks declaration parts (allocation) *) + (* pass3 checks bodys (compatibility test) *) + + + CPafterPass1: BOOLEAN; (* initial value: TRUE *) + (* whether compiler goes to lister if error detected *) + (* in pass1 and terminates compilation, or not *) + + CPafterPass2: BOOLEAN; (* initial value: FALSE *) + (* whether compiler goes to lister if error detected *) + (* in pass2 and terminates compilation, or not *) + + (* the following boolean variables are used to define the default *) + (* setting of the corresponding testcode options: *) + (* TRUE means: default is '+'; FALSE means: default is '-' *) + + CPstacktest: BOOLEAN; + (* for option 'S': initial value is TRUE *) + + CPrangetest: BOOLEAN; + (* for option 'R': initial value is TRUE *) + + CParithmetictest: BOOLEAN; + (* for option 'T': initial value is TRUE *) + +END CompPara. + +ial value is TRUE *) + + CParithmetic \ No newline at end of file diff --git a/Logitech Modula-2 v1/COMPPARA.LNK b/Logitech Modula-2 v1/COMPPARA.LNK new file mode 100644 index 0000000..888a478 Binary files /dev/null and b/Logitech Modula-2 v1/COMPPARA.LNK differ diff --git a/Logitech Modula-2 v1/COMPPARA.MOD b/Logitech Modula-2 v1/COMPPARA.MOD new file mode 100644 index 0000000..c067b19 --- /dev/null +++ b/Logitech Modula-2 v1/COMPPARA.MOD @@ -0,0 +1,177 @@ +(* + Copyrigth (C) 1984 Logitech. All Rights Reserved. + + Permission is hereby granted to registered users to use or + abstract the following program in the implementation of + customized versions. This permission does not include the + right to redistribute the source code of this program. +*) +(**************************************** +* * +* MODULA-2 Multi-Pass Compiler * +* **************************** * +* * +* Implementation for Intel 8086 * +* * +* Resident Compiler * +* * +* * +* M86CompPara: * +* * +* parameter module to configurate * +* the Modula-2 compiler * +* implementation module may be * +* changed by the user * +* * +* Version: * +* 1.0 Jan 17, 1984 * +* * +* * +* Copyright: * +* (C) 1983 * +* LOGITECH S.A. * +* CH-1143 Apples (Switzerland) * +* * +****************************************) +IMPLEMENTATION MODULE CompPara; + +BEGIN + (* the following variables are used to define the format of *) + (* the listing generated by the compiler *) + + CPpageLength := 60; + (* number of lines per page : initial value is 60 *) + (* valid range: 40..65535 (if out of range: 60 is taken) *) + + CPpageWidth := 79; + (* number of characters per line : initial value is 79 *) + (* valid range: 50..150 (if out of range: 79 is taken) *) + + (* the next two parameters are used to define the page eject *) + + CPffAtEnd := TRUE; + (* defines whether a formfeed at last character *) + (* is generated or not: initial value is TRUE *) + + CPffAtBegin := FALSE; + (* defines whether a formfeed at first character *) + (* is generated or not: initial value is FALSE *) + + (* the next two parameters define the header of each page *) + + CPheader := TRUE; + (* defines whether a headerline is generated on each *) + (* page or not: initial value is TRUE *) + + CPdate := FALSE; + (* defines whether date in headerline is generated *) + (* or not: initial value is FALSE *) + + + (* a header line has the following format: *) + (* Modula-2/86 Date filename.ext Page n *) + (* e.g. *) + (* Modula-2/86 Nov 16'83 COMPPARA.DEF Page 1 *) + + + (* the next two parameters define the footer of each page *) + + CPfooter := FALSE; + (* defines whether a footerline is generated on each *) + (* page or not: initial value is FALSE *) + + CPfooterText := ""; + (* string of pagewidth characters that defines the footerline *) + (* normally used for Copyright text: initially an empty string *) + + + (* definition of interrupt system: number of priority levels *) + + CPpriorityLevels := 8; + (* initial value of distributed version is 8: *) + (* defined by the (8259A) interrupt controller(s) *) + + + (* definition of interface to Run-Time-Support system *) + + CPRTSfunctVector := 228; + (* defines the interrupt vector to acces the RTS *) + (* RTS: Runtime Support: Assembley part of Modula-2/86 System *) + (* normally 228: may be only changed if RTS is changed *) + + CPEmulBaseVector := 18H; + (* defines the base interrupt vector to acces the emulator *) + (* normally 18H: may be only changed if emulator is changed *) + + + (* the following boolean variable defines whether code for an *) + (* 8087 coprocessor or an 8087 emulator is generated by the compiler *) + + CPemulator := FALSE; (* initial value is FALSE *) + + (* the following options define the interactive behaviour of the compiler *) + + CPinteractiv := TRUE; (* initial value is TRUE *) + (* whether compiler may be stopped by typing a key *) + + CPstatistic := TRUE; (* initial value is TRUE *) + (* whether compiler displays some statistic values *) + + CPquery := FALSE; (* initial value is FALSE *) + (* whether compiler asks for the symbol files of *) + (* the imported modules or tries to find them by *) + (* the default strategy: *) + (* build filename from module name by taking *) + (* the 8 first characters and the extension 'SYM' *) + + CPautoquery := TRUE; (* initial value is TRUE *) + (* whether compiler falls automatically in query mode *) + (* if it didn't find the file by the default mechanism *) + + CPdebug := TRUE; (* initial value is TRUE *) + (* whether compiler generates a reference file *) + (* that would be used by the debugger, or not *) + + CPversion := FALSE; (* initial value is FALSE *) + (* whether compiler displays version info or not *) + + CPlister := FALSE; (* initial value is FALSE *) + (* whether compiler generates a listing file or not *) + + CPerrorLister := TRUE; (* initial value is TRUE *) + (* whether compiler generates automatically an *) + (* error listing if errors occured or not *) + + (* moment of listing generation in case of errors *) + + (* if both variables are set to FALSE the listing *) + (* will be generated after pass3 *) + (* the functions of the different passes are: *) + (* pass1 checks syntactic of program *) + (* pass2 checks declaration parts (allocation) *) + (* pass3 checks bodys (compatibility test) *) + + + CPafterPass1 := TRUE; (* initial value: TRUE *) + (* whether compiler goes to lister if error detected *) + (* in pass1 and terminates compilation, or not *) + + CPafterPass2 := TRUE; (* initial value: FALSE *) + (* whether compiler goes to lister if error detected *) + (* in pass2 and terminates compilation, or not *) + + (* the following boolean variables are used to define the default *) + (* setting of the corresponding testcode options: *) + (* TRUE means: default is '+'; FALSE means: default is '-' *) + + CPstacktest := TRUE; + (* for option 'S': initial value is TRUE *) + + CPrangetest := TRUE; + (* for option 'R': initial value is TRUE *) + + CPindextest := TRUE; + (* for option 'T': initial value is TRUE *) + +END CompPara. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/COMPPARA.SYM b/Logitech Modula-2 v1/COMPPARA.SYM new file mode 100644 index 0000000..048a0e5 Binary files /dev/null and b/Logitech Modula-2 v1/COMPPARA.SYM differ diff --git a/Logitech Modula-2 v1/CONVERSI.DEF b/Logitech Modula-2 v1/CONVERSI.DEF new file mode 100644 index 0000000..3b030b0 --- /dev/null +++ b/Logitech Modula-2 v1/CONVERSI.DEF @@ -0,0 +1,45 @@ +DEFINITION MODULE Conversions; +(* + Convert from INTEGER and CARDINAL to string + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +*) + +EXPORT QUALIFIED ConvertOctal, ConvertHex, + ConvertCardinal, ConvertInteger; + + +PROCEDURE ConvertOctal(num, len: CARDINAL; VAR str: ARRAY OF CHAR); +(*- Convert number to right-justified octal representation +in: num value to be represented, + len minimum width of representation, +out: str result string. + +If the representation of 'num' uses fewer than 'len' digits, blanks +are added on the left. If the representation will not fit in 'str', +it is truncated on the right. +*) + +PROCEDURE ConvertHex(num, len: CARDINAL; VAR str: ARRAY OF CHAR); +(*- Convert number to right-justified hexadecimal representation. + [see ConvertOctal] +*) + +PROCEDURE ConvertCardinal(num, len: CARDINAL; VAR str: ARRAY OF CHAR); +(*- Convert a CARDINAL to right-justified decimal representation. + [see ConvertOctal] +*) + +PROCEDURE ConvertInteger(num: INTEGER; len: CARDINAL; + VAR str: ARRAY OF CHAR); +(*- Convert an INTEGER to right-justified decimal representation. + [see ConvertOctal] +Note that a leading '-' is generated if num < 0, but never a '+'. +*) + +END Conversions. + + + [see Co \ No newline at end of file diff --git a/Logitech Modula-2 v1/CONVERSI.LNK b/Logitech Modula-2 v1/CONVERSI.LNK new file mode 100644 index 0000000..8835532 Binary files /dev/null and b/Logitech Modula-2 v1/CONVERSI.LNK differ diff --git a/Logitech Modula-2 v1/CONVERSI.REF b/Logitech Modula-2 v1/CONVERSI.REF new file mode 100644 index 0000000..b24b953 Binary files /dev/null and b/Logitech Modula-2 v1/CONVERSI.REF differ diff --git a/Logitech Modula-2 v1/CONVERSI.SYM b/Logitech Modula-2 v1/CONVERSI.SYM new file mode 100644 index 0000000..130a4db Binary files /dev/null and b/Logitech Modula-2 v1/CONVERSI.SYM differ diff --git a/Logitech Modula-2 v1/DBUG.LNK b/Logitech Modula-2 v1/DBUG.LNK new file mode 100644 index 0000000..381b03c Binary files /dev/null and b/Logitech Modula-2 v1/DBUG.LNK differ diff --git a/Logitech Modula-2 v1/DBUG.LOD b/Logitech Modula-2 v1/DBUG.LOD new file mode 100644 index 0000000..5c3a60c Binary files /dev/null and b/Logitech Modula-2 v1/DBUG.LOD differ diff --git a/Logitech Modula-2 v1/DISKDIRE.DEF b/Logitech Modula-2 v1/DISKDIRE.DEF new file mode 100644 index 0000000..340491f --- /dev/null +++ b/Logitech Modula-2 v1/DISKDIRE.DEF @@ -0,0 +1,76 @@ +DEFINITION MODULE DiskDirectory; +(* + Interface to directory functions of the underlying OS + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +*) + + +EXPORT QUALIFIED + CurrentDrive, SelectDrive, + CurrentDirectory, ChangeDirectory, + MakeDir, RemoveDir, + ResetDiskSys, ResetDrive; + + +PROCEDURE CurrentDrive (VAR drive: CHAR); +(*- Returns the current default drive. +out: drive the default drive, given in character format. +*) + +PROCEDURE SelectDrive (drive: CHAR; VAR done: BOOLEAN); +(*- Set default drive. +in: drive name of drive to make default, specified in char format. +out: done TRUE if operation was successful. + +The default drive will be used by all routines referring to DK: . +*) + +PROCEDURE CurrentDirectory (drive: CHAR; VAR dir: ARRAY OF CHAR); +(*- Gets the current directory for the specified drive. +in: drive 0C for the current drive, 1C for drive "A", etc. +out: dir current directory for that drive. + +Under DOS 1.1, dir[0] will be set to nul (0C). +*) + +PROCEDURE ChangeDirectory (dir: ARRAY OF CHAR; VAR done: BOOLEAN); +(*- Set the current directory +in: dir drive and directory path name. +out: done TRUE if successful; FALSE if the directory does not exist. + +Under DOS 1.1, this function has no effect and 'done' is FALSE. +*) + +PROCEDURE MakeDir (dir: ARRAY OF CHAR; VAR done: BOOLEAN); +(*- Create a sub-directory +in: dir drive, optional pathname and name of sub-directory to create. +out: done TRUE if successful; FALSE if path or drive does not exist. + +Under DOS 1.1, this function has no effect and 'done' is FALSE. +*) + +PROCEDURE RemoveDir (dir: ARRAY OF CHAR; VAR done: BOOLEAN); +(*- Remove a directory +in: dir drive and name of the sub-directory to remove. +out: done: TRUE if successful; FALSE if directory does not exist. + +The specified directory must be empty or the procedure returns FALSE. +Under DOS 1.1, this function has no effect and 'done' is FALSE. +*) + +PROCEDURE ResetDiskSys; +(*- MS-DOS disk reset +*) + +PROCEDURE ResetDrive (d: CHAR): CARDINAL; +(* This function has no effect and always returns 255. It is part of this + definition module for reasons of compatibility with other implementations. +*) + +END DiskDirectory. + +It is part of this + definition module for reasons of compatibil \ No newline at end of file diff --git a/Logitech Modula-2 v1/DISKDIRE.LNK b/Logitech Modula-2 v1/DISKDIRE.LNK new file mode 100644 index 0000000..79b94f7 Binary files /dev/null and b/Logitech Modula-2 v1/DISKDIRE.LNK differ diff --git a/Logitech Modula-2 v1/DISKDIRE.REF b/Logitech Modula-2 v1/DISKDIRE.REF new file mode 100644 index 0000000..d6ad0c8 Binary files /dev/null and b/Logitech Modula-2 v1/DISKDIRE.REF differ diff --git a/Logitech Modula-2 v1/DISKDIRE.SYM b/Logitech Modula-2 v1/DISKDIRE.SYM new file mode 100644 index 0000000..e2c6ded Binary files /dev/null and b/Logitech Modula-2 v1/DISKDIRE.SYM differ diff --git a/Logitech Modula-2 v1/DISKFILE.DEF b/Logitech Modula-2 v1/DISKFILE.DEF new file mode 100644 index 0000000..ac88d83 --- /dev/null +++ b/Logitech Modula-2 v1/DISKFILE.DEF @@ -0,0 +1,40 @@ +DEFINITION MODULE DiskFiles; +(* + Interface to disk file functions of the underlying OS + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +[Private module of the Modula-2 system] +*) + + +FROM FileSystem IMPORT File; + +EXPORT QUALIFIED InitDiskSystem, + DiskFileProc, DiskDirProc; + + +PROCEDURE InitDiskSystem; +(*- Initialize mediums for further disk file operations + +This procedure has to be imported by FileSystem. This has the side-effect, +that this module is referenced and will therefore be linked to the user +program. +*) + +PROCEDURE DiskFilePROC (VAR f: File); +(*- low-level interface for disk operations within a file + +This procedure is passed as a parameter to the procedure CreateMedium in +FileSystem. +*) + +PROCEDURE DiskDirProc (VAR f: File; name: ARRAY OF CHAR); +(*- low-level interface for disk operations within a directory + +This procedure is passed as a parameter to the procedure CreateMedium in +FileSystem. +*) + +END DiskFiles. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/DISKFILE.LNK b/Logitech Modula-2 v1/DISKFILE.LNK new file mode 100644 index 0000000..ff498c6 Binary files /dev/null and b/Logitech Modula-2 v1/DISKFILE.LNK differ diff --git a/Logitech Modula-2 v1/DISKFILE.REF b/Logitech Modula-2 v1/DISKFILE.REF new file mode 100644 index 0000000..47129c4 Binary files /dev/null and b/Logitech Modula-2 v1/DISKFILE.REF differ diff --git a/Logitech Modula-2 v1/DISKFILE.SYM b/Logitech Modula-2 v1/DISKFILE.SYM new file mode 100644 index 0000000..7f6beee Binary files /dev/null and b/Logitech Modula-2 v1/DISKFILE.SYM differ diff --git a/Logitech Modula-2 v1/DISPLAY.DEF b/Logitech Modula-2 v1/DISPLAY.DEF new file mode 100644 index 0000000..56d9519 --- /dev/null +++ b/Logitech Modula-2 v1/DISPLAY.DEF @@ -0,0 +1,29 @@ +DEFINITION MODULE Display; +(* + Low-level Console Output + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +[Private module of the Modula-2 system] +*) + +EXPORT QUALIFIED Write; + + +PROCEDURE Write (ch: CHAR); +(*- Display a character on the console. +in: ch character to be displayed. + +The following codes are interpreted: + System.EOL (36C) = go to beginning of next line + ASCII.ff (14C) = clear screen and set cursor home + ASCII.del (177C) = erase the last character on the left + ASCII.bs (10C) = move 1 character to the left + ASCII.cr (15C) = go to beginning of current line + ASCII.lf (12C) = move 1 line down, same column +Write uses direct console I/O. +*) + +END Display. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/DISPLAY.LNK b/Logitech Modula-2 v1/DISPLAY.LNK new file mode 100644 index 0000000..b60d261 Binary files /dev/null and b/Logitech Modula-2 v1/DISPLAY.LNK differ diff --git a/Logitech Modula-2 v1/DISPLAY.MOD b/Logitech Modula-2 v1/DISPLAY.MOD new file mode 100644 index 0000000..28b4141 --- /dev/null +++ b/Logitech Modula-2 v1/DISPLAY.MOD @@ -0,0 +1,61 @@ +(* + Copyrigth (C) 1984 Logitech. All Rights Reserved. + + Permission is hereby granted to registered users to use or + abstract the following program in the implementation of + customized versions. This permission does not include the + right to redistribute the source code of this program. +*) +(*$T-*) +(*$R-*) +(******************************************************************) +(* *) +(* MODULA-2 / 86 Private module of the terminal sub-system *) +(* *) +(* DISPLAY: *) +(* IBM-PC under MSDOS 1.1 / 2.0 *) +(* History: *) +(* Dec 9, 82 First revision *) +(* April 83 Version 0.1 - 19.04.83 *) +(* Aug 83 Version 1.0 pass uninterpreted ctl-chars *) +(* Author: *) +(* Willy Steiger *) +(* LOGITECH SA. *) +(* CH-1143 Apples (Switzerland) *) +(* *) +(******************************************************************) + +IMPLEMENTATION MODULE Display; + FROM SYSTEM IMPORT DOSCALL; + + PROCEDURE Write (ch: CHAR); + (* the following code are interpreted: + 14C = FF, clear page, cursor home + 36C = EOL, go to beginning of next line (scrolls possibly) + 177C = DEL, backspace one char and clear it + *) + + BEGIN (* specifically for IBM-PC: *) + IF ch = 177C THEN (* Delete *) + DOSCALL (6, 10C); (* BackSpace *) + DOSCALL (6, ' '); + DOSCALL (6, 10C); (* BackSpace *) + ELSIF ch = 36C THEN (* EOL: end of line character in modula system *) + DOSCALL (6, 15C); + DOSCALL (6, 12C); + ELSIF ch = 14C THEN (* Form Feed: clear screen *) + (* Note: This sequence is not supported under DOS 1.1, nor is + * it interpreted by DOS 2.0 unless the ANSI Terminal features have + * been enabled with "DEVICE=ANSI.SYS" See Chapter 13 of the + * DOS 2.0 Manual. + *) + DOSCALL (6, 33C); + DOSCALL (6, '['); + DOSCALL (6, '2'); + DOSCALL (6, 'J'); + ELSE DOSCALL (6, ch); + END; + END Write; + +END Display. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/DISPLAY.REF b/Logitech Modula-2 v1/DISPLAY.REF new file mode 100644 index 0000000..46d795b Binary files /dev/null and b/Logitech Modula-2 v1/DISPLAY.REF differ diff --git a/Logitech Modula-2 v1/DISPLAY.SYM b/Logitech Modula-2 v1/DISPLAY.SYM new file mode 100644 index 0000000..a5b341c Binary files /dev/null and b/Logitech Modula-2 v1/DISPLAY.SYM differ diff --git a/Logitech Modula-2 v1/E.MOD b/Logitech Modula-2 v1/E.MOD new file mode 100644 index 0000000..640c973 --- /dev/null +++ b/Logitech Modula-2 v1/E.MOD @@ -0,0 +1,48 @@ +(*$S-*) +(*$R-*) +(*$T-*) + +MODULE e; + +FROM SYSTEM IMPORT WORD, BYTE, ADDRESS; +FROM NumberConversion IMPORT StringToCard; +FROM Strings IMPORT Assign; +FROM InOut IMPORT WriteLn, WriteInt, WriteCard, WriteString; + +CONST + DIGITS = 200; + +VAR + high, n, x : CARDINAL; + a : ARRAY [ 0..DIGITS ] OF CARDINAL; + +BEGIN + high := DIGITS; + x := 0; + + n := high - 1; + WHILE n > 0 DO + a[ n ] := 1; + n := n - 1; + END; + + a[ 1 ] := 2; + a[ 0 ] := 0; + + WHILE high > 9 DO + high := high - 1; + n := high; + WHILE 0 <> n DO + a[ n ] := x MOD n; + x := 10 * a[ n - 1 ] + x DIV n; + n := n - 1; + END; + + WriteCard( x, 0 ); + END; + + WriteLn; + WriteString( "done" ); + WriteLn; +END e. + diff --git a/Logitech Modula-2 v1/EXAMP1.MOD b/Logitech Modula-2 v1/EXAMP1.MOD new file mode 100644 index 0000000..e32b46c --- /dev/null +++ b/Logitech Modula-2 v1/EXAMP1.MOD @@ -0,0 +1,9 @@ +MODULE Examp1; + FROM Terminal IMPORT WriteString, WriteLn, Read; + VAR ch: CHAR; +BEGIN + WriteString('The program worked! (Hit a key)'); + WriteLn; + Read(ch); +END Examp1. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/EXAMP2.MOD b/Logitech Modula-2 v1/EXAMP2.MOD new file mode 100644 index 0000000..8590988 --- /dev/null +++ b/Logitech Modula-2 v1/EXAMP2.MOD @@ -0,0 +1,47 @@ +MODULE Examp2; (* Program Module to demonstrate basic file I/O *) + +IMPORT InOut; +FROM InOut IMPORT + OpenInput, OpenOutput, CloseInput, CloseOutput, Read, Write, EOL; +IMPORT Terminal; (* get qualified access to Terminal routines *) +IMPORT CardinalIO; + +CONST ESC = 33C; + +VAR Ch: CHAR; + LinesToCopy, LinesCopied: CARDINAL; + +BEGIN + (* Note that interaction with user is done via Terminal and CardinalIO, + * because InOut input/output is being redirected to files. + *) + REPEAT + Terminal.WriteString("enter input file:"); Terminal.WriteLn; + OpenInput(""); (* request input file, no default extension *) + UNTIL InOut.Done; (* keep trying until open is successful *) + REPEAT + Terminal.WriteString("Lines to copy> "); + CardinalIO.ReadCardinal(LinesToCopy); Terminal.WriteLn; + Terminal.Read(Ch); (* read terminator of ReadCardinal *) + UNTIL Ch <> ESC; (* keep asking until entry ends with ' ' or EOL *) + REPEAT + Terminal.WriteString("enter output file:"); Terminal.WriteLn; + OpenOutput(""); (* request output file, no default extension *) + UNTIL InOut.Done; + LinesCopied := 0; + LOOP + IF LinesCopied >= LinesToCopy THEN EXIT END; + Read(Ch); (* read from in file *) + IF NOT InOut.Done THEN EXIT END; (* check for EOF *) + Write(Ch); (* otherwise copy char *) + IF Ch = EOL THEN INC(LinesCopied) END; + END; (* LOOP *) + IF LinesCopied < LinesToCopy THEN + Terminal.WriteString("[Only "); + CardinalIO.WriteCardinal(LinesCopied,0); + Terminal.WriteString(" lines in file]"); Terminal.WriteLn; + END; + CloseOutput; + CloseInput; +END Examp2. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/FILEMESS.DEF b/Logitech Modula-2 v1/FILEMESS.DEF new file mode 100644 index 0000000..50e42e1 --- /dev/null +++ b/Logitech Modula-2 v1/FILEMESS.DEF @@ -0,0 +1,20 @@ +DEFINITION MODULE FileMessage; +(* + Write file status/response to the terminal +*) + +FROM FileSystem IMPORT Response; + +EXPORT QUALIFIED WriteResponse; + + +PROCEDURE WriteResponse (r: Response); +(*- Write a short description of a FileSystem response on the terminal. +in: r the response from some FileSystem operation. + +The actual argument for 'r' is typically the field 'res' of a variable +of type 'File'. The printed message is up to 32 characters long. +*) + +END FileMessage. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/FILEMESS.LNK b/Logitech Modula-2 v1/FILEMESS.LNK new file mode 100644 index 0000000..a2d7c8c Binary files /dev/null and b/Logitech Modula-2 v1/FILEMESS.LNK differ diff --git a/Logitech Modula-2 v1/FILEMESS.REF b/Logitech Modula-2 v1/FILEMESS.REF new file mode 100644 index 0000000..e71a3eb Binary files /dev/null and b/Logitech Modula-2 v1/FILEMESS.REF differ diff --git a/Logitech Modula-2 v1/FILEMESS.SYM b/Logitech Modula-2 v1/FILEMESS.SYM new file mode 100644 index 0000000..5e13afd Binary files /dev/null and b/Logitech Modula-2 v1/FILEMESS.SYM differ diff --git a/Logitech Modula-2 v1/FILENAME.DEF b/Logitech Modula-2 v1/FILENAME.DEF new file mode 100644 index 0000000..cce6cd5 --- /dev/null +++ b/Logitech Modula-2 v1/FILENAME.DEF @@ -0,0 +1,29 @@ +DEFINITION MODULE FileNames; +(* + Read a file specification from the terminal. + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +*) + +EXPORT QUALIFIED FNParts, FNPartSet, ReadFileName; + + TYPE FNParts = (FNDrive, FNPath, FNName, FNExt); + FNPartSet = SET OF FNParts; + + PROCEDURE ReadFileName(VAR resultFN: ARRAY OF CHAR; + defaultFN: ARRAY OF CHAR; + VAR ReadInName: FNPartSet); +(*- Read a file specification from terminal. +in: defaultFN default file specification, +out: resultFN the file specifications, + ReadInName which parts are in specification. + +Reads until a , blank, , or is typed. +After a call to ReadFileName, Terminal.Read must be called to +read the termination character. +The format of the specifications depends on the host operating system. +*) + +END FileNames. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/FILENAME.LNK b/Logitech Modula-2 v1/FILENAME.LNK new file mode 100644 index 0000000..b9bbc8a Binary files /dev/null and b/Logitech Modula-2 v1/FILENAME.LNK differ diff --git a/Logitech Modula-2 v1/FILENAME.REF b/Logitech Modula-2 v1/FILENAME.REF new file mode 100644 index 0000000..b2b6a23 Binary files /dev/null and b/Logitech Modula-2 v1/FILENAME.REF differ diff --git a/Logitech Modula-2 v1/FILENAME.SYM b/Logitech Modula-2 v1/FILENAME.SYM new file mode 100644 index 0000000..a3c7741 Binary files /dev/null and b/Logitech Modula-2 v1/FILENAME.SYM differ diff --git a/Logitech Modula-2 v1/FILESYST.DEF b/Logitech Modula-2 v1/FILESYST.DEF new file mode 100644 index 0000000..52529a1 --- /dev/null +++ b/Logitech Modula-2 v1/FILESYST.DEF @@ -0,0 +1,362 @@ +DEFINITION MODULE FileSystem; +(* + file manipulation routines + +Derived from the Modula-2 system developed by the +group of Prof. N. Wirth, ETH Zurich, Switzerland. +*) + + +FROM SYSTEM IMPORT ADDRESS, WORD; + +EXPORT QUALIFIED + (* file operations: *) + File, Response, Command, + Create, Close, Lookup, Rename, Delete, + SetRead, SetWrite, SetModify, SetOpen, + Doio, SetPos, GetPos, Length, + + (* Streamlike I/O: *) + Flag, FlagSet, + Reset, Again, + ReadWord, ReadChar, ReadByte, ReadNBytes, + WriteWord, WriteChar, WriteByte, WriteNBytes, + + (* Medium Handling: *) + FileProc, DirectoryProc, + MediumType, CreateMedium, RemoveMedium, + + FileNameChar; + + +TYPE MediumHint = CARDINAL; +(*- medium index used in DiskFiles *) + + MediumType = ARRAY [0..2] OF CHAR; +(*- medium name (A, B...) *) + + Flag = (er, ef, rd, wr, ag, txt); +(*- status flag for file operations + +er = error occured, ef = end-of-file reached, rd = in read mode, wr = in +write mode, ag = "Again" has been called after last read, txt = text-file +(the last access to the file was a 'WriteChar' or 'ReadChar'). +*) + + FlagSet = SET OF Flag; +(*- status flag set *) + + Response = (done, notdone, notsupported, callerror, unknownmedium, + unknownfile, paramerror, toomanyfiles, eom, userdeverror); +(*- result of a file operation *) + + Command = (create, close, lookup, rename, delete, setread, setwrite, + setmodify, setopen, doio, setpos, getpos, length); +(*- commands passed to DiskFiles *) + + BuffAdd = POINTER TO ARRAY [0..0FFFEH] OF CHAR; +(*- file buffer pointer type *) + + File = RECORD + bufa: BuffAdd; (* Buffer Address *) + buflength: CARDINAL; + (* size of buffer in bytes. In the current release + it is always a multiple of 128 *) + validlength: CARDINAL; + (* Number of valid bytes in the buffer. *) + bufind: CARDINAL; + (* Byte-Index of current position in the buffer *) + flags: FlagSet; (* status of the file *) + eof: BOOLEAN; + (* TRUE, if last access was past end of file *) + res: Response; (* result of last operation *) + lastRead:CARDINAL;(* the last read word or byte (char) *) + mt: MediumType; + (* selects the driver that supports that file *) + fHint: CARDINAL; (* internally used by the device-driver *) + mHint: MediumHint; (* internally used by medium-handler *) + CASE com: Command OF + lookup: new: BOOLEAN; + | setpos, getpos, length: highpos, lowpos: CARDINAL; + END; + END; +(*- file structure used for bookkeeping by DiskFiles *) + +PROCEDURE Create (VAR f: File; mediumName: ARRAY OF CHAR); +(*- create a temporary file +in: mediumName name of medium to create file on, in char format +out: f initialized file structure + +A temporary file is characterised by an empty name. To make the file +permanent, it has to be renamed with a non-empty name before closing it. +For subsequent operations on this file, it is referenced by "f". +*) + +PROCEDURE Close (VAR f: File); +(*- Close a file +in: f structure referencing an open file +out: f the field f.res will be set appropriately. + +Terminates the operations on file "f". If "f" is a temporary file, it will +be destroyed, whereas a file with a non-empty name remains on its medium +and is accessible through "Lookup". When closing a text-file after writing, +the end-of-file code 32C is written on the file (MS-DOS and CP/M convention). +*) + +PROCEDURE Lookup (VAR f: File; filename: ARRAY OF CHAR; newFile: BOOLEAN); +(*- look for a file +in: filename drive and name of file to search for + newFile TRUE if file should be created if not found +out: f initialized file structure; f.res will be set + appropriately. + +Searches the medium specified in "filename" for a file that matches the +name and type given in "filename". If the file is not found and "newFile" +is TRUE, a new (permanent) file with the given name and type is created. +If it is not found and "newFile" is FALSE, no action takes place and +"notdone" is returned in the result field of "f". +*) + +PROCEDURE Rename (VAR f: File; newname: ARRAY OF CHAR); +(*- rename a file +in: f structure referencing an open file + newname filename to rename to, with device:name.type specified +out: f file name in f will be changed and the f.res field will + be set appropriately. + +The medium, on which the files reside can not be changed with this command. +The medium name inside "newname" has to be the old one. +*) + +PROCEDURE Delete (name: ARRAY OF CHAR; VAR f: File); +(*- delete a file +in: name name of file to delete, with dev:name.type specified +out: f the result field f.res will be set appropriately. +*) + +PROCEDURE ReadWord (VAR f: File; VAR w: WORD); +(*- Returns the word at the current position in f +in: f structure referencing an open file +out: w word read from file + f the result field f.res will be set appropriately. + +the file will be positioned at the next word when the read is done. +*) + +PROCEDURE WriteWord (VAR f: File; w: WORD); +(*- Write one word to a file +in: f structure referencing an open file + w word to write +out: f the field f.res will be set appropriately. +*) + +PROCEDURE ReadChar (VAR f: File; VAR ch: CHAR); +(*- Read one character from a file +in: f structure referencing an open file +out: ch charatcter read from file + f the result field f.res will be set appropriately. + +the file will be positioned at the next character when the read is done. +*) + +PROCEDURE WriteChar (VAR f: File; ch: CHAR); +(*- Write one character to a file +in: f structure referencing an open file + ch character to write +out: f the result field f.res will be set apporopriately. +*) + +PROCEDURE ReadByte (VAR f: File; VAR b: CHAR); +(*- Read one byte from a file +in: f structure referencing an open file +out: b byte read from file + f the result field f.res will be set appropriately. + +the file will be positioned at the next byte when the read is completed. +*) + +PROCEDURE WriteByte (VAR f: File; b: CHAR); +(*- Write one byte to a file +in: f structure referencing an open file + b byte to write +out: f the result field f.res will be set appropriately. +*) + +PROCEDURE ReadNBytes (VAR f: File; bufPtr: ADDRESS; + requestedBytes: CARDINAL; VAR read: CARDINAL); +(*- Read a specified number of bytes from a file +in: f structure referencing an open file + bufPtr pointer to buffer area to read bytes into + requestedBytes number of bytes to read +out: bufPtr^ bytes read from file + f the result field f.res will be set appropriately. + read the number of bytes actually read. + +the file will be positioned at the next byte after the requested string. +*) + +PROCEDURE WriteNBytes (VAR f: File; bufPtr: ADDRESS; + requestedBytes: CARDINAL; VAR written: CARDINAL); +(*- Write a specified number of bytes to a file +in: f structure referencing an open file + bufPtr pointer to string of bytes to write + requestedBytes number of bytes to write +out: f the result field f.res will be set appropriately. + written the number of bytes actually written +*) + +PROCEDURE Again (VAR f: File); +(*- returns a character to the buffer to be read again +in: f structure referencing an open file +out: f the f.res field will be set appropriately. + +This should be called after a read operation only (it has no effect +otherwise). It prevents the subsequent read from reading the next element; +the element just read before will be returned a second time. Multiple calls +to Again without a read in between have the same effect as one call to +Again. The position in the file is undefined after a call to Again (it is +defined again after the next read operation). +*) + +PROCEDURE SetRead (VAR f: File); +(*- Set the file in reading-state, without changing the current position. +in: f structure referencing an open file +out: f f.res will be set appropriately. + +Upon calling SetRead, the current position must be before the eof. +In reading-state, no writing is allowed. +*) + +PROCEDURE SetWrite (VAR f: File); +(*- Sets the file in writing-state, without changing the current position. +in: f structure referencing an open file +out: f f.res will be set appropriately. + +Upon calling SetWrite, the current position must be a legal position in +the file (including eof). In writing-state, no reading is allowed, and +a write always takes place at the eof. The current implementation does +not truncate the file. +*) + +PROCEDURE SetModify (VAR f: File); +(*- Sets the file in modifying-state, without changing the current position. +in: f structure referencing an open file +out: f f.res will be set appropriately. +Upon calling SetModify, the current position must be before the eof. +In modifying-state, reading and writing are allowed. Writing is done +at the current position, overwriting whatever element is already there. +The file is not truncated. +*) + +PROCEDURE SetOpen (VAR f: File); +(*- Set the file to opened-state, without changing the current position. +in: f structure referencing an open file +out: f f.res will be set appropriately. + +The buffer content is written back on the file, if the file has been in +writing or modifying status. The new buffer content is undefined. +In opened-state, neither reading nor writing is allowed. +*) + +PROCEDURE Reset (VAR f: File); +(*- Set the file to opened state and position it to the top of file. +in: f structure referencing an open file +out: f f.res will be set appropriately. +*) + +PROCEDURE SetPos (VAR f: File; high, low: CARDINAL); +(*- Set the current position in file +in: f structure referencing an open file + high high part of the byte offset + low low part of the byte offset +out: f f.res will be set appropriately. + +The file will be positioned (high*2^16 +low) bytes from top of file. +*) + +PROCEDURE GetPos (VAR f: File; VAR high, low: CARDINAL); +(*- Return the current byte position in file +in: f structure referencing an open file +out: high high part of byte offset + low low part of byte offset + +The actual position is (high*2^16 +low) bytes from the top of file. +*) + +PROCEDURE Length (VAR f: File; VAR high, low: CARDINAL); +(*- Return the length of the file in bytes. +in: f structure referencing an open file. +out: high high part of byte offset + low ;pw part of byte offset + +The actual length is (high*2^16 +low) bytes. +*) + +PROCEDURE Doio (VAR f: File); +(*- Do various read/write operations on a file +in: f structure referencing an open file +out: f f.res will be set appropriately. + +The exact effect of this command depends on the state of the file (flags): + opened = NOOP. + reading = reads the record that contains the current byte from the + file. The old content of the buffer is not written back. + writing = the buffer is written back. It is then assigned to the + record, that contains the current position. Its content + is not changed. + modifying = the buffer is written back and the record containing + the current position is read. +Note that 'Doio' does not need to be used when reading through the +'stream-like' I/O routines. Its use is limited to special applications. +*) + + +PROCEDURE FileNameChar (c: CHAR): CHAR; +(*- Check the character c for legality in an MS-DOS filename. +in: c charater to check +out: 0C for illegal characters and c otherwise; lowercase + letters are transformed into uppercase letters. +*) + +TYPE FileProc = PROCEDURE (VAR File); +(*- Procedure type to be used for internal file operations + +A procedure of this type will be called for the functions: + setread, setwrite, setmodify, setopen, doio, + setpos, getpos, length, setprotect, getprotect, + setpermanent, getpermanent. +*) + + DirectoryProc = PROCEDURE (VAR File, ARRAY OF CHAR); +(*- Procedure type to be used for operations on an entire file + +A procedure of this type will be called for the functions: + create, close, lookup, rename, delete. +*) + +PROCEDURE CreateMedium (mt: MediumType; + fproc: FileProc; dproc: DirectoryProc; + VAR done: BOOLEAN); +(*- Install the medium "mt" in the file system +in: mt medium type to install + fproc procedure to handle internal file operations + dproc procedure to handle operations on an entire file +out done TRUE if medium was successfully installed. + +Before accessing or creating a file on a medium, this medium has to be +announced to the file system by means of the routine CreateMedium. +FileSystem calls "fproc" and "dproc" to perform operations on a file of +this medium. Up to 24 mediums can be announced. +*) + +PROCEDURE RemoveMedium (mt: MediumType; VAR done: BOOLEAN); +(*- Remove the medium "mt" from the file system +in: mt medium type to remove +out: done true if medium was successfully removed + +Attempts to access a file on this medium result in an error (unknownmedium). +*) + + +END FileSystem. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/FILESYST.LNK b/Logitech Modula-2 v1/FILESYST.LNK new file mode 100644 index 0000000..87c6317 Binary files /dev/null and b/Logitech Modula-2 v1/FILESYST.LNK differ diff --git a/Logitech Modula-2 v1/FILESYST.REF b/Logitech Modula-2 v1/FILESYST.REF new file mode 100644 index 0000000..8fbdbc4 Binary files /dev/null and b/Logitech Modula-2 v1/FILESYST.REF differ diff --git a/Logitech Modula-2 v1/FILESYST.SYM b/Logitech Modula-2 v1/FILESYST.SYM new file mode 100644 index 0000000..062cda8 Binary files /dev/null and b/Logitech Modula-2 v1/FILESYST.SYM differ diff --git a/Logitech Modula-2 v1/INIT.LOD b/Logitech Modula-2 v1/INIT.LOD new file mode 100644 index 0000000..d88df64 Binary files /dev/null and b/Logitech Modula-2 v1/INIT.LOD differ diff --git a/Logitech Modula-2 v1/INOUT.DEF b/Logitech Modula-2 v1/INOUT.DEF new file mode 100644 index 0000000..c9bbf4b --- /dev/null +++ b/Logitech Modula-2 v1/INOUT.DEF @@ -0,0 +1,158 @@ +DEFINITION MODULE InOut; +(* + Standard high-level formatted input/output + + +From the book 'Programming in Modula-2' by Prof. N. Wirth. +*) + + +FROM SYSTEM IMPORT WORD; +FROM FileSystem IMPORT File; +EXPORT QUALIFIED EOL, Done, in, out, termCH, + OpenInput, OpenOutput, CloseInput, CloseOutput, + Read, ReadString, ReadInt, ReadCard, ReadWrd, + Write, WriteLn, WriteString, WriteInt, WriteCard, + WriteOct, WriteHex, WriteWrd; + +CONST EOL = 36C; + +VAR Done: BOOLEAN; + (* Done is set by several procedures, TRUE if the + * operation was successful, FALSE otherwise. *) + termCH: CHAR; + (* terminating character from ReadString, ReadInt, ReadCard. *) + in, out: File; + (* The currently open input and output files, respectively. + * Use for exceptional cases only. *) + +PROCEDURE OpenInput(defext: ARRAY OF CHAR); +(*- Accept a file name from the terminal and open it for input. +in: defext default filetype or 'extension'. + +If the file name that is read ends with '.', then 'defext' is +appended to the file name. +If OpenInput succeeds, Done = TRUE and subsequent input is +taken from the file until CloseInput is called. +*) + +PROCEDURE OpenOutput(defext: ARRAY OF CHAR); +(*- Accept a file name from the terminal and open it for output. +in: defext default filetype or 'extension'. + +If the file name ends in '.', 'defext' is appended. +If OpenOutput succeeds, Done = TRUE and subsequent output is written +to the file until CloseOutput is called. +*) + +PROCEDURE CloseInput; +(*- Close current input file and revert to terminal for input. +*) + +PROCEDURE CloseOutput; +(*- Close current output file and revert to terminal for output. +*) + +PROCEDURE Read(VAR ch: CHAR); +(*- Read the next character from the current input. +out: ch the character read. (EOL for end-of-line.) + +Done = TRUE unless the input is at end of file. +*) + +PROCEDURE ReadString(VAR s: ARRAY OF CHAR); +(*- Read a string from the current input. +out: s the string that was read, excluding terminator. + +Leading blanks are accepted and thrown away, then characters +are read into 's' until a blank or control character is entered. +ReadString truncates the input string if it is too long for 's'. +The terminating character is left in 'termCH'. +If input is from the terminal, BS and DEL are allowed for editing. +*) + +PROCEDURE ReadInt(VAR x: INTEGER); +(*- Read an INTEGER representation from the current input. +out: x the value read. + +ReadInt is like ReadString, but the string is converted to an +INTEGER value if possible, using the syntax: ["+"|"-"] digit { digit }. +Done = TRUE if some conversion took place. +*) + +PROCEDURE ReadCard(VAR x: CARDINAL); +(*- Read an unsigned decimal number from the current input. +out: x the value read. + +ReadCard is like ReadInt, but the syntax is: digit { digit }. +*) + +PROCEDURE ReadWrd(VAR w: WORD); +(*- Read a WORD value from the current input. +out: w the value read. + +Done is TRUE if a WORD was read successfully. +(A WORD cannot be read from the terminal.) +Note that the meaning of WORD is system-dependent. +*) + +PROCEDURE Write(ch: CHAR); +(*- Write a character to the current output. +in: ch character to write. +*) + +PROCEDURE WriteLn; (*terminate line*) +(*- Write a new-line sequence to the current output. +*) + +PROCEDURE WriteString(s: ARRAY OF CHAR); +(*- Write a string to the current output. +in: s string to write. +*) + +PROCEDURE WriteInt(x: INTEGER; n: CARDINAL); +(*- Write an integer in right-justified decimal format. +in: x value to be output, + n minimum field width. + +The decimal representation of 'x' (including '-' if x is negative) +is output, using at least n characters (but more if needed). +Leading blanks are output if necessary. +*) + +PROCEDURE WriteCard(x,n: CARDINAL); +(*- Output a CARDINAL in decimal format. +in: x value to be output, + n minimum field width. + +The decimal representation of the value 'x' is output, using +at least n characters (but more if needed). Leading blanks are +output if necessary. +*) + +PROCEDURE WriteOct(x,n: CARDINAL); +(*- Output a CARDINAL in octal format. +in: x value to be output, + n minimum field width. +[see WriteCard above] +*) + +PROCEDURE WriteHex(x,n: CARDINAL); +(*- Output a CARDINAL in hexadecimal format. +in: x value to be output, + n minimum field width. + +Four uppercase hex digits are written, with leading blanks if +n > 4. +*) + +PROCEDURE WriteWrd(w: WORD); +(*- Output a WORD +in: w WORD value to be output. + +Note that the meaning of WORD is system-dependent, and that +WORDs cannot be written to the terminal. +*) + +END InOut. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/INOUT.LNK b/Logitech Modula-2 v1/INOUT.LNK new file mode 100644 index 0000000..9c39f6a Binary files /dev/null and b/Logitech Modula-2 v1/INOUT.LNK differ diff --git a/Logitech Modula-2 v1/INOUT.REF b/Logitech Modula-2 v1/INOUT.REF new file mode 100644 index 0000000..f41d9a3 Binary files /dev/null and b/Logitech Modula-2 v1/INOUT.REF differ diff --git a/Logitech Modula-2 v1/INOUT.SYM b/Logitech Modula-2 v1/INOUT.SYM new file mode 100644 index 0000000..4a5b556 Binary files /dev/null and b/Logitech Modula-2 v1/INOUT.SYM differ diff --git a/Logitech Modula-2 v1/INSTALL0.BAT b/Logitech Modula-2 v1/INSTALL0.BAT new file mode 100644 index 0000000..4fd6858 --- /dev/null +++ b/Logitech Modula-2 v1/INSTALL0.BAT @@ -0,0 +1,7 @@ +pause * Loading M2.EXE and examples onto current drive from drive B: * +copy b:m2.exe +copy b:examp*.mod +rem ****** BEFORE USING MODULA-2/86 PLEASE MAKE SURE THAT **************** +rem * You have a CONFIG.SYS file, and it includes 'FILES=12'. * +rem ********************************************************************** + \ No newline at end of file diff --git a/Logitech Modula-2 v1/INSTALL1.BAT b/Logitech Modula-2 v1/INSTALL1.BAT new file mode 100644 index 0000000..581b0b9 --- /dev/null +++ b/Logitech Modula-2 v1/INSTALL1.BAT @@ -0,0 +1,11 @@ +pause ** Creating Modula-2/86 directories on current drive ** +mkdir \m2lod +mkdir \m2lib +mkdir \m2lib\def +mkdir \m2lib\mod +mkdir \m2lib\sym +mkdir \m2lib\lnk +mkdir \m2lib\ref +mkdir \m2lib\map +rem ** Now execute INSTALL2 to load Modula-2 system from diskettes ** + \ No newline at end of file diff --git a/Logitech Modula-2 v1/INSTALL2.BAT b/Logitech Modula-2 v1/INSTALL2.BAT new file mode 100644 index 0000000..e5c4e00 --- /dev/null +++ b/Logitech Modula-2 v1/INSTALL2.BAT @@ -0,0 +1,2 @@ +copy a:installx.bat +installx \ No newline at end of file diff --git a/Logitech Modula-2 v1/INSTALLX.BAT b/Logitech Modula-2 v1/INSTALLX.BAT new file mode 100644 index 0000000..2e7d9a2 --- /dev/null +++ b/Logitech Modula-2 v1/INSTALLX.BAT @@ -0,0 +1,18 @@ +pause * Loading Modula-2/86 system onto current drive from drive A: * +pause Insert 'System' disk in drive A: +copy a:comppara.sym \m2lib\sym +copy a:*.def \m2lib\def +copy a:*.mod \m2lib\mod +pause Insert 'Compiler' disk in drive A: +copy a:*.lod \m2lod +copy a:*.sym \m2lib\sym +pause Insert 'Linker' disk in drive A: +copy a:*.lod \m2lod +copy a:*.lnk \m2lib\lnk +copy a:*.ref \m2lib\ref +rem ****** BEFORE USING MODULA-2/86 PLEASE MAKE SURE THAT **************** +rem * You have a CONFIG.SYS file, and it includes 'FILES=12' * +rem * You have an AUTOEXEC.BAT file, and it sets the search paths, * +rem * as described in the INSTALLATION section of the manual. * +rem ********************************************************************** +del installx.bat \ No newline at end of file diff --git a/Logitech Modula-2 v1/KEYBOARD.DEF b/Logitech Modula-2 v1/KEYBOARD.DEF new file mode 100644 index 0000000..9872a81 --- /dev/null +++ b/Logitech Modula-2 v1/KEYBOARD.DEF @@ -0,0 +1,30 @@ +DEFINITION MODULE Keyboard; +(* + Default driver for terminal input. + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +[Private module of the Modula-2 system] +*) + +EXPORT QUALIFIED Read, KeyPressed; + +PROCEDURE Read (VAR ch: CHAR); +(*- Read a character from the keyboard. +out: ch + +If necessary, Read waits for a character to be entered. +Characters that have been entered are returned immediately, +with no editing or buffering. + +- CTRL-C terminates the current program +- ASCII.cr is transformed into System.EOL +*) + +PROCEDURE KeyPressed (): BOOLEAN; +(*- Test if a character is available from the keyboard. +*) + +END Keyboard. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/KEYBOARD.LNK b/Logitech Modula-2 v1/KEYBOARD.LNK new file mode 100644 index 0000000..3aaaf98 Binary files /dev/null and b/Logitech Modula-2 v1/KEYBOARD.LNK differ diff --git a/Logitech Modula-2 v1/KEYBOARD.MOD b/Logitech Modula-2 v1/KEYBOARD.MOD new file mode 100644 index 0000000..18b888e --- /dev/null +++ b/Logitech Modula-2 v1/KEYBOARD.MOD @@ -0,0 +1,114 @@ +(* + Copyrigth (C) 1984 Logitech. All Rights Reserved. + + Permission is hereby granted to registered users to use or + abstract the following program in the implementation of + customized versions. This permission does not include the + right to redistribute the source code of this program. +*) +(*$T-*) +(*$R-*) +(*************************************************************) +(* *) +(* MODULA-2 / 86 Private Module of Terminal Sub-System *) +(* *) +(* Keyboard: *) +(* Reads the KBD, going through MSDOS *) +(* (direct console IO) *) +(* Version: *) +(* IBM-PC, MSDOS 1.1 / 2.0 *) +(* History: *) +(* Dec 6, 82 First revision *) +(* Feb 2, 84 V1.0 *) +(* Feb 28,84 access to command tail *) +(* Author: *) +(* Willy Steiger *) +(* LOGITECH SA. *) +(* CH-1143 Apples (Switzerland) *) +(* *) +(*************************************************************) + +IMPLEMENTATION MODULE Keyboard; + FROM SYSTEM IMPORT DOSCALL, SWI, SETREG, GETREG; + FROM System IMPORT Status, Terminate, EOL, RegAX, RegBX, RegCX; + + + CONST + CtrlC = 3C; + KBDCR = 15C; + + + PROCEDURE KeyPressed (): BOOLEAN; + (* Returns TRUE, if a character has been entered, + FALSE otherwise. + *) + VAR result: CARDINAL; + BEGIN + IF ti < tailc THEN + RETURN TRUE + END; + DOSCALL (11, result); + RETURN (result <> 0); + END KeyPressed; + + + PROCEDURE Read (VAR ch: CHAR); + (* Waits until a character has been entered and returns it. + If Ctrl-C is entered, the program is stopped. + CR is transformed into System.EOL. + *) + VAR ready: BOOLEAN; + BEGIN + IF ti < tailc THEN + ch := tail[ti]; + INC(ti) + ELSE + REPEAT + DOSCALL (6, 0FFH, ch, ready); + UNTIL ready; + END; + IF ch = CtrlC THEN Terminate (stopped); END; + IF ch = KBDCR THEN ch := EOL; + (* ASCII-cr is transformed in Modula-2 EOL character *) + END; + END Read; + + +TYPE PSP = RECORD + stuff: ARRAY [1..128] OF CHAR; + count: CHAR; (* really BYTE or SHORTCARD or whatever *) + text: ARRAY [0..127] OF CHAR + END; + +VAR PSPPtr: RECORD + CASE BOOLEAN OF + TRUE: addr: POINTER TO PSP; + | FALSE: offset,base: CARDINAL; + END; + END; + tail: ARRAY [0..127] OF CHAR; + tailc,ti: [0..128]; + +BEGIN + SETREG(RegAX,0026H); (* RTS(38) - get Program Segment Prefix Pointer *) + SWI(228); (* rts call *) + GETREG(RegBX,PSPPtr.offset); + GETREG(RegCX,PSPPtr.base); + WITH PSPPtr.addr^ DO + tailc := ORD(count); + FOR ti := 0 TO tailc DO + tail[ti] := text[ti] + END; (* FOR *) + END; (* WITH *) + ti := 0; + WHILE (ti < tailc) AND (tail[ti] = ' ') DO + INC(ti) (* skip leading blanks *) + END; + WHILE (ti < tailc) AND (tail[ti] <> ' ') DO + INC(ti) (* skip program name *) + END; + IF (ti < tailc) AND (tail[ti] = ' ') THEN + INC(ti) (* skip one blank *) + END; +END Keyboard. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/KEYBOARD.REF b/Logitech Modula-2 v1/KEYBOARD.REF new file mode 100644 index 0000000..4cadbc6 Binary files /dev/null and b/Logitech Modula-2 v1/KEYBOARD.REF differ diff --git a/Logitech Modula-2 v1/KEYBOARD.SYM b/Logitech Modula-2 v1/KEYBOARD.SYM new file mode 100644 index 0000000..64d8220 Binary files /dev/null and b/Logitech Modula-2 v1/KEYBOARD.SYM differ diff --git a/Logitech Modula-2 v1/LINK.LNK b/Logitech Modula-2 v1/LINK.LNK new file mode 100644 index 0000000..b2b17c9 Binary files /dev/null and b/Logitech Modula-2 v1/LINK.LNK differ diff --git a/Logitech Modula-2 v1/LINK.LOD b/Logitech Modula-2 v1/LINK.LOD new file mode 100644 index 0000000..66acbc9 Binary files /dev/null and b/Logitech Modula-2 v1/LINK.LOD differ diff --git a/Logitech Modula-2 v1/LISTER.LOD b/Logitech Modula-2 v1/LISTER.LOD new file mode 100644 index 0000000..bc68e1e Binary files /dev/null and b/Logitech Modula-2 v1/LISTER.LOD differ diff --git a/Logitech Modula-2 v1/LOADER.ASM b/Logitech Modula-2 v1/LOADER.ASM new file mode 100644 index 0000000..aed1d68 --- /dev/null +++ b/Logitech Modula-2 v1/LOADER.ASM @@ -0,0 +1,475 @@ +;********************************************************************** +; +; Copyrigth (C) 1984 Logitech. All Rights Reserved. +; +; Permission is hereby granted to registered users to use or +; abstract the following program in the implementation of +; customized versions. This permission does not include the +; right to redistribute the source code of this program. +; +; +; title 'Modula-2/86 Resident Loader' +; +; Author: Hugh McLarty +; +; Version: 0.0 03 August 83 +; 8308.06 converted to MSDOS +; +; Introduction: +; +; This module loads Modula-2/86 'LOD' files into memory. +; +code segment public +data segment public +DOS equ 21h +currentVersion equ 1 +targetSystem equ 0 +NameLength equ 24 ; bytes of module name +KeyLength equ 6 ; bytes of module key + + +MDescr struc +MDname db NameLength dup (?) ; module name +MDkey db KeyLength dup (?) ; key +MDproc dw ? ; offset of procedure table +MDcode dw ? ; base of code +MDdata dw ? ; base of data +MDprogid dw ? ; 'owner' program id +MDnext dd ? ; forward link +MDprev dd ? ; backward link +MDescr ends +MDSize equ size MDescr + +badStructure equ 1 +badVersion equ 2 +readEOF equ 3 +TooBig equ 4 ; not enough memory +badCheck equ 5 + +; Object Record Tags: +FormatVersion equ 0 +ProgramHeader equ 1 +SCModHeader equ 2 +ImportElement equ 3 +FilledData equ 4 +ProcedureCode equ 5 +SCModInitCode equ 6 +ModuleCode equ 7 +SCModuleCall equ 8 +RefExtData equ 9 +RefExtCode equ 10 +RefExtProc equ 11 +RefOwnData equ 12 +RefOwnCode equ 13 +RefOwnProc equ 14 +SCModuleEnd equ 15 +ProgramEnd equ 16 + + +LoadSP dw ? ; sp inside LoadProg +FileHandle dw ? +LdBufSize equ 512 +LdBuf db LdBufSize dup (?) ; read buffer +LdCnt dw ? ; bytes left in buffer +LowSum db ? ; low byte of checksum +HiSum db ? ; high byte of checksum +Checksum equ word ptr LowSum +CodeSize dw ? ; code size in paragraphs +DataSize dw ? ; data size in paragraphs +LdProgId dw ? ; id of loading program? +SCMcnt dw ? ; number of SCM's to load +ProgCodeBase dw ? ; base of program code segment +ProgDataBase dw ? ; base of program data segment +ModCodeBase dw ? ; base of module code segment +ModDataBase dw ? ; base of module data segment +StartOff dw ? ; start address of program, .. +StartBase dw ? ; .. offset and segment. +StartPtr equ dword ptr StartOff +MDoff dw ? +MDbase dw ? +MDptr equ dword ptr MDoff +PrevOff dw ? +PrevBase dw ? ; previous module descrip. (init NIL) +PrevPtr equ dword ptr PrevOff + +ModCodeSize dw ? +ModDataSize dw ? + +LdMCB dw 3 dup (?) ; Memory Control Block + even +data ends + +; LoadProg - load from file +; in: AX prog id to use +; BX file handle of already opened file +; CX:DX most recent entry in module 'tree' +; +; out: BX status +; ES:DI start address +; CX:DX last module entry added +; + public LoadProg + extrn Alloc_Mem:NEAR + assume CS:code,DS:data +LoadProg proc near + mov LdProgId,ax ; save prog id for module descriptors + mov LoadSP,sp ; save stack pointer + mov PrevBase,cx ; current 'top' of module table + mov PrevOff,dx + call InitInput ; initialize for reading from FCB + mov Checksum,0 ; reset checksum + call ReadFormatVersion + call ReadProgHdr + call AllocateProgMem ; allocate code, data, module table + call LoadSCM ; load first module + les bx,MDptr ; point to its descriptor + mov bx,ES:MDproc[bx] ; get offset to procedure table + mov ES,StartBase + mov ax,ES:word ptr 2[bx] ; get offset to procedure 0 + mov StartOff,ax ; which is offset of start address + dec SCMcnt ; more modules to load? + jz SCMend ; guess not. +SCMloop: + add MDoff,MDSize ; allocate a new module descriptor + call LoadSCM ; load one SCM + dec SCMcnt ; more? + jnz SCMloop ; yes, load them too (why not) +SCMend: call ReadProgEnd ; process ProgramEnd + les di,StartPtr + mov cx,MDbase + mov dx,MDoff ; pointer to last module entry + xor bx,bx ; if no error, return BX=0 +LoadFU: mov sp,LoadSP ; reset stack pointer + ret +LoadProg endp + + +ReadFormatVersion proc near + call GetByte ; record tag + cmp al,FormatVersion + je RFV2 + mov bx,badStructure + jmp LoadFU +; +RFV2: call GetByte ; object file format + cmp al,currentVersion + je RFV4 ; right version + mov bx,badVersion + jmp LoadFU +; +RFV4: call GetByte ; read target system + cmp al,targetSystem + je RFV6 + mov bx,badVersion + jmp LoadFU +; +RFV6: jmp CheckChecksum +ReadFormatVersion endp + + +ReadProgHdr proc near + call GetByte + cmp al,ProgramHeader + je RPH2 + mov bx,badStructure + jmp LoadFU +; +RPH2: call GetWord + mov CodeSize,ax + call GetWord + mov DataSize,ax + call GetWord + mov SCMcnt,ax + jmp CheckChecksum +ReadProgHdr endp + +AllocateProgMem proc near + mov ax,MDSize ; size of a module descriptor + mul SCMcnt ; times number of modules.. + add ax,15 + mov cl,4 + shr ax,cl ; convert to paragraphs + add ax,CodeSize ; add paragraphs of code.. + add ax,DataSize ; and paragraphs of data + call Alloc_Mem ; allocate memory, base => AX + test bx,bx ; got it? + jz GotMem ; yes + mov bx,TooBig ; nope. + jmp LoadFU +; +GotMem: mov ProgCodeBase,ax ; start of code segment + mov ModCodeBase,ax ; start of first module + mov StartBase,ax ; save base of start address + add ax,CodeSize + mov ProgDataBase,ax ; start of data segment + mov ModDataBase,ax ; data of first module + add ax,DataSize + mov MDbase,ax ; base of module descriptor table + mov MDoff,0 ; initial offset + ret +AllocateProgMem endp + + +; LoadSCM - load one module +; +LoadSCM proc near + call ReadSCMHdr + call GetByte ; next field tag.. + cmp al,ModuleCode ; ModuleCode record? + je LdSCM2 ; yes + mov bx,badStructure + jmp LoadFU +; +LdSCM2: call RestModCode ; yes, process rest of record + call ReadFixups ; process rest of module (fixups & end) + ret +LoadSCM endp + + +; ReadSCMhdr - process an SCModHeader record +; out: ModName module name +; ModKey module key +ReadSCMhdr proc near + call GetByte + cmp al,SCModHeader + je RSCMH2 + mov bx,badStructure + jmp LoadFU +; +RSCMH2: les di,MDptr + mov ax,ModCodeBase + mov ES:MDcode[di],ax ; code-base for this module + mov ax,ModDataBase + mov ES:MDdata[di],ax ; data base for this module + mov ax,LdProgId + mov ES:MDprogid[di],ax ; owner-program id for this module +;;;;;;;;add di,offset MDname ; DOESN'T WORK!!! + MOV AX, OFFSET MDname + ADD DI, AX + mov ax,NameLength + call GetNBytes ; read module name + les di,MDptr +;;;;;;;;add di,offset MDkey ; DOESN'T WORK + MOV AX, OFFSET MDkey + ADD DI, AX + mov ax,KeyLength + call GetNBytes ; read module key + call GetWord + les di,MDptr + mov ES:MDproc[di],ax ; offset of procedure table + call GetWord + mov ModCodeSize,ax ; bytes of code + call GetWord + mov ModDataSize,ax ; bytes of data + call GetWord ; (internal use by compiler) + jmp CheckChecksum +ReadSCMhdr endp + + +; RestModCode - read the rest of a ModuleCode record +; (called after the tag has been read) +RestModCode proc near + call GetWord ; length of code (bytes) + mov ES,ModCodeBase ; base + mov di,0 ; offset + call GetNBytes ; read AX bytes at ES:0000 + jmp CheckChecksum +RestModCode endp + + +; ReadFixups - process fixup records until SCModuleEnd record is processed +; +ReadFixups proc near + call GetByte + cmp al,RefOwnCode + jne RFIX2 + call GetWord ; offset of fixup (current module) + push ax + call GetWord ; 'bias' (paragraphs from codebase) + add ax,ProgCodeBase ; compute fixup value + pop bx ; fixup offset.. + mov ES,ModCodeBase ; fixup base: current module + mov ES:[bx],ax + call CheckChecksum + jmp short ReadFixups +; +RFIX2: cmp al,SCModuleEnd + je RFIX4 + mov bx,badStructure + jmp LoadFU +; end of module: +RFIX4: mov ax,ModCodeSize ; adjust base-of-module-code + add ax,15 ; paragraph pointer by size + mov cl,4 ; of module code, rounded up + shr ax,cl ; and converted to paragraphs. + add ModCodeBase,ax + mov ax,ModDataSize + add ax,15 + mov cl,4 + shr ax,cl + add ModDataBase,ax + call LinkModuleDescriptor + jmp CheckChecksum +ReadFixups endp + +LinkModuleDescriptor proc near + les di,PrevPtr + cmp di,0Fh + jne LMD2 + mov ax,ES + cmp ax,0FFFFh + je LMD4 ; IF PrevPtr <> NIL THEN.. +LMD2: mov ax,MDoff + mov ES:MDnext[di],ax + mov ax,MDbase + mov ES:MDnext+2[di],ax ; PrevPtr^.next := MDptr +LMD4: les di,MDptr ; END + mov ES:MDnext[di],0Fh + mov ES:MDnext+2[di],0FFFFh ; MDptr^.next := NIL + mov ax,PrevOff + mov ES:MDprev[di],ax + mov ax,PrevBase + mov ES:MDprev+2[di],ax ; MDptr^.prev := PrevPtr + mov PrevOff,di + mov PrevBase,ES ; PrevPtr := MDptr + ret +LinkModuleDescriptor endp + +ReadProgEnd proc near + call GetByte + cmp al,ProgramEnd + je RPE2 + mov bx,badStructure + jmp LoadFU +; +RPE2: jmp CheckChecksum +ReadProgEnd endp + +; GetWord - get next word from object record (update checksum) +; out: AX data word +; BX status/error code +; set for BX +GetWord proc near + call GetByte ; read lo byte + mov ah,al + call GetByte ; read hi byte + xchg ah,al ; shuffle into position + ret +GetWord endp + + +; GetNBytes - get multiple bytes into memory (with Checksum) +; in: AX byte count (must be > 0!) +; ES:DI where to put the bytes +; out: CX =0 +; ES:DI points past last byte read +GetNBytes proc near + mov cx,ax + mov dx,Checksum ; move checksum into reg for speed +NBcont: mov bx,LdCnt ; ditto for bytes-left-in-buffer + cld ; make sure direction flag is forward + xor ah,ah ; extend each byte to cardinal +NBytes: lodsb ; fetch next byte from buffer + sub bx,1 + jc NBfill ; refill buffer + add dx,ax ; update checksum + stosb ; place byte into memory + loop NBytes ; and repeat N times + mov LdCnt,bx ; bring memory variables up to date + mov Checksum,dx + ret +; +NBfill: call ReadSeq ; read next buffer sequentially + jmp short NBcont +GetNBytes endp + +; GetByte - get next byte from object record (updates checksum) +; out: AL data byte +; BX status/error code +; note: CX, DX, DI, ES preserved +GetByte proc near + call ReadByte ; read one raw + add LowSum,al ; update checksum + adc HiSum,0 + ret +GetByte endp + +CheckChecksum proc near + call ReadWord ; read record checksum field + cmp ax,Checksum ; checksum checks? + jne Struct ; no + ret +; +Struct: mov bx,badCheck ; no + jmp LoadFU ; short-circuit exit +CheckChecksum endp + + +ReadWord proc near + call ReadByte ; read low byte + mov ah,al ; save it + call ReadByte ; read high byte + xchg ah,al ; swap into position + ret +ReadWord endp + + +; ReadByte - get next raw byte from input file +; out: AL next byte +; BX status/error code +; note: AH, CX, DX, DI, ES preserved +; +ReadByte proc near + cld + lodsb ; yes: pull next byte from buffer + sub LdCnt,1 ; anything left in buffer? + jc ReadB2 ; no, refill buffer + ret +; +ReadB2: call ReadSeq + jmp short ReadByte ; try again +ReadByte endp + + +InitInput proc near + mov FileHandle,bx +InitInput endp ; fall through to read first block +; ReadSeq - read next sequential block into buffer +; +; out: BX status/error code +; SI points to start of buffer +; LdCnt number of bytes read +; note: AX, CX, DX, DI, ES are preserved +ReadSeq proc near + push ax ; just to be polite + push cx + push dx + push di + push ES + push DS + mov bx,FileHandle + mov cx,LdBufSize + mov dx,offset LdBuf + mov ah,3FH + int DOS ; sequential read + pop DS + cmp ax,LdBufSize ; full record? + je RstBuf ; yes + cmp ax,0 ; partial record? + jne RstBuf ; yes + mov bx,readEOF ; no, EOF, which should never happen! + jmp LoadFU +; +RstBuf: mov si,offset LdBuf ; reset buffer scanner + mov LdCnt,LdBufSize ; and buffer count + pop ES + pop di + pop dx + pop cx + pop ax + ret +ReadSeq endp + +code ends + end + \ No newline at end of file diff --git a/Logitech Modula-2 v1/M2.EXE b/Logitech Modula-2 v1/M2.EXE new file mode 100644 index 0000000..f954c75 Binary files /dev/null and b/Logitech Modula-2 v1/M2.EXE differ diff --git a/Logitech Modula-2 v1/M2COMP.LNK b/Logitech Modula-2 v1/M2COMP.LNK new file mode 100644 index 0000000..0279241 Binary files /dev/null and b/Logitech Modula-2 v1/M2COMP.LNK differ diff --git a/Logitech Modula-2 v1/M2COMP.LOD b/Logitech Modula-2 v1/M2COMP.LOD new file mode 100644 index 0000000..2ce9171 Binary files /dev/null and b/Logitech Modula-2 v1/M2COMP.LOD differ diff --git a/Logitech Modula-2 v1/M2DBUG.LOD b/Logitech Modula-2 v1/M2DBUG.LOD new file mode 100644 index 0000000..a9d2396 Binary files /dev/null and b/Logitech Modula-2 v1/M2DBUG.LOD differ diff --git a/Logitech Modula-2 v1/M2LINK.LOD b/Logitech Modula-2 v1/M2LINK.LOD new file mode 100644 index 0000000..62e6a46 Binary files /dev/null and b/Logitech Modula-2 v1/M2LINK.LOD differ diff --git a/Logitech Modula-2 v1/MATHLIB0.DEF b/Logitech Modula-2 v1/MATHLIB0.DEF new file mode 100644 index 0000000..813190c --- /dev/null +++ b/Logitech Modula-2 v1/MATHLIB0.DEF @@ -0,0 +1,41 @@ +DEFINITION MODULE MathLib0; +(* + Real Math Functions + + +From the book 'Programming in Modula-2' by Prof. N. Wirth. +*) + + +EXPORT QUALIFIED sqrt, exp, ln, sin, cos, arctan, real, entier; + + +PROCEDURE sqrt(x: REAL): REAL; +(* x must be positive *) + +PROCEDURE exp(x: REAL): REAL; +(* returns e^x where e = 2.71828.. *) + +PROCEDURE ln(x: REAL): REAL; +(* returns natural logarithm with base e = 2.71828.. of x *) +(* x must be positive and not zero *) + +PROCEDURE sin(x: REAL): REAL; +(* returns sin(x) where x is given in radians *) + +PROCEDURE cos(x: REAL): REAL; +(* returns cos(x) where x is given in radians *) + +PROCEDURE arctan(x: REAL): REAL; +(* returns arctan(x) in radians *) + +PROCEDURE real(x: INTEGER): REAL; +(* type conversion from INTEGER to REAL *) + +PROCEDURE entier(x: REAL): INTEGER; +(* returns the integral part of x. *) +(* If this cannot be represented in an INTEGER, *) +(* the result is undefined. *) + +END MathLib0. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/MATHLIB0.LNK b/Logitech Modula-2 v1/MATHLIB0.LNK new file mode 100644 index 0000000..5e7a401 Binary files /dev/null and b/Logitech Modula-2 v1/MATHLIB0.LNK differ diff --git a/Logitech Modula-2 v1/MATHLIB0.REF b/Logitech Modula-2 v1/MATHLIB0.REF new file mode 100644 index 0000000..11122c9 Binary files /dev/null and b/Logitech Modula-2 v1/MATHLIB0.REF differ diff --git a/Logitech Modula-2 v1/MATHLIB0.SYM b/Logitech Modula-2 v1/MATHLIB0.SYM new file mode 100644 index 0000000..2855bcb Binary files /dev/null and b/Logitech Modula-2 v1/MATHLIB0.SYM differ diff --git a/Logitech Modula-2 v1/MEMORY.PMD b/Logitech Modula-2 v1/MEMORY.PMD new file mode 100644 index 0000000..07abfe0 Binary files /dev/null and b/Logitech Modula-2 v1/MEMORY.PMD differ diff --git a/Logitech Modula-2 v1/NUMBERCO.DEF b/Logitech Modula-2 v1/NUMBERCO.DEF new file mode 100644 index 0000000..4c939f3 --- /dev/null +++ b/Logitech Modula-2 v1/NUMBERCO.DEF @@ -0,0 +1,106 @@ +DEFINITION MODULE NumberConversion; +(* + Conversion between numbers and strings + + + The routines that convert a string to a number: + - skip leading blanks, + - accept always a '+' sign and for integers + also a '-' sign + - skip blanks between sign and number + Done is TRUE if the conversion is successful + The routines that convert a number to a string: + - if the string is too small the number is truncated + - if the number has less digits than width,leading + blanks are added +*) + +EXPORT QUALIFIED MaxBase, BASE, + StringToCard, StringToInt, StringToNum, + CardToString, IntToString, NumToString; + +CONST MaxBase = 16; + +TYPE BASE = [2..MaxBase]; + + +PROCEDURE StringToCard( + str: ARRAY OF CHAR; + VAR num: CARDINAL; + VAR done: BOOLEAN + ); +(*- Convert a string to a CARDINAL number. +in: str string to convert +out: num converted number + done TRUE if successful conversion, + FALSE if number out of range, + or contents of string non numeric. +*) + +PROCEDURE StringToInt( + str: ARRAY OF CHAR; + VAR num: INTEGER; + VAR done: BOOLEAN + ); +(*- Convert a string to an INTEGER number. +in: str string to convert +out: num converted number + done TRUE if successful conversion, + FALSE if number out of range, + or contents of string non numeric. +*) + +PROCEDURE StringToNum( + str: ARRAY OF CHAR; + base: BASE; + VAR num: CARDINAL; + VAR done: BOOLEAN + ); +(*- Convert a string to a CARDINAL number. +in: str string to convert + base the base of the number represented in the string +out: num converted number + done TRUE if successful conversion, + FALSE or number out of range, + or contents of string not within base. +*) + +PROCEDURE CardToString( + num: CARDINAL; + VAR str: ARRAY OF CHAR; + width: CARDINAL + ); +(*- Convert a CARDINAL number to a string. +in: num number to convert +out: str returned string representation of the number +in: width width of the returned string +*) + +PROCEDURE IntToString( + num: INTEGER; + VAR str: ARRAY OF CHAR; + width: CARDINAL + ); +(*- Convert an INTEGER number to a string. + +in: num number to convert +out: str returned string representation of the number +in: width width of the returned string +*) + +PROCEDURE NumToString( + num: CARDINAL; + base: BASE; + VAR str: ARRAY OF CHAR; + width: CARDINAL + ); +(*- Convert a number to the string representation in the specified base. + +in: num number to convert +in: base the base of conversion +out: str returned string representation of the number +in: width width of the returned string +*) + +END NumberConversion. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/NUMBERCO.LNK b/Logitech Modula-2 v1/NUMBERCO.LNK new file mode 100644 index 0000000..752a6a1 Binary files /dev/null and b/Logitech Modula-2 v1/NUMBERCO.LNK differ diff --git a/Logitech Modula-2 v1/NUMBERCO.REF b/Logitech Modula-2 v1/NUMBERCO.REF new file mode 100644 index 0000000..0fa617d Binary files /dev/null and b/Logitech Modula-2 v1/NUMBERCO.REF differ diff --git a/Logitech Modula-2 v1/NUMBERCO.SYM b/Logitech Modula-2 v1/NUMBERCO.SYM new file mode 100644 index 0000000..5a0c4a5 Binary files /dev/null and b/Logitech Modula-2 v1/NUMBERCO.SYM differ diff --git a/Logitech Modula-2 v1/OPTIONS.DEF b/Logitech Modula-2 v1/OPTIONS.DEF new file mode 100644 index 0000000..bf686c6 --- /dev/null +++ b/Logitech Modula-2 v1/OPTIONS.DEF @@ -0,0 +1,52 @@ +DEFINITION MODULE Options; +(* + Read a file specification, with options, from the terminal + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +*) + + EXPORT QUALIFIED NameParts, NamePartSet, Termination, + FileNameAndOptions, GetOption; + + + TYPE Termination = (norm, empty, can, esc); + NameParts = (NameDrive, NamePath, NameName, NameExt); + NamePartSet = SET OF NameParts; + +PROCEDURE FileNameAndOptions(default: ARRAY OF CHAR; + VAR name: ARRAY OF CHAR; + VAR term: Termination; + acceptOption: BOOLEAN; + VAR ReadInName: NamePartSet); +(*- Read file name and options from terminal. +in: default the file specification to use if one is not entered, + acceptOption if TRUE, allow options to be entered, +out: name the file specification, + term how the read ended, + ReadInName which parts of specification are present. + +'term' returns the status of the input termination: + norm : normally terminated + empty : normally terminated, but name is empty + can : is typed, input line cancelled + esc : is typed, no file specified. + +Input is terminated by a , blank, , or . + and are allowed while entering the file name. +*) + + +PROCEDURE GetOption(VAR optStr: ARRAY OF CHAR; VAR length: CARDINAL); +(*- Get another option from the last call to FileNameAndOptions. +out: optStr text of the option, + length length of optStr. + +Calls to GetOption return the options from the last call to +FileNameAndOptions, in the order they were entered. When there are +no more options, a length of 0 is returned. +*) + +END Options. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/OPTIONS.LNK b/Logitech Modula-2 v1/OPTIONS.LNK new file mode 100644 index 0000000..ec6a999 Binary files /dev/null and b/Logitech Modula-2 v1/OPTIONS.LNK differ diff --git a/Logitech Modula-2 v1/OPTIONS.REF b/Logitech Modula-2 v1/OPTIONS.REF new file mode 100644 index 0000000..091fb08 Binary files /dev/null and b/Logitech Modula-2 v1/OPTIONS.REF differ diff --git a/Logitech Modula-2 v1/OPTIONS.SYM b/Logitech Modula-2 v1/OPTIONS.SYM new file mode 100644 index 0000000..475d7e8 Binary files /dev/null and b/Logitech Modula-2 v1/OPTIONS.SYM differ diff --git a/Logitech Modula-2 v1/PASS1.LOD b/Logitech Modula-2 v1/PASS1.LOD new file mode 100644 index 0000000..97e546a Binary files /dev/null and b/Logitech Modula-2 v1/PASS1.LOD differ diff --git a/Logitech Modula-2 v1/PASS2.LOD b/Logitech Modula-2 v1/PASS2.LOD new file mode 100644 index 0000000..bea965b Binary files /dev/null and b/Logitech Modula-2 v1/PASS2.LOD differ diff --git a/Logitech Modula-2 v1/PASS3.LOD b/Logitech Modula-2 v1/PASS3.LOD new file mode 100644 index 0000000..461b32b Binary files /dev/null and b/Logitech Modula-2 v1/PASS3.LOD differ diff --git a/Logitech Modula-2 v1/PASS4.LOD b/Logitech Modula-2 v1/PASS4.LOD new file mode 100644 index 0000000..cf83690 Binary files /dev/null and b/Logitech Modula-2 v1/PASS4.LOD differ diff --git a/Logitech Modula-2 v1/PMD.ASM b/Logitech Modula-2 v1/PMD.ASM new file mode 100644 index 0000000..ba4d84a --- /dev/null +++ b/Logitech Modula-2 v1/PMD.ASM @@ -0,0 +1,338 @@ +;****************************************************** +; +; Copyrigth (C) 1984 Logitech. All Rights Reserved. +; +; Permission is hereby granted to registered users to use or +; abstract the following program in the implementation of +; customized versions. This permission does not include the +; right to redistribute the source code of this program. +; +; +; Modula-2/86 Run Time Support package +; +; PMD.ASM - Post Mortem Dump module +; +; + + include RTS.INC + +code segment public + extrn RTS_DS:word ; really belongs here! + extrn GET_CURR_DISK:near + extrn SELECT_DISK:near + extrn DELETE_FILE:near + extrn MAKE_FILE:near + extrn SET_DEFAULT_DMA:near + extrn NORM_ADDR:near + extrn SEQ_WRITE:near + extrn CLOSE_FILE:near + extrn DELETE_FILE:near + extrn WRITE_LN:near + extrn WRITE_MSG:near + +data segment public + +; Variables for Post Mortem Dump: +DUMP_NAME DB 'MEMORY.PMD',0 +NO_DUMP DB 'Post Mortem Dump failed', 0DH,0AH, '$' +PARAG_IN_REC DB 0 ; paragraph counter for PMD + even +DUMP_LOW_START dw ? ; first paragraph of 'low' dump area +DUMP_LOW_END dw ? ; last paragraph of same +DUMP_HIGH_START dw ? +DUMP_HIGH_END dw ? +TEMP_W dd ? + + extrn START_MEM:word, MEM_SIZE:word + extrn SAVED_DISK:byte + extrn RTS_DISK:byte + extrn CUR_PROCESS:byte ;:ProcessDescriptor + extrn RTS_PROCESS:byte ;:ProcessDescriptor + extrn CUR_P_PTR:dword + extrn FILE_HANDLE:word + extrn FILE_SPEC:byte +data ends + + public P_M_DUMP + assume CS:code, DS:data + +P_M_DUMP proc NEAR +;======== + ; Entry point for Post Mortem Dump + ; When arriving here, we assume the relevant + ; registers to be saved in the process descriptor. + ; Before dumping memory, we are going to + ; write the copy of the P.D. back into the + ; workspace of the process: + Les di, CUR_P_PTR + Mov si, offset CUR_PROCESS + Mov cx, (size ProcessDescriptor)/2 + Rep Movsw + + ; Now, we create the file on the same disk + ; where the resident part was found. Therefore, + ; we have first to save the currrent disk: + call GET_CURR_DISK + + ; set up the filespec: + MOV AL, RTS_DISK + add al,'A' + PUSH DS + POP ES + MOV SI, OFFSET DUMP_NAME + MOV DI, offset FILE_SPEC + mov byte ptr[di],al + inc di + mov byte ptr[di],':' + inc di + MOV CX, 11 ; Drive, Name, Typ and Extent + REP MOVSB + + CALL DELETE_FILE ; Delete the old DUMP-file + CALL MAKE_FILE ; and create the new-one + JNB D_FILE_MADE ; yes + JMP AFTER_DUMP ; no, dump fails +D_FILE_MADE: + mov FILE_HANDLE,ax + CALL SET_DEFAULT_DMA +; Fill the header record: + MOV AX, 0 ; First fill with zeroes + MOV DI, DEFAULT_DMA + PUSH DS + POP ES + MOV CX, 64 + REP STOSW + ; Now put the info required by the debugger: + MOV DI, DEFAULT_DMA + ; addr of MAIN process descr: + MOV word ptr [DI], OFFSET RTS_PROCESS + MOV word ptr 2[DI], DS + ; addr of descriptor of terminating process: + LES SI, CUR_P_PTR + MOV [DI]+4, SI + MOV [DI]+6, ES + ; start and end of interrupt vector table: + MOV WORD PTR [DI]+16, 0 + MOV WORD PTR [DI]+18, 3FH + ; paragraph address of RESIDENT: + mov ax, RTS_DS + mov DUMP_LOW_START, ax + mov [di]+20, ax + ; end of lower memory area: + MOV BX, RTS_PROCESS.PD_HEAP_TOP + 2 + MOV AX, RTS_PROCESS.PD_HEAP_TOP + CALL NORM_ADDR + INC BX ; next paragraph + MOV DUMP_LOW_END, BX ; just save it + MOV [DI]+22, BX ; top of main heap (parag) + ; start of higher memory area: + MOV BX, RTS_PROCESS.PD_SS + MOV AX, RTS_PROCESS.PD_SP + CALL NORM_ADDR + MOV DUMP_HIGH_START, BX ; just save it + MOV [DI]+24, BX ; top of main stack (parag) + ; last paragraph of memory: + mov bx, START_MEM + dec bx + add bx, MEM_SIZE + MOV DUMP_HIGH_END, BX ; just save it + MOV [DI]+26, BX + + ; Send the first record to the file: + CALL SEQ_WRITE + CMP AL, 80H + JNE DUMP_BAD + + ; Now dump the memory: + ; We dump 3 memory areas: the interrupt vectors (0..3FFH), the 'low' + ; memory from start of RESIDENT to heaptop of main and the 'high' + ; memory starting at stacktop of main to end of memory. + ; These 3 areas are dumped paragraph-wise. + MOV PARAG_IN_REC, 0 ; counter = 0 + MOV CX, 0 ; start of first area + MOV BX, 03FH ; end of first area + CALL DUMP_PART + CMP AL, 0 + JNE DUMP_BAD ; there was an error + MOV CX, DUMP_LOW_START ; start of second area + MOV BX, DUMP_LOW_END ; end of second area + CALL DUMP_PART + CMP AL, 0 + JNE DUMP_BAD ; there was an error + MOV CX, DUMP_HIGH_START ; start of third area + MOV BX, DUMP_HIGH_END ; end of third area + CALL DUMP_PART + CMP AL, 0 + JNE DUMP_BAD ; there was an error + CMP PARAG_IN_REC, 0 + JE CLOSE_DUMP + CALL SET_DEFAULT_DMA ; We have to write the buffer + CALL SEQ_WRITE + CMP AL, 80H + JNE DUMP_BAD + +CLOSE_DUMP: + MOV AX, 0 ; to indicate 'no error' +DUMP_BAD: + PUSH AX + ; Close the file: + CALL CLOSE_FILE + POP AX + +AFTER_DUMP: + ; Dump is made. AX contains 0 for successfull + ; dump and > 0 if an error occured: + CMP AX, 0 + JE DUMP_OK + CALL WRITE_LN + MOV DX, OFFSET NO_DUMP + CALL WRITE_MSG + CALL DELETE_FILE +DUMP_OK: + ; Restore the disk of before the dump: + MOV DL, SAVED_DISK + CALL SELECT_DISK + RET +P_M_DUMP endp + +DUMP_PARTIAL_REC proc NEAR + ; The variable 'PARAG_IN_REC' gives the number of paragraphs that + ; are already in the record at CPM_DMA. It is updated here. + ; AX holds the number of paragraphs to dump at entry and the + ; remaining-ones at exit. + ; CX is paragraph address of memory to dump and is updated here. + ; When the record can be filled completely, it is written to the + ; file (DEFAULT_FCB). BL returns 0 if no error, 0FFH otherwise. + CMP AX, 8 + JB DO_PARTIAL_DUMP + JZ GOOD_PARTIAL_DUMP + ; nothing to dump + CMP PARAG_IN_REC, 0 + JZ GOOD_PARTIAL_DUMP + ; This means: nothing in the + ; buffer and more than 8 + ; paragraphs to dump. +DO_PARTIAL_DUMP: + ; There are some paragraphs to copy: + MOV BX, 8 + SUB BL, PARAG_IN_REC + ; BX= number of par. to copy + CMP AX, BX + JAE ENOUGH_TO_FILL + MOV BX, AX + MOV AX, 0 + JMP SHORT PARTIAL_DUMP +ENOUGH_TO_FILL: + SUB AX, BX +PARTIAL_DUMP: + ; AX = remaining paragraphs to dump later. + ; BX = number of paragraphs to copy in buffer. + ; CX = paragraph addr of area to copy (offset=0). + MOV TEMP_W, AX + MOV TEMP_W+2, BX + MOV ES, RTS_DS + MOV DI, DEFAULT_DMA ; offset of buffer + MOV AL, PARAG_IN_REC + MOV AH, 0 + MOV DS, CX + MOV CL, 4 + SHL AX, CL ; offset inside buffer + ADD DI, AX ; (ES,DI) = dest addr + MOV SI, 0 ; source offset + MOV CX, 4 + SHL BL, CL + MOV CL, BL + ; number of bytes to copy + REP MOVSB + ; Now, the paragraphs to copy are in the + ; buffer, update counters and pointers: + MOV CX, DS + MOV DS, RTS_DS + MOV AX, TEMP_W+2 ; number of copied paragraphs + ADD PARAG_IN_REC, AL + ADD AX, CX + MOV TEMP_W+2, AX + MOV CX, AX + MOV AX, TEMP_W + CMP PARAG_IN_REC, 8 + JB GOOD_PARTIAL_DUMP + ; The buffer is full, we write it on the file: + CALL SET_DEFAULT_DMA + CALL SEQ_WRITE + CMP AL, 80H + JNE BAD_PARTIAL_DUMP + MOV AX, TEMP_W + MOV CX, TEMP_W+2 + MOV PARAG_IN_REC, 0 +GOOD_PARTIAL_DUMP: + MOV BL, 0 + RET +BAD_PARTIAL_DUMP: + MOV BL, 0FFH + RET +DUMP_PARTIAL_REC endp + + +DUMP_PART proc NEAR + ; Dumps a part of the memory to an open + ; disk file, using the DEFAULT_FCB. + ; Upon entry: + ; CX holds addr of first paragraph to + ; dump, BX is addr of last paragraph + ; to dump (BX=CX means 1 par. to dump). + ; Upon exit: + ; AL=0 if no error occured while writing, + ; AL=1 otherwise. + MOV AX, BX + INC AX + SUB AX, CX + JA DUMP_SIZE_OK + RET + ; endaddr < startaddr +DUMP_SIZE_OK: + CALL DUMP_PARTIAL_REC + ; needed to fill partially filled + ; buffer, as remainder from dumping + ; the previous area. + CMP BL, 0 + JZ DUMP_NEXT_REC + MOV AL, 0FFH + RET +DUMP_NEXT_REC: + ;;;;;; start of LOOP ;;;;;;; + ; AX holds number of paragraphs to dump + ; CX holds first paragr-addr + CMP AX, 8 + JB DUMP_LAST_REC + MOV TEMP_W, AX + MOV TEMP_W+2, CX + push DS + mov DS,cx + mov dx,0 + mov ah, 01Ah + int OS ; Set disk transfer address (DS:DX) + pop DS + CALL SEQ_WRITE ; Write next record + CMP AL, 80H + JE DUMP_REC_OK + RET +; +DUMP_REC_OK: + + MOV AX, TEMP_W ; The next record is written, + SUB AX, 8 ; update counter and address. + MOV CX, TEMP_W+2 + ADD CX, 8 + JMP SHORT DUMP_NEXT_REC + ;;;;; End of LOOP ;;;;;;; + +DUMP_LAST_REC: + CALL DUMP_PARTIAL_REC ; copy the remaining paragraphs + ; in the buffer. + MOV AL, BL ; error flag + RET +DUMP_PART endp + +code ends + end + \ No newline at end of file diff --git a/Logitech Modula-2 v1/PROCESSE.DEF b/Logitech Modula-2 v1/PROCESSE.DEF new file mode 100644 index 0000000..ff96562 --- /dev/null +++ b/Logitech Modula-2 v1/PROCESSE.DEF @@ -0,0 +1,66 @@ +DEFINITION MODULE Processes; +(* + (pseudo-) concurrent programming with SEND/WAIT + + +From the book 'Programming in Modula-2' by Prof. N. Wirth. +*) + +EXPORT QUALIFIED SIGNAL, SEND, WAIT, + StartProcess, Awaited, Init; + + +TYPE SIGNAL; +(* SIGNAL's are the means of synchronization between processes. *) + + +PROCEDURE StartProcess (P: PROC; n: CARDINAL); +(*- Start up a new process. +in: P top-level procedure that will execute in this process. + n number of bytes of workspace to be allocated to it. + +Allocates (from Storage) a workspace of n bytes, and creates a process +executing procedure P in that workspace. Control is given to the new process. + +Caution: The caller must ensure that the workspace size is sufficient for P. +Errors: StartProcess may fail due to insufficient memory. +*) + +PROCEDURE SEND (VAR s: SIGNAL); +(*- Send a signal +in: s the signal to be sent. [Must have been Init'd] +out: s the signal with one less process waiting for it. + +If no process is waiting for s, SEND has precisely no effect. Otherwise, +some process which is waiting for s is given control and allowed to +continue from WAIT. +*) + +PROCEDURE WAIT (VAR s: SIGNAL); +(*- Wait for some other process to send a signal. +in: s the signal to wait for. [Must have been Init'd] + +The current process waits for the signal s. At some later time, a +SEND(s) by some other process can cause this process to return from WAIT. + +Errors: If all other processes are waiting, WAIT terminates the program. +*) + +PROCEDURE Awaited (s:SIGNAL): BOOLEAN; +(*- Test whether any process is waiting for a signal. +in: s the signal of interest. [Must have been Init'd] +out: TRUE if and only if at least one process is waiting for s. +*) + +PROCEDURE Init (VAR s: SIGNAL); +(*- Initialize a SIGNAL object. +in: s the signal to be initialized +out: s the initialized signal (ready to be used as above) + +An object of type SIGNAL must be initialized with this procedure before +it can be used with any of the other operations. After Init(S), Awaited(S) +is FALSE. +*) + +END Processes. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/PROCESSE.LNK b/Logitech Modula-2 v1/PROCESSE.LNK new file mode 100644 index 0000000..51de406 Binary files /dev/null and b/Logitech Modula-2 v1/PROCESSE.LNK differ diff --git a/Logitech Modula-2 v1/PROCESSE.MOD b/Logitech Modula-2 v1/PROCESSE.MOD new file mode 100644 index 0000000..3dc9bb3 Binary files /dev/null and b/Logitech Modula-2 v1/PROCESSE.MOD differ diff --git a/Logitech Modula-2 v1/PROCESSE.REF b/Logitech Modula-2 v1/PROCESSE.REF new file mode 100644 index 0000000..3891cc3 Binary files /dev/null and b/Logitech Modula-2 v1/PROCESSE.REF differ diff --git a/Logitech Modula-2 v1/PROCESSE.SYM b/Logitech Modula-2 v1/PROCESSE.SYM new file mode 100644 index 0000000..0391cbb Binary files /dev/null and b/Logitech Modula-2 v1/PROCESSE.SYM differ diff --git a/Logitech Modula-2 v1/PROGMESS.DEF b/Logitech Modula-2 v1/PROGMESS.DEF new file mode 100644 index 0000000..84f04e9 --- /dev/null +++ b/Logitech Modula-2 v1/PROGMESS.DEF @@ -0,0 +1,20 @@ +DEFINITION MODULE ProgMessage; +(* + Write program status message to the terminal +*) + + +FROM System IMPORT Status; + +EXPORT QUALIFIED WriteStatus; + + +PROCEDURE WriteStatus (st: Status); +(*- Write a short description of a program status on the terminal. +in: st a Status, as returned by Program.Call + +The message may be up to 32 characters long. +*) + +END ProgMessage. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/PROGMESS.LNK b/Logitech Modula-2 v1/PROGMESS.LNK new file mode 100644 index 0000000..f1c2b7c Binary files /dev/null and b/Logitech Modula-2 v1/PROGMESS.LNK differ diff --git a/Logitech Modula-2 v1/PROGMESS.REF b/Logitech Modula-2 v1/PROGMESS.REF new file mode 100644 index 0000000..8ff8fb1 Binary files /dev/null and b/Logitech Modula-2 v1/PROGMESS.REF differ diff --git a/Logitech Modula-2 v1/PROGMESS.SYM b/Logitech Modula-2 v1/PROGMESS.SYM new file mode 100644 index 0000000..b9962b7 Binary files /dev/null and b/Logitech Modula-2 v1/PROGMESS.SYM differ diff --git a/Logitech Modula-2 v1/PROGRAM.DEF b/Logitech Modula-2 v1/PROGRAM.DEF new file mode 100644 index 0000000..e5913bf --- /dev/null +++ b/Logitech Modula-2 v1/PROGRAM.DEF @@ -0,0 +1,89 @@ +DEFINITION MODULE Program; +(* + Sub-program loading and execution + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. + + + Under Modula-2/86, programs can be divided into + sub-programs (we call them 'programs') which are + loaded upon request. + + These programs are executed like procedures: + - they have only one entry-point (body of + program's main module). + - after termination, their data do not exist any + longer. In the case of programs the code also + disappears and will be reloaded from disk upon + the next activation. + - programs may themselves activate other programs. + +*) + + +FROM System IMPORT Status; + +EXPORT QUALIFIED Call, GetErrorInfo; + + +PROCEDURE GetErrorInfo (VAR msg: ARRAY OF CHAR); +(*- Obtain more information about a load error. +out: msg a string related to the last error. + +After Call (below) has returned a Status value of +'modulenotfound' and 'incompatiblemodules', GetErrorInfo +will return the name of the offending module. (length is up +to 24 characters). It returns an empty string in all other +cases. +*) + +PROCEDURE Call (programName: ARRAY OF CHAR; shared: BOOLEAN; + VAR st: Status); +(*- Load and execute a (sub) program. +in: programName file specification for the program, + shared whether to share resources, +out: st terminating status of the subprogram. + +The file whose name is given in 'programName' is opened +loaded, and started. There is no default device or file type: +these must be supplied by the caller. The file must contain a +linked, relocatable program. + +The load address is defined by the default allocation schema, +in which programs are loaded on top of stack and a new stack is +created for execution of the new program. + +If 'shared' = TRUE then all sharable resources allocated by +the called program are owned by the calling program (or +possibly the caller of the caller...). Shared resources are +not released upon termination of the new program. + +Upon termination of the program, its memory is freed and the +old stack is established. All the resources used by a +terminating program are released, if they are not shared and +if they have not been released explicitly by the program +(files, heap, etc). + +Any value of 'st' other than 'normal' indicates an abnormal +termination of the subprogram. In some cases GetErrorInfo (above) +will provide additional details. + + - Cautions - + +In case of abnormal termination, Call does NOT print any kind +of error message. + +Do not assign a procedure in the current program to a procedure +variable which could still exist after the current program +terminates (for example, a variable in a shared resource or in +the calling program). When the current program terminates, +all procedures in it must be considered to cease to exist. + +The loader in this module is not reentrant. This means that +interrupt processes must not load overlays! +*) + +END Program. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/PROGRAM.LNK b/Logitech Modula-2 v1/PROGRAM.LNK new file mode 100644 index 0000000..8d8c41d Binary files /dev/null and b/Logitech Modula-2 v1/PROGRAM.LNK differ diff --git a/Logitech Modula-2 v1/PROGRAM.REF b/Logitech Modula-2 v1/PROGRAM.REF new file mode 100644 index 0000000..37b36ef Binary files /dev/null and b/Logitech Modula-2 v1/PROGRAM.REF differ diff --git a/Logitech Modula-2 v1/PROGRAM.SYM b/Logitech Modula-2 v1/PROGRAM.SYM new file mode 100644 index 0000000..4eaf5cc Binary files /dev/null and b/Logitech Modula-2 v1/PROGRAM.SYM differ diff --git a/Logitech Modula-2 v1/PUBLIC.LNK b/Logitech Modula-2 v1/PUBLIC.LNK new file mode 100644 index 0000000..ebf4da5 Binary files /dev/null and b/Logitech Modula-2 v1/PUBLIC.LNK differ diff --git a/Logitech Modula-2 v1/REALINOU.DEF b/Logitech Modula-2 v1/REALINOU.DEF new file mode 100644 index 0000000..761ad91 --- /dev/null +++ b/Logitech Modula-2 v1/REALINOU.DEF @@ -0,0 +1,41 @@ +DEFINITION MODULE RealInOut; +(* + Terminal input/output of REAL values + + +From the book 'Programming in Modula-2' by Prof. N. Wirth. +*) + +EXPORT QUALIFIED ReadReal, WriteReal, WriteRealOct, Done; + +VAR Done: BOOLEAN; + +PROCEDURE ReadReal(VAR x: REAL); +(*- Read a REAL from the terminal. +out: x the number read. + +The syntax accepted is: +["+"|"-"] digit {digit} ["." digit {digit}] ["E"["+"|"-"] digit [digit]] + +If a number is found, Done is set to TRUE (otherwise FALSE). +At most 7 digits are significant, leading zeros not +counting. Maximum exponent is 38. Input terminates +with a blank or any control character. DEL may be used +for backspacing. +*) + +PROCEDURE WriteReal(x: REAL; n: CARDINAL); +(*- Write a REAL to the terminal, right-justified. +in: x number to write, + n minimum field width. + +If fewer than n characters are needed to represent x, leading +blanks are output. +*) + +PROCEDURE WriteRealOct(x: REAL); +(*- Write a REAL to terminal, in octal form with exponent and mantissa. +*) + +END RealInOut. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/REALINOU.LNK b/Logitech Modula-2 v1/REALINOU.LNK new file mode 100644 index 0000000..3adc336 Binary files /dev/null and b/Logitech Modula-2 v1/REALINOU.LNK differ diff --git a/Logitech Modula-2 v1/REALINOU.REF b/Logitech Modula-2 v1/REALINOU.REF new file mode 100644 index 0000000..16ac967 Binary files /dev/null and b/Logitech Modula-2 v1/REALINOU.REF differ diff --git a/Logitech Modula-2 v1/REALINOU.SYM b/Logitech Modula-2 v1/REALINOU.SYM new file mode 100644 index 0000000..ea6a394 Binary files /dev/null and b/Logitech Modula-2 v1/REALINOU.SYM differ diff --git a/Logitech Modula-2 v1/RS232COD.DEF b/Logitech Modula-2 v1/RS232COD.DEF new file mode 100644 index 0000000..5064060 --- /dev/null +++ b/Logitech Modula-2 v1/RS232COD.DEF @@ -0,0 +1,81 @@ +DEFINITION MODULE RS232Code; +(* + High-speed interrupt-driven input/output via the serial port + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. + + + This module provides interrupt-driven I/O via the serial port, + but the Interrupt Service Routine is implemented using in-line + code (as opposed to IOTRANSFER). + + This approach is NOT portable to other Modula-2 implementations, + but it allows for treatment of interrupts with high frequency. + There is a buffer of at least 128 characters for received data. +*) + + +EXPORT QUALIFIED Init, StartReading, StopReading, + BusyRead, Read, Write; + + +PROCEDURE Init (baudRate: CARDINAL; stopBits: CARDINAL; + parityBit: BOOLEAN; evenParity: BOOLEAN; + nbrOfBits: CARDINAL; VAR result: BOOLEAN); +(*- Initialize the serial port. +in: baudRate transmission speed, + stopBits number of stop bits (usually 1 or 2), + parityBit if TRUE, parity is used, otherwise not, + evenParity if parity is used, this indicates even/odd, + nbrOfBits number of data bits (usually 7 or 8), +out: result TRUE if the initialization was completed. + +The legal values for the parameters depend on the implementation +(e.g. the range of supported baud rates). +*) + +PROCEDURE StartReading; +(*- Allow characters to be received from the serial port. + +This procedure initializes the communication controller to +generate interrupts upon reception of a character. It also +un-masks the corresponding interrupt level in the interrupt +controller. +*) + +PROCEDURE StopReading; +(*- Disable receiving from the serial port. + +A call to this procedure disables the communication controller +from generating interrupts. In addition it terminates the +coroutine which listens to the line. The old interrupt vector +as well as the old state of the interrupt controller (mask) +is restored. +*) + +PROCEDURE BusyRead (VAR ch: CHAR; VAR received: BOOLEAN); +(*- Read a character from serial port, if one has been received. +out: ch the character received, if any, + received TRUE if a character was received. + +If no character has been received, ch = 0C, received = FALSE. +*) + +PROCEDURE Read (VAR ch: CHAR); +(*- Read a character from the serial port. +out: ch the character received. + +As opposed to BusyRead, Read waits for a character to arrive. +*) + +PROCEDURE Write (ch: CHAR); +(*- Write a character to the serial port. +in: ch character to send. + +Note: no interpretation of characters is made. +*) + +END RS232Code. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/RS232COD.LNK b/Logitech Modula-2 v1/RS232COD.LNK new file mode 100644 index 0000000..f8804f2 Binary files /dev/null and b/Logitech Modula-2 v1/RS232COD.LNK differ diff --git a/Logitech Modula-2 v1/RS232COD.MOD b/Logitech Modula-2 v1/RS232COD.MOD new file mode 100644 index 0000000..6e5d5d0 --- /dev/null +++ b/Logitech Modula-2 v1/RS232COD.MOD @@ -0,0 +1,325 @@ +(* + Copyrigth (C) 1984 Logitech. All Rights Reserved. + + Permission is hereby granted to registered users to use or + abstract the following program in the implementation of + customized versions. This permission does not include the + right to redistribute the source code of this program. +*) +(*$S+ *) +(*$T- *) +(*$R- *) +(************************************************************) +(* *) +(* MODULA-2 / 86 (Library Module) *) +(* *) +(* Module: RS232Code *) +(* Library module to read and write over the *) +(* RS-232 asynchronous serial port, using inter- *) +(* rupts for the reception. Received characters *) +(* are stored in a buffer of 100H characters. *) +(* The Interrupt Service Routine is implemented *) +(* using inline-code (as opposed to IOTRANSFER). *) +(* This approach is NOT portable to other Modula-2 *) +(* implementations, but it allows for treatment of *) +(* interrupts with high frequency. *) +(* *) +(* Automatic initialization at the beginning sets *) +(* the following parameters: *) +(* baudRate = 1200, stopBits = 1, *) +(* parityBit = FALSE, evenParity = don't care, *) +(* nbrOfBits = 8 *) +(* *) +(* History: *) +(* Sep 20 83 Revision 0.25 *) +(* Version: *) +(* IBM-PC *) +(* Authors: *) +(* Willy Steiger, LOGITECH SA. *) +(* CH-1143 Apples (Switzerland) and *) +(* Pitts Jarvis, 3Com Corporation *) +(* Mountain View, CA 94043 *) +(* *) +(************************************************************) + +IMPLEMENTATION MODULE RS232Code; + +IMPORT SYSTEM; +FROM SYSTEM IMPORT INBYTE, OUTBYTE; + + + CONST + LineContrReg = 3FBH; (* to specify format of transmitted data *) + LowBaudRateDiv = 3F8H; (* lower byte of divisor to select baud rate *) + HighBaudRateDiv = 3F9H; (* higher byte of divisor *) + LineStatusReg = 3FDH; (* holds status info on the data transfer *) + ReceiverReg = 3F8H; (* received char is in this register *) + TransmitReg = 3F8H; (* char to send is to put in this reg *) + IntEnableReg = 3F9H; (* to enable the selected interrupt *) + + + + + PROCEDURE Init (baudRate: CARDINAL; stopBits: CARDINAL; + parityBit: BOOLEAN; evenParity: BOOLEAN; + nbrOfBits: CARDINAL; VAR result: BOOLEAN); + (* Used to initialze the serial port to specific values. The legal + values for the parameters are: + baudRate: 300..9600 + stopBits: 1 or 2 + parityBit: TRUE / FALSE + evenParity: TRUE / FALSE + nbrOfBits: 5..8 + *) + VAR divisorLow, divisorHigh: CARDINAL; parameters: BITSET; + + BEGIN (* Init *) + result := FALSE; + divisorHigh := 0; + CASE baudRate OF + 300: divisorLow := 80H; + divisorHigh := 1H; + | 600: divisorLow := 0C0H; + | 1200: divisorLow := 60H; + | 2400: divisorLow := 30H; + | 4800: divisorLow := 18H; + | 9600: divisorLow := 0CH; + |19200: divisorLow := 06H; + ELSE RETURN; + END; + (* load the divisor of the baud rate generator: *) + OUTBYTE (LineContrReg, CHR(80H)); + OUTBYTE (HighBaudRateDiv, CHR(divisorHigh)); + OUTBYTE (LowBaudRateDiv, CHR(divisorLow)); + + (* prepare the parameters: *) + parameters := {}; + IF stopBits = 2 THEN INCL (parameters, 2); + ELSIF stopBits <> 1 THEN RETURN; + END; + IF parityBit THEN INCL (parameters, 3); END; + IF evenParity THEN INCL (parameters, 4); END; + IF (nbrOfBits < 5) OR (nbrOfBits > 8) THEN RETURN END; + IF NOT ODD (nbrOfBits) THEN INCL (parameters, 0); END; + IF nbrOfBits >= 7 THEN INCL (parameters, 1); END; + OUTBYTE (LineContrReg, CHR(CARDINAL(parameters))); + + (* Disable Interrupts: *) + OUTBYTE (IntEnableReg, 0C); + + result := TRUE; + END Init; + + + + PROCEDURE BusyRead (VAR ch: CHAR; VAR received: BOOLEAN); + (* If a character has been received, it is read and assigned to 'ch' + and 'received' is set to TRUE. If no character has been received, + 'ch' is set to 0C and 'received' is set to FALSE. + *) + BEGIN + GetByte (ch, received); + END BusyRead; + + + PROCEDURE Read (VAR ch: CHAR); + (* Reads a character from the buffer and returns it in 'ch'. + This routine returns control to the calling program only after + a character has been received. + *) + VAR done: BOOLEAN; + BEGIN + LOOP + BusyRead (ch, done); + IF done THEN EXIT END; + END; + END Read; + + + PROCEDURE Write (ch: CHAR); + (* Writes 'ch' to the port. No interpretation of characters is made *) + VAR status: CHAR; + BEGIN + LOOP + (* Wait until port is ready to accept a character: *) + INBYTE (LineStatusReg, status); + IF 5 IN BITSET(ORD(status)) THEN EXIT END; + END; + OUTBYTE (TransmitReg, ch); + END Write; + + + MODULE InterruptHandler;(********************************************) + + FROM SYSTEM IMPORT INBYTE, OUTBYTE, ADR, BYTE, ADDRESS, + ENABLE, DISABLE; + IMPORT LineStatusReg, ReceiverReg, IntEnableReg; + + EXPORT GetByte, StartReading, StopReading; + + CONST + ModemContrReg = 3FCH; (* controls the interface to a modem *) + I8259ContrWord1 = 21H; (* Interrupt controller, + Operation Control Word 1 *) + I8259ContrWord2 = 20H; (* Interrupt controller, + Operation Control Word 2 *) + AsyncInterrupt = 0CH; (* vector used by the communication contr. *) + EndOfInterrupt = 20H; (* code to send to the 8259 in the ISR *) + + BufferSize = 100H; + + + VAR + oldModemContrRegBit3 : BOOLEAN; + oldLevel4Masked : BOOLEAN; + buffer : ARRAY [0..BufferSize-1] OF CHAR; + xin, xout : CARDINAL; + ISR : ARRAY [0..30] OF BYTE; (* It will contain the code of the ISR *) + vector0C [30H] : ADDRESS; + oldVector0C : ADDRESS; + + + + PROCEDURE GetByte (VAR c: BYTE; VAR valid: BOOLEAN); + BEGIN + IF xin=xout THEN + valid := FALSE; + c := BYTE (0C); + ELSE + valid := TRUE; + c := BYTE(buffer[xout]); + xout := (xout + 1) MOD BufferSize; + END; + END GetByte; + + PROCEDURE PutByte (c: BYTE); + BEGIN + IF (xin + 1) MOD BufferSize = xout THEN RETURN END; + buffer [xin] := CHAR (c); + xin := (xin + 1) MOD BufferSize; + END PutByte; + + + PROCEDURE LineBusyRead (VAR c: CHAR; VAR received: BOOLEAN); + VAR status : CHAR; + BEGIN + c := 0C; received := FALSE; + INBYTE (LineStatusReg, status); + IF 0 IN BITSET(ORD(status)) THEN + INBYTE (ReceiverReg, c); + received := TRUE; + END; + END LineBusyRead; + + + PROCEDURE Receiver; (* Body of the Interrupt Service Routine *) + VAR ch: CHAR; done: BOOLEAN; + BEGIN + (* This procedure is called from the code in the array ISR, + after execution of the prolog in that array. + When arriving here, we have received a character. + *) + LineBusyRead (ch, done); + IF done THEN PutByte (ch); END; + OUTBYTE (I8259ContrWord2, CHR(EndOfInterrupt)); + END Receiver; + + + PROCEDURE StartReading; + VAR tempSet : BITSET; ch: CHAR; dummy: BOOLEAN; + ISRbody: PROC; p: POINTER TO ADDRESS; + BEGIN + ISR[ 0] := BYTE (50H); (* push ax *) + ISR[ 1] := BYTE (51H); (* push cx *) + ISR[ 2] := BYTE (52H); (* push dx *) + ISR[ 3] := BYTE (53H); (* push bx *) + ISR[ 4] := BYTE (56H); (* push si *) + ISR[ 5] := BYTE (57H); (* push di *) + ISR[ 6] := BYTE (1EH); (* push ds *) + ISR[ 7] := BYTE (06H); (* push es *) + ISR[ 8] := BYTE (9AH); (* call far *) + ISR[ 9] := BYTE (00H); (* address will be fixed below *) + ISR[10] := BYTE (00H); (* that routine saves and restores bp *) + ISR[11] := BYTE (00H); + ISR[12] := BYTE (00H); + ISR[13] := BYTE (07H); (* pop es *) + ISR[14] := BYTE (1FH); (* pop ds *) + ISR[15] := BYTE (5FH); (* pop di *) + ISR[16] := BYTE (5EH); (* pop si *) + ISR[17] := BYTE (5BH); (* pop bx *) + ISR[18] := BYTE (5AH); (* pop dx *) + ISR[19] := BYTE (59H); (* pop cx *) + ISR[20] := BYTE (58H); (* pop ax *) + ISR[21] := BYTE (0CFH); (* iret *) + + ISRbody := Receiver; + p := ADR (ISR[9]); + p^:= ADDRESS (ISRbody); + + oldVector0C := vector0C; + vector0C := ADR (ISR); (* set the interrupt vector *) + + LineBusyRead (ch, dummy); (* clear the controller *) + + DISABLE; + xin := 0; xout := 0; + (* select interrupts upon reception: *) + INBYTE (ModemContrReg, ch); + tempSet := BITSET (ORD(ch)); + oldModemContrRegBit3 := 3 IN tempSet; + INCL (tempSet, 3); + OUTBYTE (ModemContrReg, CHR(CARDINAL(tempSet))); + + (* enable interrupts in the communication controller (8250): *) + OUTBYTE (IntEnableReg, 1C); + + (* enable interrupts in the interrupt controller (8259): *) + INBYTE (I8259ContrWord1, ch); + tempSet := BITSET (ORD(ch)); + oldLevel4Masked := 4 IN tempSet; (* level 4 interrupt *) + EXCL (tempSet, 4); + OUTBYTE (I8259ContrWord1, CHR(CARDINAL(tempSet))); + ENABLE; + END StartReading; + + + PROCEDURE StopReading; + VAR tempSet: BITSET; ch: CHAR; + BEGIN + DISABLE; + (* restore old mask in 8259: *) + INBYTE (I8259ContrWord1, ch); + tempSet := BITSET (ORD(ch)); + IF oldLevel4Masked THEN + INCL (tempSet, 4); + ELSE + EXCL (tempSet, 4); + END; + OUTBYTE (I8259ContrWord1, CHR(CARDINAL(tempSet))); + (* disable interrupts in 8250: *) + OUTBYTE (IntEnableReg, 1C); + (* restore modem control register in 8250: *) + INBYTE (ModemContrReg, ch); + tempSet := BITSET (ORD(ch)); + IF oldModemContrRegBit3 THEN + INCL (tempSet, 3); + ELSE + EXCL (tempSet, 3); + END; + OUTBYTE (ModemContrReg, CHR(CARDINAL(tempSet))); + + vector0C := oldVector0C; (* restore the old interrupt vector *) + + ENABLE; + END StopReading; + + END InterruptHandler;(*******************************************) + + + +VAR done: BOOLEAN; + +BEGIN + Init (1200, 1, FALSE, FALSE, 8, done); +END RS232Code. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/RS232COD.REF b/Logitech Modula-2 v1/RS232COD.REF new file mode 100644 index 0000000..f828e64 Binary files /dev/null and b/Logitech Modula-2 v1/RS232COD.REF differ diff --git a/Logitech Modula-2 v1/RS232COD.SYM b/Logitech Modula-2 v1/RS232COD.SYM new file mode 100644 index 0000000..20ac27a Binary files /dev/null and b/Logitech Modula-2 v1/RS232COD.SYM differ diff --git a/Logitech Modula-2 v1/RS232INT.DEF b/Logitech Modula-2 v1/RS232INT.DEF new file mode 100644 index 0000000..2a81508 --- /dev/null +++ b/Logitech Modula-2 v1/RS232INT.DEF @@ -0,0 +1,80 @@ +DEFINITION MODULE RS232Int; +(* + Interrupt-driven input/output via the serial port + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. + + + Interrupts are treated with the standard procedure IOTRANSFER. + Received characters are stored in a buffer of 100H characters. + The module initializes the serial port as follows: + baudRate = 1200, stopBits = 1, + parityBit = FALSE, evenParity = don't care, + nbrOfBits = 8 +*) + + +EXPORT QUALIFIED Init, StartReading, StopReading, + BusyRead, Read, Write; + + +PROCEDURE Init (baudRate: CARDINAL; stopBits: CARDINAL; + parityBit: BOOLEAN; evenParity: BOOLEAN; + nbrOfBits: CARDINAL; VAR result: BOOLEAN); +(*- Initialize the serial port. +in: baudRate transmission speed, + stopBits number of stop bits (usually 1 or 2), + parityBit if TRUE, parity is used, otherwise not, + evenParity if parity is used, this indicates even/odd, + nbrOfBits number of data bits (usually 7 or 8), +out: result TRUE if the initialization was completed. + +The legal values for the parameters depend on the implementation +(e.g. the range of supported baud rates). +*) + +PROCEDURE StartReading; +(*- Allow characters to be received from the serial port. + +This procedure initializes the communication controller to +generate interrupts upon reception of a character. It also +un-masks the corresponding interrupt level in the interrupt +controller. +*) + +PROCEDURE StopReading; +(*- Disable receiving from the serial port. + +A call to this procedure disables the communication controller +from generating interrupts. In addition it terminates the +coroutine which listens to the line. The old interrupt vector +as well as the old state of the interrupt controller (mask) +is restored. +*) + +PROCEDURE BusyRead (VAR ch: CHAR; VAR received: BOOLEAN); +(*- Read a character from serial port, if one has been received. +out: ch the character received, if any, + received TRUE if a character was received. + +If no character has been received, ch = 0C, received = FALSE. +*) + +PROCEDURE Read (VAR ch: CHAR); +(*- Read a character from the serial port. +out: ch the character received. + +As opposed to BusyRead, Read waits for a character to arrive. +*) + +PROCEDURE Write (ch: CHAR); +(*- Write a character to the serial port. +in: ch character to send. + +Note: no interpretation of characters is made. +*) + +END RS232Int. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/RS232INT.LNK b/Logitech Modula-2 v1/RS232INT.LNK new file mode 100644 index 0000000..0beddb4 Binary files /dev/null and b/Logitech Modula-2 v1/RS232INT.LNK differ diff --git a/Logitech Modula-2 v1/RS232INT.MOD b/Logitech Modula-2 v1/RS232INT.MOD new file mode 100644 index 0000000..a4aefa5 --- /dev/null +++ b/Logitech Modula-2 v1/RS232INT.MOD @@ -0,0 +1,308 @@ +(* + Copyrigth (C) 1984 Logitech. All Rights Reserved. + + Permission is hereby granted to registered users to use or + abstract the following program in the implementation of + customized versions. This permission does not include the + right to redistribute the source code of this program. +*) +(*$S+ *) +(*$T- *) +(*$R- *) +(************************************************************) +(* *) +(* MODULA-2 / 86 (Library Module) *) +(* *) +(* Module: RS232Int *) +(* Library module to read and write over the *) +(* RS-232 asynchronous serial port, using inter- *) +(* rupts for the reception. Interrupts are treated *) +(* with the standard procedure IOTRANSFER. *) +(* Received characters are stored in a buffer of *) +(* 100H characters. *) +(* Automatic initialization at the beginning sets *) +(* the following parameters: *) +(* baudRate = 1200, stopBits = 1, *) +(* parityBit = FALSE, evenParity = don't care, *) +(* nbrOfBits = 8 *) +(* *) +(* Version: *) +(* IBM-PC, V1.0 january 84 *) +(* Author: *) +(* Willy Steiger *) +(* LOGITECH SA. *) +(* CH-1143 Apples (Switzerland) *) +(* *) +(************************************************************) + +IMPLEMENTATION MODULE RS232Int; + +IMPORT SYSTEM; +FROM SYSTEM IMPORT INBYTE, OUTBYTE, SIZE, ADR, SWI, + PROCESS, NEWPROCESS, TRANSFER, ENABLE, DISABLE; + + + CONST + LineContrReg = 3FBH; (* to specify format of transmitted data *) + LowBaudRateDiv = 3F8H; (* lower byte of divisor to select baud rate *) + HighBaudRateDiv = 3F9H; (* higher byte of divisor *) + LineStatusReg = 3FDH; (* holds status info on the data transfer *) + ReceiverReg = 3F8H; (* received char is in this register *) + TransmitReg = 3F8H; (* char to send is to put in this reg *) + IntEnableReg = 3F9H; (* to enable the selected interrupt *) + + ModemContrReg = 3FCH; (* controls the interface to a modem *) + AsyncInterrupt = 0CH; (* vector used by the communication contr. *) + InterruptCtrlMask = 21H;(* port address of mask-reg. in int.contr. *) + CommCtrlLevel = 4; (* level of communication interrupts inside + interrupt controller *) + + + VAR + commCtrlMasked, oldModemContrRegBit3 : BOOLEAN; + terminated : BOOLEAN; + workspace : ARRAY [0..100H] OF CARDINAL; + mainP, receiverP : PROCESS; + + + + + PROCEDURE Init (baudRate: CARDINAL; stopBits: CARDINAL; + parityBit: BOOLEAN; evenParity: BOOLEAN; + nbrOfBits: CARDINAL; VAR result: BOOLEAN); + (* Used to initialze the serial port to specific values. The legal + values for the parameters are: + baudRate: 300..9600 + stopBits: 1 or 2 + parityBit: TRUE / FALSE + evenParity: TRUE / FALSE + nbrOfBits: 5..8 + *) + VAR divisorLow, divisorHigh: CARDINAL; parameters: BITSET; + + BEGIN (* Init *) + result := FALSE; + divisorHigh := 0; + CASE baudRate OF + 300: divisorLow := 80H; + divisorHigh := 1H; + | 600: divisorLow := 0C0H; + | 1200: divisorLow := 60H; + | 2400: divisorLow := 30H; + | 4800: divisorLow := 18H; + | 9600: divisorLow := 0CH; + ELSE RETURN; + END; + (* load the divisor of the baud rate generator: *) + OUTBYTE (LineContrReg, CHR(80H)); + OUTBYTE (HighBaudRateDiv, CHR(divisorHigh)); + OUTBYTE (LowBaudRateDiv, CHR(divisorLow)); + + (* prepare the parameters: *) + parameters := {}; + IF stopBits = 2 THEN INCL (parameters, 2); + ELSIF stopBits <> 1 THEN RETURN; + END; + IF parityBit THEN INCL (parameters, 3); END; + IF evenParity THEN INCL (parameters, 4); END; + IF (nbrOfBits < 5) OR (nbrOfBits > 8) THEN RETURN END; + IF NOT ODD (nbrOfBits) THEN INCL (parameters, 0); END; + IF nbrOfBits >= 7 THEN INCL (parameters, 1); END; + OUTBYTE (LineContrReg, CHR(CARDINAL(parameters))); + + (* Disable Interrupts: *) + OUTBYTE (IntEnableReg, 0C); + + result := TRUE; + END Init; + + + + PROCEDURE BusyRead (VAR ch: CHAR; VAR received: BOOLEAN); + (* If a character has been received, it is read and assigned to 'ch' + and 'received' is set to TRUE. If no character has been received, + 'ch' is set to 0C and 'received' is set to FALSE. + *) + BEGIN + GetByte (ch, received); + END BusyRead; + + + PROCEDURE Read (VAR ch: CHAR); + (* Reads a character from the buffer and returns it in 'ch'. + This routine returns control to the calling program only after + a character has been received. + *) + VAR done: BOOLEAN; + BEGIN + LOOP + BusyRead (ch, done); + IF done THEN EXIT END; + END; + END Read; + + + PROCEDURE Write (ch: CHAR); + (* Writes 'ch' to the port. No interpretation of characters is made *) + VAR status: CHAR; + BEGIN + LOOP + (* Wait until port is ready to accept a character: *) + INBYTE (LineStatusReg, status); + IF 5 IN BITSET(ORD(status)) THEN EXIT END; + END; + OUTBYTE (TransmitReg, ch); + END Write; + + + MODULE InterruptHandler [4];(********************************************) + (* We execute the routines in this module at the priority of + the asynchronous controller, to avoid a second interrupt + while we treat the first one. + *) + FROM SYSTEM IMPORT INBYTE, OUTBYTE, BYTE, + PROCESS, TRANSFER, IOTRANSFER; + IMPORT LineStatusReg, ReceiverReg, terminated, AsyncInterrupt, + mainP, receiverP; + + EXPORT GetByte, Receiver, LineBusyRead; + + CONST + BufferSize = 100H; + + + VAR + buffer : ARRAY [0..BufferSize-1] OF CHAR; + xin, xout : CARDINAL; + + + + PROCEDURE GetByte (VAR c: BYTE; VAR valid: BOOLEAN); + BEGIN + IF xin=xout THEN + valid := FALSE; + c := BYTE (0C); + ELSE + valid := TRUE; + c := BYTE(buffer[xout]); + xout := (xout + 1) MOD BufferSize; + END; + END GetByte; + + PROCEDURE PutByte (c: BYTE); + BEGIN + IF (xin + 1) MOD BufferSize = xout THEN RETURN END; + buffer [xin] := CHAR (c); + xin := (xin + 1) MOD BufferSize; + END PutByte; + + + PROCEDURE LineBusyRead (VAR c: CHAR; VAR received: BOOLEAN); + VAR status : CHAR; + BEGIN + c := 0C; received := FALSE; + INBYTE (LineStatusReg, status); + IF 0 IN BITSET(ORD(status)) THEN + INBYTE (ReceiverReg, c); + received := TRUE; + END; + END LineBusyRead; + + + PROCEDURE Receiver; (* coroutine *) + VAR ch: CHAR; valid: BOOLEAN; + tempSet : BITSET; + interruptedP : PROCESS; + BEGIN + interruptedP := mainP; + LOOP + IOTRANSFER (receiverP, interruptedP, AsyncInterrupt); + IF terminated THEN + TRANSFER (receiverP, interruptedP); + END; + (* we have received a character: *) + LineBusyRead (ch, valid); + IF valid THEN PutByte (ch) END; + END; (* LOOP *) + END Receiver; + + + BEGIN + xin := 0; xout := 0; + terminated := TRUE; + END InterruptHandler;(*******************************************) + + + + PROCEDURE StartReading; + VAR tempSet : BITSET; ch: CHAR; valid: BOOLEAN; + BEGIN + (* clear the modem controller: *) + LineBusyRead (ch, valid); + (* Start coroutine, which listens on the line for reception: *) + NEWPROCESS (Receiver, ADR(workspace), SIZE(workspace) DIV 16,receiverP); + terminated := FALSE; + TRANSFER (mainP, receiverP); (* we'll come back right away *) + + (* select interrupts upon reception (in communication contr): *) + INBYTE (ModemContrReg, ch); + tempSet := BITSET(ORD(ch)); + oldModemContrRegBit3 := 3 IN tempSet; + INCL (tempSet, 3); + OUTBYTE (ModemContrReg, CHR(CARDINAL(tempSet))); + (* enable interrupts in the communication controller (8250): *) + OUTBYTE (IntEnableReg, CHR(1H)); + + (* set interrupt controller (8259) to accept interrupts + from asynchronous communication controller: *) + INBYTE (InterruptCtrlMask, ch); + tempSet := BITSET(ORD(ch)); + commCtrlMasked := CommCtrlLevel IN tempSet; + EXCL (tempSet, CommCtrlLevel); + OUTBYTE (InterruptCtrlMask, CHR(CARDINAL(tempSet))); + END StartReading; + + + PROCEDURE StopReading; + VAR tempSet : BITSET; ch: CHAR; + BEGIN + (* set interrupt controller (8259) to the state it was + prior to 'StartReading' (as far as asynchronous + communication controller is concerned): *) + INBYTE (InterruptCtrlMask, ch); + tempSet := BITSET(ORD(ch)); + IF commCtrlMasked THEN INCL (tempSet, CommCtrlLevel); + ELSE EXCL (tempSet, CommCtrlLevel); + END; + OUTBYTE (InterruptCtrlMask, CHR(CARDINAL(tempSet))); + + terminated := TRUE; + SWI (AsyncInterrupt); + (* This interrupt causes the interrupt service routine (ISR) + to be executed a last time. Since the flag 'terminated' is + set, the ISR will just return. The effect is that there is + no more active ISR in the Run-Time Support for 'AyncInterrupt'. + *) + + DISABLE; + (* disable interrupts in 8250: *) + OUTBYTE (IntEnableReg, CHR(1H)); + (* restore modem control register in 8250: *) + INBYTE (ModemContrReg, ch); + tempSet := BITSET(ORD(ch)); + IF oldModemContrRegBit3 THEN + INCL (tempSet, 3); + ELSE + EXCL (tempSet, 3); + END; + OUTBYTE (ModemContrReg, CHR(CARDINAL(tempSet))); + ENABLE; + END StopReading; + + +VAR done: BOOLEAN; + +BEGIN + Init (1200, 1, FALSE, FALSE, 8, done); +END RS232Int. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/RS232INT.REF b/Logitech Modula-2 v1/RS232INT.REF new file mode 100644 index 0000000..3b106c5 Binary files /dev/null and b/Logitech Modula-2 v1/RS232INT.REF differ diff --git a/Logitech Modula-2 v1/RS232INT.SYM b/Logitech Modula-2 v1/RS232INT.SYM new file mode 100644 index 0000000..1f87a39 Binary files /dev/null and b/Logitech Modula-2 v1/RS232INT.SYM differ diff --git a/Logitech Modula-2 v1/RS232POL.DEF b/Logitech Modula-2 v1/RS232POL.DEF new file mode 100644 index 0000000..5d44f54 --- /dev/null +++ b/Logitech Modula-2 v1/RS232POL.DEF @@ -0,0 +1,56 @@ +DEFINITION MODULE RS232Polling; +(* + Polled input/output via the serial port + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. + + + Since this module does not use interrupts, it is the responsibility + of the programmer to poll (by calling 'Read' or 'BusyRead') + frequently enough to ensure that no characters are lost. +*) + +EXPORT QUALIFIED Init, BusyRead, Read, Write; + + +PROCEDURE Init (baudRate: CARDINAL; stopBits: CARDINAL; + parityBit: BOOLEAN; evenParity: BOOLEAN; + nbrOfBits: CARDINAL; VAR result: BOOLEAN); +(*- Initialize the serial port. +in: baudRate transmission speed, + stopBits number of stop bits (usually 1 or 2), + parityBit if TRUE, parity is used, otherwise not, + evenParity if parity is used, this indicates even/odd, + nbrOfBits number of data bits (usually 7 or 8), +out: result TRUE if the initialization was completed. + +The legal values for the parameters depend on the implementation +(e.g. the range of supported baud rates). +*) + +PROCEDURE BusyRead (VAR ch: CHAR; VAR received: BOOLEAN); +(*- Read a character from serial port, if one has been received. +out: ch the character received, if any, + received TRUE if a character was received. + +If no character has been received, ch = 0C, received = FALSE. +*) + +PROCEDURE Read (VAR ch: CHAR); +(*- Read a character from the serial port. +out: ch the character received. + +As opposed to BusyRead, Read waits for a character to arrive. +*) + +PROCEDURE Write (ch: CHAR); +(*- Write a character to the serial port. +in: ch character to send. + +Note: no interpretation of characters is made. +*) + +END RS232Polling. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/RS232POL.LNK b/Logitech Modula-2 v1/RS232POL.LNK new file mode 100644 index 0000000..be67f32 Binary files /dev/null and b/Logitech Modula-2 v1/RS232POL.LNK differ diff --git a/Logitech Modula-2 v1/RS232POL.MOD b/Logitech Modula-2 v1/RS232POL.MOD new file mode 100644 index 0000000..88d26ed --- /dev/null +++ b/Logitech Modula-2 v1/RS232POL.MOD @@ -0,0 +1,191 @@ +(* + Copyrigth (C) 1984 Logitech. All Rights Reserved. + + Permission is hereby granted to registered users to use or + abstract the following program in the implementation of + customized versions. This permission does not include the + right to redistribute the source code of this program. +*) +(*$R- *) +(*$T- *) +(********************************************************************) +(* *) +(* MODULA-2 / 86 *) +(* *) +(* RS232: *) +(* Library module to read and write over the RS-232 *) +(* asynchronous serial port. *) +(* This implementation does NOT work with interrupts, *) +(* so it is the responsability of the user to poll (i.e *) +(* call 'Read' or 'BusyRead') frequently enough to ensure *) +(* that no characters are lost on reception. *) +(* Automatic initialization sets the following parameters: *) +(* baudRate = 9600, stopBits = 1, *) +(* parityBit = FALSE, evenParity = don't care, *) +(* nbrOfBits = 8 *) +(* *) +(* History: *) +(* May 26 83 First revision (0.0-260583) *) +(* July 8 83 Version 0.1 - 07.07.83 *) +(* Version: *) +(* IBM-PC *) +(* Author: *) +(* Willy Steiger *) +(* LOGITECH SA. *) +(* CH-1143 Apples (Switzerland) *) +(* *) +(********************************************************************) + +IMPLEMENTATION MODULE RS232Polling; + +FROM SYSTEM IMPORT INBYTE, OUTBYTE; + + CONST + LineContrReg = 3FBH; (* to specify format of transmitted data *) + LowBaudRateDiv = 3F8H; (* lower byte of divisor to select baud rate *) + HighBaudRateDiv = 3F9H; (* higher byte of divisor *) + LineStatusReg = 3FDH; (* holds status info on the data transfer *) + ReceiverReg = 3F8H; (* received char is in this register *) + TransmitReg = 3F8H; (* char to send is to put in this reg *) + IntEnableReg = 3F9H; (* to enable the selected interrupt *) + + + + PROCEDURE Init (baudRate: CARDINAL; stopBits: CARDINAL; + parityBit: BOOLEAN; evenParity: BOOLEAN; + nbrOfBits: CARDINAL; VAR result: BOOLEAN); + (* Used to initialze the serial port to specific values. The legal + values for the parameters are: + baudRate: 300..9600 + stopBits: 1 or 2 + parityBit: TRUE / FALSE + evenParity: TRUE / FALSE + nbrOfBits: 5..8 + *) + VAR divisorLow, divisorHigh: CARDINAL; parameters: BITSET; + + BEGIN + result := FALSE; + divisorHigh := 0; + CASE baudRate OF + 300: divisorLow := 80H; + divisorHigh := 1H; + | 600: divisorLow := 0C0H; + | 1200: divisorLow := 60H; + | 2400: divisorLow := 30H; + | 4800: divisorLow := 18H; + | 9600: divisorLow := 0CH; + ELSE RETURN; + END; + (* load the divisor of the baud rate generator: *) + OUTBYTE (LineContrReg, 80H); + OUTBYTE (HighBaudRateDiv, divisorHigh); + OUTBYTE (LowBaudRateDiv, divisorLow); + + (* prepare the parameters: *) + parameters := {}; + IF stopBits = 2 THEN INCL (parameters, 2); + ELSIF stopBits <> 1 THEN RETURN; + END; + IF parityBit THEN INCL (parameters, 3); END; + IF evenParity THEN INCL (parameters, 4); END; + IF (nbrOfBits < 5) OR (nbrOfBits > 8) THEN RETURN END; + IF NOT ODD (nbrOfBits) THEN INCL (parameters, 0); END; + IF nbrOfBits >= 7 THEN INCL (parameters, 1); END; + OUTBYTE (LineContrReg, parameters); + + (* Disable Interrupts: *) + OUTBYTE (IntEnableReg, 0H); + + result := TRUE; + END Init; + + + + PROCEDURE BusyRead (VAR ch: CHAR; VAR received: BOOLEAN); + (* If a character has been received, it is read and assigned to 'ch' + and 'received' is set to TRUE. If no character has been received, + 'ch' is set to 0C and 'received' is set to FALSE. + *) + VAR status: BITSET; + BEGIN + received := FALSE; + ch := 0C; + INBYTE (LineStatusReg, status); + IF 0 IN status THEN + INBYTE (ReceiverReg, status); + ch := CHR (CARDINAL(status)); + received := TRUE; + END; + END BusyRead; + + + PROCEDURE Read (VAR ch: CHAR); + (* Reads a character from the port and returns it in 'ch'. + This routine returns control to the calling program only after + a character has been received. + *) + VAR done: BOOLEAN; + BEGIN + LOOP + BusyRead (ch, done); + IF done THEN EXIT END; + END; + END Read; + + + + PROCEDURE Write (ch: CHAR); + (* Writes 'ch' to the port. No interpretation of characters is made *) + VAR status: BITSET; + BEGIN + LOOP + (* Wait until port is ready to accept a character: *) + INBYTE (LineStatusReg, status); + IF 5 IN status THEN EXIT END; + END; + OUTBYTE (TransmitReg, ORD(ch)); + END Write; + + +(* To use the RS232 without interrupts, we have to turn off the + updating of the time on the screen. To do this, we can set + the corresponding Interrupt Vector (1CH) to point to a dummy + Interrupt Service Routine. Such a routine is included here + for illustration. The vector should actually be saved and + restored in the program that uses this module, since 'RS232Polling' + doe not know, when the transmittion is terminated and can + therefore not restore that vector. + + + VAR saveVector: PROC; + vector1C[112]: PROC; (* at address 1CH * 4 *) + + + PROCEDURE DummyISR; + (* Used to disable the updating of the time on the screen. *) + CONST + I8259ContrWord2 = 20H; + EndOfInterrupt = 20H; + PopBP = 5DH; + IRET = 0CFH; + BEGIN + OUTBYTE (I8259ContrWord2, EndOfInterrupt); + CODE (PopBP); (* simulate a procedure exit *) + CODE (IRET); (* return from interrupt service routine *) + END DummyISR; +*) + + VAR done: BOOLEAN; + +BEGIN + Init (9600, 1, FALSE, FALSE, 8, done); +(* In the program that uses this module, the interrupt vector 1CH + should be saved and restored after termination of the transmition. + During transmition, that vector should point to a dummy Interrupt + Service Routine: + saveVector := vector1CH; + vector1CH := DummyISR; +*) +END RS232Polling. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/RS232POL.REF b/Logitech Modula-2 v1/RS232POL.REF new file mode 100644 index 0000000..8933f35 Binary files /dev/null and b/Logitech Modula-2 v1/RS232POL.REF differ diff --git a/Logitech Modula-2 v1/RS232POL.SYM b/Logitech Modula-2 v1/RS232POL.SYM new file mode 100644 index 0000000..717e6ba Binary files /dev/null and b/Logitech Modula-2 v1/RS232POL.SYM differ diff --git a/Logitech Modula-2 v1/RTS.ASM b/Logitech Modula-2 v1/RTS.ASM new file mode 100644 index 0000000..7e4148f --- /dev/null +++ b/Logitech Modula-2 v1/RTS.ASM @@ -0,0 +1,786 @@ +;********************************************************************** +; +; Copyrigth (C) 1984 Logitech. All Rights Reserved. +; +; Permission is hereby granted to registered users to use or +; abstract the following program in the implementation of +; customized versions. This permission does not include the +; right to redistribute the source code of this program. +; +; +; RTS - Mainline of Modula-2/86(tm) Run Time System +; +; 8308.09 converted to PC-DOS 1.1 +; 8312.28 function 26H and trapping of interrupt 23H (break) +; 8401.17 default programname is COMINT; init interrupt mask in PD +; +CGROUP group code +DGROUP group data,stack,memory + + include RTS.INC + +data segment public + + public START_MEM, MEM_SIZE + public CUR_PROCESS, RTS_PROCESS, CUR_P_PTR + public BASE_PAGE_PTR + public SAVED_DISK, RTS_DISK + public FILE_SPEC, FILE_HANDLE + +BASE_PAGE db 100H dup (?) ; required for the Main-Module +TOP_OF_MEMORY equ word ptr BASE_PAGE+2 ; last free paragraph, +1 +TRANS_COM_SIZE equ 440H ; transient part of COMMAND.COM (in parag) +START_MEM dw ? ; first free paragraph +MEM_SIZE dw ? ; number of free paragraphs at START_MEM +DOS dd ? ; jump vector to DOS +START_ADDR dd ? ; start address of .LOD program + +; - saved interrupt vectors - +OLD_RTS_VECTOR dd ? +OLD_DIV0_VECTOR dd ? +OLD_INTO_VECTOR dd ? +OLD_BREAK_VECTOR dd ? + +; This is a copy of the descriptor of the current process: +CUR_PROCESS ProcessDescriptor <> +; Workspace of the MAIN process, starting with RTS: +RTS_PROCESS ProcessDescriptor <> +CUR_P_PTR dd RTS_PROCESS ; pointer to current process descr. +BASE_PAGE_PTR dd BASE_PAGE ; ptr to program segment prefix +MAIN_SP dw ? +MAIN_SS dw ? + +START_DISK db ? +SAVED_DISK db ? +RTS_DISK db ? +DEFAULT_NAME db 'COMINT ' ; default file to load +DEFAULT_TYPE db 'LOD' ; default filetype for loading +DEFAULT_PATH db '\M2LOD\' ; secondary directory to search +DEF_PATH_LENGTH equ 7H +FILE_SPEC db 64H dup(?) +FILE_MSG1 db ' ' +FILE_MSG2 db ' not found in current directory or in \M2LOD$' +FILE_HANDLE dw ? +RES_FN db '?:????????.???$' ; for writing filespecs +NO_FILE db 'File not found: $' +NO_MEMORY db 'Insufficient Memory: $' +SOME_ERROR DB ' --- $' + +NORMAL_MSG DB 'normal termination$' +WARNED_MSG DB 'warning$' +STOP_MSG DB 'stopped$' +ASSERT_MSG DB 'wrong assertion$' +HALT_MSG DB 'HALT called$' +CASE_MSG DB 'case-tag error$' +STACK_MSG DB 'stack overflow$' +HEAP_MSG DB 'heap overflow$' +FCT_ERR_MSG DB 'function return error$' +ADDR_OVF_MSG DB 'address overflow$' +REAL_OVF_MSG DB 'real overflov$' +CARD_OVF_MSG DB 'cardinal overflow$' +INTEGER_OVF_MSG DB 'integer overflow$' +RANGE_ERR_MSG DB 'range error$' +ZERO_DIV_MSG DB 'divison by zero$' +PROC_END_MSG DB 'coroutine end$' +LOAD_MSG DB 'cannot load$' +CALL_MSG DB 'unsuccessfull program call$' +NO_PROG_MSG DB 'program not found$' +NO_MOD_MSG DB 'module not found$' +INCOMPAT_MSG DB 'incompatible module keys$' +BAD_FILE_MSG DB 'bad structure in file$' +ILL_INSTR_MSG DB 'illegal instruction encountered$' +ILL_FCT_MSG DB 'illegal RTS call$' +NO_MORE_ISR DB 'too many concurrent IO-Processes$' + + even +STATUS_MSG DW NORMAL_MSG, WARNED_MSG, STOP_MSG, ASSERT_MSG + DW HALT_MSG, CASE_MSG, STACK_MSG, HEAP_MSG + DW FCT_ERR_MSG, ADDR_OVF_MSG, REAL_OVF_MSG,CARD_OVF_MSG + DW INTEGER_OVF_MSG, RANGE_ERR_MSG, ZERO_DIV_MSG + DW PROC_END_MSG, LOAD_MSG, CALL_MSG + DW NO_PROG_MSG, NO_MOD_MSG, INCOMPAT_MSG, BAD_FILE_MSG + DW ILL_INSTR_MSG, ILL_FCT_MSG, NO_MORE_ISR + +data ends + +stack segment stack + db 100h dup (?) ; loader will set up stack for us +stack ends + + +code segment public +; Upon entry, we assume CS, IP and DS to be set correctly. +; We return to DOS through a jump to location 0 of the Program Segment Prefix +; There is no explicit release of memory or stack reset. + + extrn LoadProg:NEAR ; resident loader + extrn RTS_BRANCH:NEAR ; interrupt dispatcher + extrn REST_I_V:NEAR ; restore interrupt vectors + extrn STACK_OVF:NEAR ; stack overflow + extrn DIV_BY_ZERO:NEAR ; divide by zero handler + extrn STOPPED:NEAR ; break handler + extrn GET_INTERRUPT_MASK:NEAR ; reads the current interrupt mask + + public AFTER_RESIDENT + public RTS_DS + + assume CS:code + public RTS_DS +RTS_DS DW ? ; We need a way to set the DS later on + +main proc near +RTS_START: + push DS ; base of PSP + mov ax,data + mov ES,ax ; point to data segment + mov RTS_DS,ax ; (make it easy to access later, in ISR's) + mov di,offset BASE_PAGE + mov si,0 + mov cx,size BASE_PAGE + cld + rep movsb ; copy PSP into BASE_PAGE + mov DS,ax ; now switch to RTS data segment + assume DS:data,ES:data + pop word ptr DOS+2 ; set up exit vector, which + mov word ptr DOS,0 ; goes to PSP:0 +; + STI ; Allow interruptions + +;****************************************************** +; Initial Memory Allocation +;****************************************************** + mov START_MEM,SS ; bottom of last segment .. + mov ax,sp + mov cl,4 + shr ax,cl ; plus paragraphs of stack.. + add ax,10 ; (plus fudge factor..) + add START_MEM,ax ; ..gives first free paragraph + mov ax,TOP_OF_MEMORY + sub ax,START_MEM +IF KEEP_COM + sub ax, TRANS_COM_SIZE +ENDIF + cmp ax, MAX_MEM_FOR_M2 ; more than we need? + jbe N2MUCH ; nope + mov ax, MAX_MEM_FOR_M2 ; yes, just take what is needed +N2MUCH: mov MEM_SIZE,ax ; compute free paragraphs +; +; Find the current disk, and fill in the Filespec of the program to run +; + mov ah, 25 + int OS ; get current default disk + mov START_DISK, al ; save for Postmortem dump + mov RTS_DISK, al +; => RESTRICTION: The user has to log in the disk on which reside +; both, the Run-Time-Support and the RESIDENT.CMD + mov di,offset FILE_SPEC +FN_COPY2: + mov si,DEFAULT_DMA + cld + mov cx,0 + mov cl,byte ptr[si] + inc si + jcxz FN_COPY5 ; no command tail, use default name +FN_COPY2a: + lodsb ; look for first non-blank + cmp al,' ' + jne FN_COPY6a ; that must be file name + loop FN_COPY2a + jmp FN_COPY5 ; all blanks, use default name + +FN_COPY6: ; copy in file name! + lodsb + cmp al,' ' + je FN_COPY6b ; until blank +FN_COPY6a: + stosb + loop FN_COPY6 ; or end of command line + inc si ; pretend we saw a blank.. +FN_COPY6b: + dec si ; back up over terminating blank + cmp byte ptr[si-1],":" ; was only the device there? + je FN_COPY5 ; yes, so set the default name. +FN_COPY9: + dec si + cmp byte ptr[si],"." + je EXT_END ; extension already here. + cmp si,DEFAULT_DMA ; at start of command tail? + ja FN_COPY9 ; no: keep looking for '.' + jmp FN_COPY3 ; yes: no extension, supply one. + +FN_COPY5: ; use default name + mov si,offset DEFAULT_NAME + mov cx,6 +FN_COPY4: + movsb + dec cx + jz FN_COPY3 + cmp byte ptr[si]," " + jne FN_COPY4 +FN_COPY3: ; end of all the 'write filename' loops + mov byte ptr[di],"." + inc di + mov si,offset DEFAULT_TYPE + mov cx,3 +FEXT_COPY1: + cmp byte ptr[si]," " + je EXT_END + movsb + dec cx + jnz FEXT_COPY1 +EXT_END: + mov byte ptr[di],0 + CALL OPEN_FILE ; open program file + jnb FOUND + mov si,offset FILE_SPEC +FN_COPY11: + cmp byte ptr[si],"\" + je NOT_FOUND ; path speficied, so don't retry + cmp byte ptr[si],0 + je LOOK_AGAIN ; no path, so look in default path + inc si + jmp FN_COPY11 +LOOK_AGAIN: + mov cx,15 + mov di,offset FILE_MSG1 + mov si,offset FILE_SPEC + cld + rep movsb + mov cx,64-DEF_PATH_LENGTH + mov di,offset FILE_SPEC+63 + mov si,offset FILE_SPEC+63-DEF_PATH_LENGTH + std ; move filename down so path can + rep movsb ; be inserted. + mov di,offset FILE_SPEC+2 + cmp byte ptr[di]-1,":" + je INS_PATH + mov di,offset FILE_SPEC +INS_PATH: + mov si,offset DEFAULT_PATH + cld + mov cx,DEF_PATH_LENGTH + rep movsb ; insert path + call OPEN_FILE ; check if file is there... + jnb FOUND + jmp N_FOUND1 ; nope. issue special message. +NOT_FOUND: + MOV DX, OFFSET NO_FILE ; nope + CALL WRITE_MSG + CALL WRITE_FILE_NAME + jmp DOS +N_FOUND1: + mov dx,offset FILE_MSG1 + call WRITE_MSG + jmp DOS +FOUND: + mov FILE_HANDLE,ax + mov bx,FILE_HANDLE + mov ax,RTS_PROCESS.PD_PROG_ID ; AX = current prog id + mov dx,RTS_PROCESS.PD_MOD_TABLE + mov cx,RTS_PROCESS.PD_MOD_TABLE+2 ; CX:DX = old module table + call LoadProg ; load Resident + mov RTS_PROCESS.PD_MOD_TABLE,dx + mov RTS_PROCESS.PD_MOD_TABLE+2,cx ; CX:DX = new module table + mov word ptr START_ADDR,di + mov word ptr START_ADDR+2,ES ; ES:DI = start address + push bx + call CLOSE_FILE + pop bx + test bx,bx ; load ok? + jz LOADED ; yes + dec bx + shl bx,1 + mov dx,LdErr[bx] + CALL WRITE_MSG + CALL WRITE_FILE_NAME + jmp DOS + +data segment +;; - load error table and messages - +badstr db '** Bad Structure - $' +badver db '** Bad Version or Target system - $' +badeof db '** Unexpected EOF - $' +badmem db '** Insufficient Memory - $' +badchk db '** Bad Checksum - $' +baderr db '** LOAD error table fu - $' + even +LdErr dw badstr,badver,badeof,badmem,badchk,baderr +data ends + + +; Alloc_Mem - called by LoadProg to allocate memory for the 'IPL' +; +; in: AX memory request size, in paragraphs +; out: AX first paragraph of allocated chunk +; BX =0 if ok, <>0 if memory not available +; + public Alloc_Mem +Alloc_Mem: + mov bx,1 + cmp ax, MEM_SIZE ; can request be satisfied? + ja AllFU ; no + sub MEM_SIZE,ax ; yes + add ax, START_MEM ; compute next free paragraph.. + xchg ax, START_MEM ; update start_mem, return old value + xor bx,bx +AllFU: ret + +LOADED: +MEM_OK: +; switch to real run-time stack, at top of workspace: + MOV AX, MEM_SIZE + MOV BX, START_MEM + CALL COMP_STACK ; BX becomes SS, AX becomes SP + MOV MAIN_SS, BX + MOV MAIN_SP, AX + MOV SS, BX ; No need to disable Interrupts, + MOV SP, AX ; the processor does it here + + +;****************************************************** +; Fill in the Default Process Descriptor: +;****************************************************** + + ; First we put the Return Address in RTS on the + ; Stack. It will be used in case of an error + ; in the Main program (RESIDENT) + PUSHF + PUSH CS + MOV AX, OFFSET AFTER_RESIDENT + PUSH AX + PUSH DS + PUSH BP + + + ; Now put all the significant registers at + ; their places in P.D: + PUSHF + POP RTS_PROCESS.PD_FLAGS + MOV RTS_PROCESS.PD_SP, SP + MOV RTS_PROCESS.PD_SS, SS + MOV RTS_PROCESS.PD_DS, DS + + ; and the initial value for the stack test: + MOV AX, SP + SUB AX, SP_RESERVE+4 + ; 4 stands for the CALLF to RESIDENT + MOV RTS_PROCESS.PD_SP_LIM, AX + ; Stack Limit is actual value of SP + ; minus some reserve + + ; and the initial values for the heap managment: + MOV AX, START_MEM ; Paragraph addr + MOV RTS_PROCESS.PD_HEAP_BASE + 2, AX ; first para of heap + MOV RTS_PROCESS.PD_HEAP_TOP + 2, AX ; top para. of heap + ; Only the minimum is done here, to be as + ; independant from the implementation of the + ; heap manager as possible. See also NEW_PROCESS + + ; Set all the values needed for TRANSFER + ; and error handling: + MOV RTS_PROCESS.PD_RET_SP, SP + MOV RTS_PROCESS.PD_PROG_END, SP + MOV RTS_PROCESS.PD_PROG_END+2, SS + + + +;****************************************************** +; Create the Main Process: +;****************************************************** + + ; The Default Process Descriptor becomes the + ; current one. This is not a TRANSFER, the + ; very first process has to be created + ; simply by copying its descriptor into the + ; current-one: + push DS + pop ES + mov si, offset RTS_PROCESS + mov di, offset CUR_PROCESS + mov cx, size CUR_PROCESS + rep movsb + + +;****************************************************** +; Prepare the interrupt system: +;****************************************************** + + CALL GET_INTERRUPT_MASK + MOV CUR_PROCESS.PD_PRIO_MASK, AX + + ; Compute physical address of RTS vector: + mov bx,RTS_INT*4 + MOV AX, 0 + MOV ES, AX + + ; Set entry point for RTS-interrupt-vector: + MOV AX, ES: [BX] ; Save the old value + MOV OLD_RTS_VECTOR, AX + MOV AX, ES: 2[BX] + MOV OLD_RTS_VECTOR + 2, AX + MOV ES:word ptr [BX], offset RTS_BRANCH + MOV ES:word ptr 2[BX], CS ; Set the new-one + + ; Interrupt vector 0, used for 'divide by zero': + mov bx,0*4 + mov ax, ES:[bx] ; Save the old value + mov OLD_DIV0_VECTOR, ax + mov ax, ES:2[bx] + mov OLD_DIV0_VECTOR + 2, ax + mov ES:word ptr 2[bx], CS ; Set the new-one + mov ES:word ptr[bx], offset DIV_BY_ZERO + + ; Interrupt vector 4 (used for INTO) has also + ; to point to the RTS: + mov bx,4*4 + MOV AX, ES:[bx] ; Save the old value + MOV OLD_INTO_VECTOR, AX + MOV AX, ES:2[bx] + MOV OLD_INTO_VECTOR + 2, AX + MOV ES:word ptr [bx], offset RTS_BRANCH + MOV ES:word ptr 2[bx], CS ; Set the new-one + ; Note, that there is no special entry for the + ; interrupt on overflow. The calling program + ; has to set the function code in AX as for the + ; other RTS calls. Needed, because an overflow + ; may occur in several error conditions + ; (INTEGER, CARDINAL, SUBRANGE...) + + ; Interrupt vector 23H (used for BREAK) has also + ; to point to the RTS: + mov bx,4*23H + MOV AX, ES:[bx] ; Save the old value + MOV OLD_BREAK_VECTOR, AX + MOV AX, ES:2[bx] + MOV OLD_BREAK_VECTOR + 2, AX + MOV ES:word ptr [bx], offset STOPPED + MOV ES:word ptr 2[bx], CS ; Set the new-one + + + +;****************************************************** +; Call the RESIDENT part: +;****************************************************** + + ; For debugger, to detect first + ; procedure in calling sequence: + MOV BP, 0 + +CALL_RESIDENT: + CALL START_ADDR ; call loaded program + +; We are back from the MODULA program. +AFTER_RESIDENT: + MOV DS, RTS_DS ; restore data segment + MOV AX, CUR_PROCESS.PD_STATUS + test ax,ax + jz RTS_END ; 0 = No error + MOV DX, OFFSET SOME_ERROR + CALL WRITE_MSG + MOV BX, CUR_PROCESS.PD_STATUS + CALL WRITE_STATUS + CALL WRITE_LN + ; It is safer to return to DOS and possibly reload the + ; RTS rather then restarting its execution, since the + ; code might have been overwritten. + +RTS_END: +; Restore the modified interrupt vectors + MOV AX, 0 + MOV ES, AX + MOV BX, RTS_INT*4 + MOV AX, OLD_RTS_VECTOR ; The RTS entry + MOV ES: [BX], AX + MOV AX, OLD_RTS_VECTOR + 2 + MOV ES: [BX]+2, AX + MOV AX, OLD_DIV0_VECTOR ; The entry for DIV0 + MOV ES:word ptr 0, AX + MOV AX, OLD_DIV0_VECTOR + 2 + MOV ES:word ptr 2, AX + MOV AX, OLD_INTO_VECTOR ; The entry for INTO + MOV ES:word ptr 16, AX + MOV AX, OLD_INTO_VECTOR + 2 + MOV ES:word ptr 18, AX + MOV AX, OLD_BREAK_VECTOR ; The entry for BREAK + MOV ES:word ptr 140, AX + MOV AX, OLD_BREAK_VECTOR + 2 + MOV ES:word ptr 142, AX + ; Restore the old interrupt vectors for every IO-Process, + ; waiting on an interrupt: + mov CUR_PROCESS.PD_PROG_ID, 0 + ; 0 as program id is a sort of a joker. + CALL REST_I_V + ; select the same drive that was selected at beginning: + MOV DL, START_DISK + CALL SELECT_DISK + + public SYS_RESET +SYS_RESET: + jmp DOS ; Back to DOS + + +;********************************************************** + public TERMINATE +;********************************************************** + +; We arrive here, when a program is terminated or if any error had +; occured. In the former case, status is 'normal', in the latter case +; the error-code is set in the Status-field of Current Process Descriptor: + +data segment +SAVE_SP dw ? +SAVE_SS dw ? +PMD_STACK dw 160 dup (?) ; should be enough +PMD_STACK_END label word +data ends + extrn P_M_DUMP:near + +TERMINATE: +;========= + MOV DS, RTS_DS + assume DS:data +; We produce a memory dump, if the status is not NORMAL or WARNED: + MOV AX, CUR_PROCESS.PD_STATUS + CMP AX, 2 + JB TERMINATION + +; lines added so bad function call will not cause parity check + cmp ax,ILL_FCT_CODE + je TERMINATION + + CMP AX, HIGHEST_ERR_CODE ; Test if err-code legal + JBE TERM_DUMP + MOV CUR_PROCESS.PD_STATUS, ILL_FCT_CODE + +; line added to avoid parity check + jmp TERMINATION +TERM_DUMP: + ; First, we're going to set (SS,SP) to the + ; auxiliary stack: + MOV SAVE_SS, SS + MOV SAVE_SP, SP + MOV AX, DS + MOV SS, AX + MOV SP, OFFSET PMD_STACK_END + + CALL P_M_DUMP + + ; Restore stack of user process: + MOV SS, SAVE_SS + MOV SP, SAVE_SP + +TERMINATION: + ; Free the resources, managed by RTS: + CALL REST_I_V ; only Interrupt Vectors + MOV DS, CS:RTS_DS + ; Prepare return: + MOV SS, CUR_PROCESS.PD_PROG_END+2 + MOV SP, CUR_PROCESS.PD_PROG_END + POP BP ; BP and DS of Father Program + POP DS + IRET + + +;****************************************************** +; Some Utilities: +;****************************************************** + + + public COMP_STACK +COMP_STACK: + ; Upon Entry: + ; AX holds size of free memory (in paragraphs) + ; BX holds (paragraph) start address of free memory + ; Upon Exit: + ; AX holds SP and BX holds SS + ; Policy: + ; Set STACK to the end of memory. Check if + ; there is room for a minimal stack. + CMP AX, 1000H + JBE SMALL_MEM + ; There is more than 64K of free memory: + SUB AX, 1000H + ADD BX, AX + ; Set SS to end of memory - 64K + MOV AX, 0 + ; and SP to 0 + RET +SMALL_MEM: + ; Less than 64K of free memory + ; SS is start of free memory + MOV CL, 4 + SHL AX, CL + ; SP is length * 16 + CMP AX, SP_INI_SIZE + SP_RESERVE + 4 + ; 4 is for the call of RESIDENT + JAE LARGE_ENOUGH + JMP STACK_OVF + ; Not enough for initial stack and + ; for some reserve! +LARGE_ENOUGH: + RET + + + + + public WRITE + +WRITE: +; The character to be printed is in DL + MOV AH, 2 ; Console Output + INT OS + RET + + public WRITE_MSG + +WRITE_MSG: +; The address of the message is in DX + MOV AH, 9 ; Print String + INT OS + RET + + public WRITE_LN + +WRITE_LN: + MOV DL, 0DH ; Print CR + CALL WRITE + MOV DL, 0AH ; Print LF + CALL WRITE + RET + + public WRITE_FILE_NAME + +WRITE_FILE_NAME: + mov di,offset FILE_SPEC +WFN1: + cmp byte ptr[di],0 + je WFN3 + inc di + jmp WFN1 +WFN3: + mov byte ptr[di],'$' + mov dx,offset FILE_SPEC + call WRITE_MSG + ret + + + public WRITE_STATUS + +WRITE_STATUS: + ; prints on the screen the meaning of a + ; program status (passed in BL): + push bx + MOV DL, ' ' + CALL WRITE + pop bx + xor bh,bh + ADD BX, BX + MOV DX, STATUS_MSG [BX] + CALL WRITE_MSG + RET + + + public SET_DEFAULT_DMA + +SET_DEFAULT_DMA: + mov dx, DEFAULT_DMA + mov ah, 01Ah + int OS + ret + + public SELECT_DISK + +SELECT_DISK: +; the drive to be selected is passed in DL + mov ah, 14 + int OS + ret + + public OPEN_FILE + +OPEN_FILE: +; open file in FILE_SPEC: returns carry flag set if not found + mov ax,3D02H ; open for read/write + mov dx,offset FILE_SPEC + int OS + ret + + public CLOSE_FILE + +CLOSE_FILE: + ; closes the file given in the FILE_HANDLE + mov ah,3EH + mov bx,FILE_HANDLE + int OS + ret + + public DELETE_FILE + +DELETE_FILE: + ; deletes the file given in the FILE_SPEC + mov ah,41H + mov dx,offset FILE_SPEC + int OS + ret + + public SEQ_WRITE + +SEQ_WRITE: + ; writes the next byte in the file given + ; in the FILE_HANDLE. + push ds + mov ah,2FH ; get current dma (buffer address) + int os + push es + push bx + mov bx,FILE_HANDLE + pop dx + mov cx,80H + mov ah,40H + pop ds + int OS + pop ds + ret + + public MAKE_FILE + +MAKE_FILE: + ; creates the file given in the FILE_SPEC + mov ah, 3CH + mov cx,0 ; attribute of zero + mov dx,offset FILE_SPEC + int OS + ret + + public GET_CURR_DISK + +GET_CURR_DISK: + ; gets the currently logged in disk and stores + ; the value in the variable 'SAVED_DISK' + mov ah, 25 + int OS + mov SAVED_DISK, al + ret + + public NORM_ADDR + +NORM_ADDR: + ; To normalize a address with segment and offset, + ; i.e the segment value is as large as possible + ; and the offset is smaller than 16. + ; Upon entry: + ; BX holds the old segment and AX the old offset. + ; Upon exit: + ; BX holds the normalized segment and AX the offset. + ; If an overflow occurs, the 'CF' flag is set. + MOV DX, AX + AND AX, 0FH + MOV CL, 4 + SHR DX, CL + ADD BX, DX + RET + +main endp +code ends + end RTS_START + \ No newline at end of file diff --git a/Logitech Modula-2 v1/RTS.INC b/Logitech Modula-2 v1/RTS.INC new file mode 100644 index 0000000..ac26530 --- /dev/null +++ b/Logitech Modula-2 v1/RTS.INC @@ -0,0 +1,227 @@ +;********************************************************************** +; +; Copyrigth (C) 1984 Logitech. All Rights Reserved. +; +; Permission is hereby granted to registered users to use or +; abstract the following program in the implementation of +; customized versions. This permission does not include the +; right to redistribute the source code of this program. +; +; +; Common Definitions, Run-Time-Support for Modula-2 System (RTS). +; +; Version: 8086 processor, RAM-version +; IBM-PC under PC-DOS 1.1 and 2.0 +; +; Release: 0.1; June 25 '83 +; 0.2; Aug 03 '83 +; 0.2; Aug 09 '83 - for PCDOS 1.1 +; 1.0; Feb 29 '84 - add function 26H,priority in PD +; +; Copyright: LOGITECH SA. +; CH-1143 Apples +; Switzerland +; +; WARNING: This program has to be modified with utmost care! +; Modula-2 programs contain calls to this +; assembly part and therefore a user must +; not modify those functions of this Run-Time +; Support which are accessed through interrupt 'RTS_INT'. +; +;********************************************************************** + +TRUE EQU 0FFFFH +FALSE EQU 0 + +; The following definitions may be modified by a user, +; to adapt the RTS to his particular system: + + RTS_INT EQU 228 + ; Interrupt vector for main entry in RTS. This vector is used by the + ; compiler. If you modify it, you have to correct the corresponding + ; value in the compiler (contact LOGITECH). + + + NBR_ISR EQU 8 + ; Number of interrupts that can be used together at any one time. + ; This parameter allows to adapt the size of tables to the really + ; needed size. If you want to treat more than 16 interrupts together, + ; you have to write additional interrupt service routines, each of + ; which consists of 2 instructions: NOP, CALL COM_ISR. See the + ; existing ones (named ISR0 through ISR15). + + + MAX_MEM_FOR_M2 EQU 0FFFFH ; In number of paragraphs. + ; With this constant you can limit the total amount of memory + ; that will be used for the Modula-2 programs. The space used + ; for the Run-Time-Support (the program you are now looking at) + ; and for the Resident Part are not included in this memory size. + ; If this number is larger than the available memory, the total + ; physical memory will be used. Usually this number is therefore + ; set to 0FFFFH. + + + KEEP_COM EQU TRUE + ; This switch is used to specify if the transient portion of + ; COMMAND.COM of the DOS operating system has to be preserved + ; in memory or if it can be overwritten by the Modula program. + ; It is convenient to keep COMMAND.COM in memory, on systems + ; with little memory however, that portion may be used too. + ; Its size is 17K bytes. + + + DUMP_ENABLE EQU TRUE + ; With this switch you can disable the Post Mortem Dump generation. + ; During development phase of a program this switch should be turned + ; on, to allow debugging. In case your Modula System runs only + ; debugged programs (typically when you distribute an application), + ; this switch can be turned off. + + +; End of user-modifiable definitions. +;****************************************************** + +OS EQU 21H ; PC-DOS +SP_INI_SIZE EQU 10 ; 10 bytes are needed to prepare + ; the stack of a new process. +SP_RESERVE EQU 30H ; Reserve for 10 PUSHes + 2 roundings +DEFAULT_FCB EQU 5CH ; inside the BASE_PAGE +DEFAULT_DMA EQU 80H ; inside the BASE_PAGE +NIL_SEG EQU 0FFFFh +NIL_OFF EQU 0FH ; Offset value for a NIL pointer + ; Note: NIL = highest legal address +NIL_CARD EQU 0FFFFH ; NIL value for a CARDINAL + + +ProcessDescriptor STRUC + ; The type 'ProcessDescriptor' in module 'System' + ; must have the same structure! +PD_AX dw 0 +PD_BX dw 0 +PD_CX dw 0 +PD_DX dw 0 +PD_SP dw 0 +PD_BP dw 0 +PD_SI dw 0 +PD_DI dw 0 +PD_DS dw 0 +PD_SS dw 0 +PD_ES dw 0 +PD_CS dw 0 +PD_IP dw 0 +PD_FLAGS dw 0 ; processor flags register +PD_STATUS dw 0 ; program/process status +PD_PROG_ID dw 1 ; default program id +PD_AUX_ID dw 0 ; (not yet used) +PD_SHARED_ID dw 1 ; prog id of last shared level +PD_FATHER_PROC dd 0FFFF000Fh + ; Points to the 'father process' descriptor + ; The father process is the main process of + ; a program (overlay). The father itself has + ; no father (NIL value). This is used to + ; terminate the whole program if a 'son process' + ; terminates. +PD_SP_LIM dw 0 ; stack (SP) limit value +PD_PRIO_MASK dw 0 ; Interrupt mask for priority level of + ; this process +PD_RET_SP dw 0 ; Return Stack Value +PD_PROG_END dd 0 ; Program End Stack +PD_INT_VECT dw 0 ; Interrupt Vector +PD_OLD_ISR dd 0 ; Old addr of Int Service R. +PD_INT_PROC dd 0 ; Addr, where to store the + ; interrupted process (in ISR) +PD_HEAP_BASE dd 0 ; Heap Base (initially after code) +PD_HEAP_TOP dd 0 ; Heap Top (= highwater marker) +PD_MOD_TABLE dd 0FFFF000Fh ; Pointer to first Module Descriptor + +ProcessDescriptor ENDS + + NBR_FCT EQU 39 + ; Number of existing functions in RTS + + RESET_FCT EQU 0 + HALT_FCT EQU 1 + TRANSFER_FCT EQU 2 + IOTRANSFER_FCT EQU 3 + NEWPROCESS_FCT EQU 4 + MON_ENTRY_FCT EQU 5 + MON_EXIT_FCT EQU 6 + LISTEN_FCT EQU 7 + SAVE_RET_FCT EQU 8 + REST_RET_FCT EQU 9 + SET_RET_FCT EQU 10 + TERMINATE_FCT EQU 11 + CASE_1_FCT EQU 12 + CASE_2_CARD_FCT EQU 13 + CASE_2_INT_FCT EQU 14 + CASE_3_CARD_FCT EQU 15 + CASE_3_INT_FCT EQU 16 + CASE_ERR_FCT EQU 17 + PAR_COPY_FCT EQU 18 + DYNPAR_COPY_FCT EQU 19 + STACK_CHECK_FCT EQU 20 + FREE_INT_FCT EQU 21 + WRT_STATUS_FCT EQU 22 + GET_PD_ADDRESS EQU 23 + ALLOC_HEAP_FCT EQU 24 + FCT_RET_ERR_FCT EQU 25 + NORM_ADDR_FCT EQU 26 + ADD_ADDR_FCT EQU 27 + ADD_ADDR_CARD_FCT EQU 28 + SUB_ADDR_FCT EQU 29 + SUB_ADDR_CARD_FCT EQU 30 + EQ_ADDR_FCT EQU 31 + GT_ADDR_FCT EQU 32 + GT_EQ_ADDR_FCT EQU 33 + CONV_ADDR_CARD_FCT EQU 34 + CARD_OVF_FCT EQU 35 + INTEGER_OVF_FCT EQU 36 + RANGE_ERR_FCT EQU 37 + PSP_PTR_FCT EQU 38 + + + + + +;******************************************************** +;The Error-codes: +;******************************************************** + ; Correspond to the enumeration type 'Status' of + ; module 'System'. + +HIGHEST_ERR_CODE EQU 24 + +NORMAL_CODE EQU 0 +WARNED_CODE EQU 1 +STOP_CODE EQU 2 +ASSERTED_CODE EQU 3 +HALT_CODE EQU 4 + +CASE_ERR_CODE EQU 5 +STACK_OVF_CODE EQU 6 +HEAP_OVF_CODE EQU 7 +FCT_RET_ERR_CODE EQU 8 +ADDR_OVF_CODE EQU 9 +REAL_OVF_CODE EQU 10 +CARD_OVF_CODE EQU 11 +INTEGER_OVF_CODE EQU 12 +RANGE_ERR_CODE EQU 13 +ZERO_DIVIDE_CODE EQU 14 +PROCESS_END_CODE EQU 15 + +LOAD_ERR_CODE EQU 16 +CALL_ERR_CODE EQU 17 +NO_PROG_CODE EQU 18 +NO_MODULE_CODE EQU 19 +INCOMPAT_MOD_CODE EQU 20 +BAD_FILE_CODE EQU 21 + ; may be used in an application program +ILL_INSTR_CODE EQU 22 + ; possible with the 8087 +ILL_FCT_CODE EQU 23 + ; illegal RTS-function or illegal + ; error-code +INT_ERR_CODE EQU 24 + ; attempt to treat too many + ; interrupts at the same time + \ No newline at end of file diff --git a/Logitech Modula-2 v1/SERVICES.ASM b/Logitech Modula-2 v1/SERVICES.ASM new file mode 100644 index 0000000..3172753 --- /dev/null +++ b/Logitech Modula-2 v1/SERVICES.ASM @@ -0,0 +1,1225 @@ +;************************************************************* +; +; Copyrigth (C) 1984 Logitech. All Rights Reserved. +; +; Permission is hereby granted to registered users to use or +; abstract the following program in the implementation of +; customized versions. This permission does not include the +; right to redistribute the source code of this program. +; +; +; Modula-2/86 Run Time Support package +; +; SERVICES.ASM - Module 2 of the Run Time Support +; +; Release 1.0 - Feb 29 84 +; +;************************************************************* + + include RTS.INC + + +code segment public + extrn RTS_DS:word ; yes, this goes in CODE segment! + + extrn TERMINATE:near + extrn COMP_STACK:near + extrn NORM_ADDR:near + extrn WRITE_STATUS:near + extrn REST_INTERRUPT_MASK:near + + extrn SYS_RESET:near + extrn TRANSFER:near + extrn IOTRANSFER:near + extrn NEWPROCESS:near + extrn MON_ENTRY:near + extrn MON_EXIT:near + extrn LISTEN:near + extrn FREE_INT_VECT:near + +data segment public + extrn CUR_PROCESS:byte ; ProcessDescriptor + extrn CUR_P_PTR:dword ; (ptr to ProcessDescriptor) + extrn BASE_PAGE_PTR:dword ; pointer to prog seg prefix + + public FCT_CODE + + +FCT_CODE db ? + even +TempWord dw ? ; temporary word storage.. +TEMP_W dw ? ; another temporary word.. +OldIP dw ? ; interrupt frame, saved and +OldCS dw ? ; restored by DYN_PAR_COPY +OldFlags dw ? ; + + +; Run Time Support system JUMP TABLE +; +; The entries in this table cannot be changed without corresponding +; changes to the Modula-2/86 Compiler! +; It is suggested that extensions to the RTS be implemented with a +; different interrupt than the standard RTS interrupt. +; +RTS_JMP_TBL dw SYS_RESET ; 00h + dw M2_HALT ; 01h + dw TRANSFER ; 02h + dw IOTRANSFER ; 03h + dw NEWPROCESS ; 04h + dw MON_ENTRY ; 05h + dw MON_EXIT ; 06h + dw LISTEN ; 07h + dw GET_RETURN_POINT; 08h + dw SET_RETURN_POINT; 09h + dw RUN_PROGRAM ; 0Ah + dw TERMINATE ; 0Bh + dw COM_CASE ; 0Ch + dw COM_CASE ; 0Dh + dw COM_CASE ; 0Eh + dw COM_CASE ; 0Fh + dw COM_CASE ; 10h + dw CASE_ERROR ; 11h + dw PAR_COPY ; 12h + dw DYN_PAR_COPY ; 13h + dw STACK_CHECK ; 14h + dw FREE_INT_VECT ; 15h + dw WRITE_STAT ; 16h + dw GET_PD_ADDR ; 17h + dw ALLOC_HEAP ; 18h + dw FCT_RET_ERR ; 19h + dw NORM_ADDRESS ; 1Ah + dw ADD_ADDR ; 1Bh + dw ADD_A_C ; 1Ch + dw SUB_ADDR ; 1Dh + dw SUB_A_C ; 1Eh + dw EQ_ADDR ; 1Fh + dw GT_EQ_ADDR ; 20h + dw GT_EQ_ADDR ; 21h + dw CONV_A_C ; 22h + dw CARD_OVF ; 23h + dw INTEGER_OVF ; 24h + dw RANGE_ERROR ; 25h + dw PSP_POINTER ; 26H +data ends + +FAST_JUMP dw SLOW_BRANCH ; 00h + dw SLOW_BRANCH ; 01h + dw SLOW_BRANCH ; 02h + dw SLOW_BRANCH ; 03h + dw SLOW_BRANCH ; 04h + dw SLOW_BRANCH ; 05h + dw SLOW_BRANCH ; 06h + dw SLOW_BRANCH ; 07h + dw SLOW_BRANCH ; 08h + dw SLOW_BRANCH ; 09h + dw SLOW_BRANCH ; 0Ah + dw SLOW_BRANCH ; 0Bh + dw COM_CASE ; 0Ch + dw COM_CASE ; 0Dh + dw COM_CASE ; 0Eh + dw COM_CASE ; 0Fh + dw COM_CASE ; 10h + dw SLOW_BRANCH ; 11h + dw PAR_COPY ; 12h + dw SLOW_BRANCH ; 13h + dw STACK_CHECK ; 14h + dw SLOW_BRANCH ; 15h + dw SLOW_BRANCH ; 16h + dw SLOW_BRANCH ; 17h + dw ALLOC_HEAP ; 18h + dw SLOW_BRANCH ; 19h + dw Norm_ADDRESS ; 1Ah + dw ADD_ADDR ; 1Bh + dw ADD_A_C ; 1Ch + dw SUB_ADDR ; 1Dh + dw SUB_A_C ; 1Eh + dw EQ_ADDR ; 1Fh + dw GT_EQ_ADDR ; 20h + dw GT_EQ_ADDR ; 21h + dw CONV_A_C ; 22h + dw SLOW_BRANCH ; 23h + dw SLOW_BRANCH ; 24h + dw SLOW_BRANCH ; 25h + dw SLOW_BRANCH ; 26h + + public RTS_BRANCH + assume CS:code + +RTS_BRANCH: +;========== + ; This is the entry point for all the functions + ; of RTS. During execution of these functions, + ; interrupts are disabled. + ; Upon entry: + ; AL contains the function code. Parameters + ; for the functions are on stack or in registers. + ; SI and ES must not be used for parameters, + ; they are overwritten here. + ; We don't need to save all the registers, since we + ; come here on explicite demande (SWI 228) and not + ; through a hardware interrupt. + + ; Save current DS and set the one of RTS: + ; Note: in the current release, the compiler + ; does not assume the DS to hold the + ; value of the current data segment. + ; It is however safer not just to destroy it. + MOV ES, RTS_DS + assume ES:data + xor ah,ah + +;lines added to process invalid function calls properly + cmp al,NBR_FCT + jge SLOW_BRANCH + + mov si,ax + add si,si + jmp FAST_JUMP[si] ; do fast routines +; +SLOW_BRANCH: + + CALL SAVE_CPU_INFO + assume DS:data + + ; AL contains the function code + MOV FCT_CODE, AL + CMP AL, NBR_FCT + JB VALID_FCT + MOV CUR_PROCESS.PD_STATUS, ILL_FCT_CODE + JMP TERMINATE + +VALID_FCT: + xor ah, ah + MOV SI, AX + SHL SI, 1 + ; At this point: + ; AL holds the RTS-Function-Code, SI = 2 * AX. + ; DS and ES hold the Data Segment of RTS, + ; while DS of the running process is already saved + ; in the Process Descriptor. + + JMP RTS_JMP_TBL [SI] + ;*********************** That's the branch + + +;----------------------------------------------------------- + + public SAVE_CPU_INFO + +SAVE_CPU_INFO PROC NEAR +;============ + ; Utility routine to save registers in the process descr: + ; Upon entry: ES is data segment of RTS + ; Upon exit: DS is data segment of RTS + MOV ES:CUR_PROCESS.PD_DS, DS ; save process' DS + MOV DS, RTS_DS ; now switch to RTS data seg +; We have to save some more information +; (used for the P_M_DUMP and for TRANSFER): + MOV CUR_PROCESS.PD_SP, SP + MOV CUR_PROCESS.PD_BP, BP + MOV CUR_PROCESS.PD_SS, SS + POP SI ; save ret addr of caller + POP CUR_PROCESS.PD_IP + ; offset of return address + POP CUR_PROCESS.PD_CS + ; segment of return address + POP CUR_PROCESS.PD_FLAGS + ; restore the return block: + PUSH CUR_PROCESS.PD_FLAGS + PUSH CUR_PROCESS.PD_CS + PUSH CUR_PROCESS.PD_IP + PUSH SI + RET +SAVE_CPU_INFO ENDP + + +;----------------------------------------------------------- + +STACK_CHECK: +;=========== +; BX = stack clearance requested, in bytes + +; we first have to check, if the current stack is the one +; of the modula program. If we are interrupted inside MS-DOS, +; the stack points to an area inside MS-DOS and the test for +; stack-overflow we make here has no sens. + mov ax, ss + cmp ax, ES:CUR_PROCESS.PD_SS + jne SP_OK + + add bx, sp_reserve ; BX is space required on stack + mov ax, sp + sub ax, bx ; compute new limit + jb STACK_BOO ; oops, wrap thru 0 + mov ES:CUR_PROCESS.PD_SP_LIM, ax ; record limit, for heap + mov bx, ss + mov cl,4 + shr ax,cl + add bx,ax ; convert SP to paragraph pointer + mov ax,ES:CUR_PROCESS.PD_HEAP_TOP + shr ax,cl + add ax,ES:CUR_PROCESS.PD_HEAP_TOP+2 ; ditto with heap top ptr + sub bx,ax ; stack below HeapTop? + jbe STACK_BOO ; yup +SP_OK: IRET + +STACK_BOO: + CALL SAVE_CPU_INFO + MOV FCT_CODE, STACK_CHECK_FCT +;;; JMP SHORT STACK_OVF + +;----------------------------------------------------------- + + public STACK_OVF + +STACK_OVF: +;========= + ; This is the entry through RTS_BRANCH for treatment + ; of a stack overflow: + MOV CUR_PROCESS.PD_STATUS, STACK_OVF_CODE + JMP TERMINATE ; No return! + + page + + +;----------------------------------------------------------- + public DIV_BY_ZERO + +DIV_BY_ZERO: +;=========== + ; We arrive here NOT through RTS_BRANCH, but directly + ; from the interrupt, that the CPU performs in case + ; of a division by zero. So, we have to save the registers + ; that are relevant for the dump and the debugger: + MOV ES, CS: RTS_DS + CALL SAVE_CPU_INFO + ; Set the function code to some resonable value: + MOV FCT_CODE, TERMINATE_FCT + MOV CUR_PROCESS.PD_STATUS, ZERO_DIVIDE_CODE + JMP TERMINATE + +;----------------------------------------------------------- + + +M2_HALT: +;======= + ; The following registers are destroyed: SI, ES. + ; (DS is already saved) + MOV CUR_PROCESS.PD_STATUS, HALT_CODE + JMP TERMINATE + +;----------------------------------------------------------- + + +GET_RETURN_POINT: +;================ +SET_RETURN_POINT: +;================ + + JMP NOT_YET + ; Reserved entries for use in connection with + ; separate program loading and execution. + +;----------------------------------------------------------------- + +GET_OLD_PROGRAM: + ; We arrive here after termination of an + ; overlay and - more precisely - after + ; execution of TERMINATE. Stack is already set + ; to top-of-stack of father program. + ; BP and DS are restores for father program. + MOV DS, RTS_DS + + ; Save the interrupt mask of terminating program: + PUSH CUR_PROCESS.PD_PRIO_MASK + + ; We have to swap to the main process + ; of the terminating program (if father <> NIL): + MOV AX, CUR_PROCESS.PD_FATHER_PROC + 2 + CMP AX, 0FFFFH ; check if not NIL + JE REST_OLD_PD ; seg test is enough + + ; copy the status from the terminating process + ; to the P.D. of father process: + MOV CX, CUR_PROCESS.PD_STATUS + MOV TempWord, CX + ; update pointer to current P.D: + MOV CUR_P_PTR + 2, AX + MOV SI, CUR_PROCESS.PD_FATHER_PROC + MOV CUR_P_PTR, SI + + MOV CX, DS + MOV ES, CX + MOV DI, OFFSET CUR_PROCESS + MOV DS, AX + ; (DS,SI) hold addr of process descriptor + ; of father process, (ES,DI) hold addr + ; of copy in RTS. + + MOV CX, size ProcessDescriptor / 2 + rep movsw + MOV CX, ES + MOV DS, CX + MOV CX, TempWord ; copy status + MOV CUR_PROCESS.PD_STATUS, CX + +REST_OLD_PD: + POP BX ; interrupt mask of term. prog. + ; Restore old P.D.: + POP word ptr CUR_PROCESS.PD_FATHER_PROC + POP word ptr CUR_PROCESS.PD_FATHER_PROC + 2 + POP word ptr CUR_PROCESS.PD_PROG_END + POP word ptr CUR_PROCESS.PD_PROG_END + 2 + POP CUR_PROCESS.PD_SP_LIM + POP AX + MOV CUR_PROCESS.PD_PRIO_MASK, AX + ; compare current and new priority and change system's + ; priority if they are not equal: + CMP AX, BX + JE EQUAL_PRIO + CALL REST_INTERRUPT_MASK +EQUAL_PRIO: + + POP DS ; has to be restored last + ; Return to the father program: + IRET + page + +data segment +NEW_PROG_START DW ? ; variable for 'RUN_PROGRAM' +NEW_PROG_ENTRY DW ?,? ; the same +data ends + +RUN_PROGRAM: +;=========== + ; This function prepares the stack and + ; starts a new program. Parameters: + ; BX= segment addr of program area + ; (used to prepare the new stack). + ; DX:CX segment:offset of program entry point, + ; Save the parameters: + MOV NEW_PROG_START, BX + MOV NEW_PROG_ENTRY, CX + MOV NEW_PROG_ENTRY + 2, DX + + ; The old stack (current-one) still holds + ; the return block, to go back to the father + ; program upon termination. + ; Save some values of the P.D. on the old stack: + PUSH CUR_PROCESS.PD_DS ; has to be first + PUSH CUR_PROCESS.PD_PRIO_MASK + PUSH CUR_PROCESS.PD_SP_LIM + PUSH word ptr CUR_PROCESS.PD_PROG_END + 2 + PUSH word ptr CUR_PROCESS.PD_PROG_END + PUSH word ptr CUR_PROCESS.PD_FATHER_PROC + 2 + PUSH word ptr CUR_PROCESS.PD_FATHER_PROC + + ; Now, we push the entry of the termination + ; routine and set the new values for PROG_END: + MOV AX, 0 ; interrupt disable + PUSH AX ; flags + PUSH CS + MOV AX, OFFSET GET_OLD_PROGRAM + PUSH AX + PUSH DS + PUSH CUR_PROCESS.PD_BP + MOV CUR_PROCESS.PD_PROG_END + 2, SS + MOV CUR_PROCESS.PD_PROG_END, SP + + ; New value for father process. It becomes + ; NIL, because the current process will be + ; the main of the new program: + MOV AX, NIL_OFF + MOV BX, NIL_SEG + MOV CUR_PROCESS.PD_FATHER_PROC + 2, BX + MOV CUR_PROCESS.PD_FATHER_PROC, AX + + ; Now, we create the new stack: + MOV AX, CUR_PROCESS.PD_HEAP_TOP + MOV BX, CUR_PROCESS.PD_HEAP_TOP + 2 + CALL NORM_ADDR + INC BX + ; BX= seg of free memory + MOV AX, NEW_PROG_START + SUB AX, BX + JA NEW_PROG_OK + MOV CUR_PROCESS.PD_STATUS, CALL_ERR_CODE + POP BP + POP DS + IRET + ; To return in this case (error), we + ; execute the termination routine + +NEW_PROG_OK: + ; Set the new stack: + CALL COMP_STACK + MOV SS, BX + MOV SP, AX + ; the old value is stored in PROG_END + + ; Put the address of the termination routine + ; on the new stack. In case of normal termination, + ; a RETF will be executed by the program and + ; we will arrive in TERMINATE with status=normal. + PUSH CS + MOV AX, OFFSET TERMINATE + PUSH AX + + ; Now push the entry address of + ; the new program: + PUSH CUR_PROCESS.PD_FLAGS + PUSH NEW_PROG_ENTRY + 2 + PUSH NEW_PROG_ENTRY + + ; BP is set to 0FFFFH, so the debugger + ; can recognize the beginning + ; of a new overlay: + MOV BP, 0FFFFH + ; it will be pushed in new program + + ;...and call it: + IRET + + + +;--------------------------------------------------------------------------- + + +COM_CASE: +;======== +; Common Entry Point for all kind of CASE evaluations +; The actual value of the tag is in BX. +; The parameters are in the code segment, right after the INT instr. +; First fetch the return addr, to get the addr of the parameters: + POP DI + POP ES + PUSH ES ; Restore it, used for IRET + ; Get the first parameter: + MOV CX, ES: [DI] + ; Set DI to the next parameter: + INC DI + INC DI + ; Now select the corresponding routine: + CMP AL, CASE_3_CARD_FCT + JAE CASE_3 + CMP AL, CASE_2_CARD_FCT + JAE CASE_2 + ; otherwise, it must be CASE_1: + + +CASE_1: + MOV DX, CX ; just to save it + INC CX + ; Search 1 more than the actual number of value. This is needed + ; distinguish the case where the last element matches from the case + ; where no element matches. + MOV AX, BX + cld + REPNE SCASW ; Search the actual tag in the list + ; DI points now to the element after the one that matches the actual + ; tag. If no value matches, DI points to the word 2 positions after + ; the last one in the list. DI is now used as the index in the table + ; with the entry points: + SHL DX, 1 ; Size of list to skip + ADD DI, DX + PUSH ES: WORD PTR [DI] - 2 + ; Entry point for actual tag. The '-2' corrects for the incrementation + ; of DI after the search. If no element had matched, we will find the + ; address of the ELSE part. + IRET + + +CASE_2: + MOV DX, ES: [DI] ; Lowest value + ; CX holds the highest value, DX the lowest one. + ; Set DI to poin to the jumptable: + INC DI + INC DI + INC CX ; highest value + 1 + CMP AL, CASE_2_CARD_FCT + JNE CASE_2_INT +CASE_2_CARD: ; The tag is a CARDINAL + CMP BX, DX ; Test if lower than lowest value + JAE CASE_2_1 + MOV BX, CX ; actual tag was below lowest value +CASE_2_1: ; The tag is above or equal to lowest value + CMP BX, CX ; Test if higher than highest value + JB CASE_2_OK + MOV BX, CX + JMP SHORT CASE_2_OK +CASE_2_INT: ; The tag is an INTEGER + CMP BX, DX ; Test for lowest value + JGE CASE_2_2 + MOV BX, CX +CASE_2_2: ; Tag is greater or equal to lowest value + CMP BX, CX ; Test for highest value + JL CASE_2_OK + MOV BX, CX +CASE_2_OK: + SUB BX, DX ; Tag - Lowest Value + SHL BX, 1 + PUSH ES: WORD PTR [BX + DI] + IRET + + +CASE_3: + PUSH DI ; just to save it + MOV DX, 0 ; Counter +CASE_3_NEXT: + INC DX + CMP DX, CX + JA CASE_3_FOUND + ; The tag value was not found: proceed with the counter (DX) + ; pointing to the ELSE part. + MOV SI, ES: [DI] ; low limit of next intervall + ; Set DI to the next high limit: + INC DI + INC DI + CMP AL, CASE_3_CARD_FCT + JNE CASE_3_INT +CASE_3_CARD: ; Tag is a CARDINAL + CMP BX, SI + JB CASE_3_BELOW + MOV SI, ES: [DI] ; high limit + CMP BX, SI + JBE CASE_3_FOUND + JMP SHORT CASE_3_ABOVE ; It's not this one +CASE_3_INT: ; Tag is an INTEGER + CMP BX, SI + JL CASE_3_BELOW + MOV SI, ES: [DI] ; high limit + CMP BX, SI + JLE CASE_3_FOUND + JMP SHORT CASE_3_ABOVE ; It's not this one +CASE_3_BELOW: + INC DI + INC DI +CASE_3_ABOVE: + ; Set DI to the low limit of next intervall + INC DI + INC DI + JMP SHORT CASE_3_NEXT +CASE_3_FOUND: + ; DX is the index in the jumptable + ; CX is the number of listed intervalls + SHL CX, 1 + SHL CX, 1 ; CX is now size of list + POP DI + INC DI + INC DI ; DI is the addr of the list + ADD DI, CX + SHL DX, 1 + ADD DI, DX + PUSH ES: WORD PTR [DI] + IRET + + + +CASE_ERROR: +;========== + MOV CUR_PROCESS.PD_STATUS, CASE_ERR_CODE + JMP TERMINATE + + +; END CASE +;--------------------------------------------------------------------------- + + +PAR_COPY: +;======== + ; Used to copy a fix size value-parameter from its actual argument + ; into the place inside the local variables of a procedure, reserved + ; for that copy: + ; Upon entry: CX = size of parameter, + ; BX = offset, relativ to BP, where the addr of argument is + ; DI = offset, relativ to BP, where to copy it. + + MOV SI, BX + LDS SI, DWORD PTR [BP+SI] ; (DS,SI) hold source addr + MOV AX, SS + MOV ES, AX + ADD DI, BP ; (ES,DI) hold dest addr + MOV AX, CX ; save the counter + SHR CX, 1 ; number of words to copy +REP MOVSW + AND AX, 1 ; check if odd + JZ PAR_COPY_1 + MOVSB ; move the last byte, if any +PAR_COPY_1: + MOV DS, CUR_PROCESS.PD_DS + IRET + + + +DYN_PAR_COPY: +;============ + ; Used to copy a value-parameter of type ARRAY OF T from the actual + ; argument on the stack of the called procedure. The copy is placed + ; topstack and its address (SS and offset) is put in the procedure + ; interface. + ; Upon entry: CX holds size of the element of the array. + ; DI holds offset, relativ to BP, where the address and + ; the high index stand (Offset, Segment, High). + ; The low index is assumed to be zero. + ; Upon exit: The address of the copy replaces the address of the + ; original ([BP+DI] upon entry). + + MOV AX, [BP+DI] + 4 ; High index value + INC AX ; # of elements = high+1 + CMP CX, 1 + JE SIZE_IN_AX ; no multiplication needed + CMP CX, 4 + JA MUL_NEEDED + SHL AX, 1 + CMP CX, 2 + JBE SIZE_IN_AX ; NOTE: in case the size was an odd + ; number, we still have to multiply + ; by the next higher even number. + SHL AX, 1 + JMP SHORT SIZE_IN_AX +MUL_NEEDED: + MUL CX +SIZE_IN_AX: + ; Save the return block from the stack: + POP OldIP + POP OldCS + POP OldFlags + ; Check, if there is enough room on the stack: + MOV BX, AX + PUSH AX ; just to save it + PUSH DI ; just to save it + CALL SP_TEST ; returns AX<>0, if error + CMP AX, 0 + JZ STACK_GOOD + CALL STACK_OVF ; no room for the copy +STACK_GOOD: + POP DI ; restore it + POP CX ; restore it + SUB SP, CX + AND SP, 0FFFEH ; Mask out last bit, to + ; ensure an even address. + MOV DX, DS ; save DS (don't use stack) + LDS SI, DWORD PTR [BP+DI] ; Source address + MOV [BP+DI], SP ; Store the destination addr + MOV [BP+DI] + 2, SS + MOV DI, SP + MOV AX, SS + MOV ES, AX ; (ES,DI) = Dest addr + INC CX ; number of bytes + SHR CX, 1 ; CX = number of words + REP MOVSW + ; Restore the return block: + MOV DS, DX ; restore DS + PUSH OldFlags + PUSH OldCS + PUSH OldIP + MOV DS, CUR_PROCESS.PD_DS + IRET + + +; END PARAMETER_COPY +;--------------------------------------------------------------------------- + + +SP_TEST PROC near + ; Used registers: AX, BX, CX, DX, SI, DI + ; BX holds the required size. SP is checked for room to grow by + ; the required number of bytes + some reserve. AX returns 0 if ok + ; and 0FFH if overflow occurs. + ADD BX, SP_RESERVE + ; first check, if SP does not go through zero: + CMP BX, SP + JA STACK_BAD + MOV AX, SP + SUB AX, BX ; that's the new stack limit + ; update the stack limit, it is used when heap wants to grow: +; MOV CUR_PROCESS.PD_SP_LIM, AX +; removed, SP_LIM is not used in heap test (27/4/83). + MOV BX, SS + CALL NORM_ADDR ; Returns: BX=seg, AX=offset (<16) + MOV SI, AX + MOV DI, BX + MOV AX, CUR_PROCESS.PD_HEAP_TOP + MOV BX, CUR_PROCESS.PD_HEAP_TOP + 2 + CALL NORM_ADDR ; Returns: BX=seg, AX=offset (<16) + CMP DI, BX ; test segment + JA STACK_OK + JB STACK_BAD + CMP SI, AX ; test offset + JA STACK_OK +STACK_BAD: + MOV AX, 0FFH ; means: error + RET +STACK_OK: + MOV AX, 0 ; means: no error + RET +SP_TEST ENDP + + + +WRITE_STAT: +;========== + ; BX holds the status value to be interpreted + CALL WRITE_STATUS + MOV DS, CUR_PROCESS.PD_DS + IRET + +;--------------------------------------------------------------------------- + +GET_PD_ADDR: +;=========== +; Upon entry: (DX,BX) hold address, where to put the addr of CUR_PROCESS + MOV ES, DX + MOV ES:WORD PTR [BX], OFFSET CUR_PROCESS + MOV ES:WORD PTR 2[BX],DS ; DS of RTS + MOV DS, CUR_PROCESS.PD_DS + IRET + +;--------------------------------------------------------------------------- + +ALLOC_HEAP: +;========== + ; Increases the Heap by the requested size + ; (in register BX). Checks for collision + ; Heap - Stack. +;;;;;;;;; Fast procedure + MOV ES: CUR_PROCESS.PD_DS, DS + MOV AX, ES + MOV DS, AX + MOV AX, CUR_PROCESS.PD_HEAP_TOP + 2 + ADD BX, CUR_PROCESS.PD_HEAP_TOP + JC FIX_OFFSET + ; save the new heap_top: + PUSH AX ; segment + PUSH BX ; offset + JMP NORM_HEAP_TOP +FIX_OFFSET: + ; there was an overflow of the offset: + ADD AX, 1000H + PUSH AX ; new segment + PUSH BX ; and old offset + JC HEAP_BAD ; we ask for too much +NORM_HEAP_TOP: + MOV CL, 4 + SHR BX, CL + INC BX + ADD BX, AX ; normalized new segment + JC HEAP_BAD + ; BX is the segment value just above the new + ; Heap_Top. On the stack we have saved that + ; new Heap_Top. Now we have to normalize the stack: + MOV AX, SP + MOV CL, 4 + SHR AX, CL + MOV DX, SS + ADD AX, DX ; norm. stack segment + CMP AX, BX ; compare segments only + JB HEAP_BAD +HEAP_OK: + POP word ptr CUR_PROCESS.PD_HEAP_TOP + POP word ptr CUR_PROCESS.PD_HEAP_TOP + 2 +HEAP_RET: + MOV DS, CUR_PROCESS.PD_DS + IRET +HEAP_BAD: + MOV CUR_PROCESS.PD_STATUS, HEAP_OVF_CODE + POP AX ; dummy + POP AX + JMP SHORT HEAP_RET + + +;--------------------------------------------------------------------------- + +FCT_RET_ERR: +;=========== + ; This error will occur, if a function terminates without an + ; explicite RETURN statement. + MOV CUR_PROCESS.PD_STATUS, FCT_RET_ERR_CODE + JMP TERMINATE ; No return! + + +;--------------------------------------------------------------------------- + + +NORM_ADDRESS: +;============ + ; GOAL: brings an address variable in its normalized form, + ; i.e. segment as large as possible, offset = [0..15]. + ; The program is terminated in case of overflow. + ; INPUT: the address in (DS,BX) + ; OUTPUT: same as input + + MOV AX, BX + MOV BX, DS + CALL NORM_ADDR + MOV DS, BX + MOV BX, AX + JC ADDR_OVF ; address larger than 20 Bits! + IRET + +;--------------------------------------------------------------------------- + +ADD_ADDR: +;======== + ; GOAL: Adds two addresses and checks the result for overflow. + ; INPUT: the 2 addresses to add are in (DX,DI) and (DS,BX). + ; OUTPUT: the resulting address in (DS,BX). + + MOV AX, DI + ; add the offsets: + ADD AX, BX + JNC OFF_OK_1 + ; IF CARRY means: the sum of the offsets gives an overflow, + ; we have to add 1000H to the segment values: + ADD DX, 1000H + JC ADDR_OVF +OFF_OK_1: + MOV BX, DS + ; add the segments: + ADD BX, DX + JC ADDR_OVF +;;; Don't make the following shortcut! +;;; It returns a non-normalized address and +;;; therefore the address comparison is slower! +;;; CMP BX, 0F000H +;;; JB ADD_ADDR_DONE ; overflow not possible + ; check for overflow: + CALL NORM_ADDR + JC ADDR_OVF +ADD_ADDR_DONE: + MOV DS, BX + MOV BX, AX + IRET + + + +ADD_A_C: +;======= + ; GOAL: Adds an ADDRESS and a CARDINAL and checks the result + ; for overflow. + ; INPUT: the ADDRESS is in (DS,BX) and the CARDINAL in (DX) + ; OUTPUT: the resulting ADDRESS in (DS,BX). + + MOV AX, DX + ; add the offsets: + ADD AX, BX + MOV BX, DS + JNC OFF_OK_2 + ; IF CARRY means: the sum of the offsets gives an overflow, + ; so we have to add 1000H to the segment values: + ADD BX, 1000H + JC ADDR_OVF +OFF_OK_2: +;;; Don't make the following shortcut! +;;; It returns a non-normalized address and +;;; therefore the address comparison is slower! +;;; CMP BX, 0F000H +;;; JB ADD_A_C_DONE ; overflow not possible + ; check for overflow: + CALL NORM_ADDR + JC ADDR_OVF +ADD_A_C_DONE: + MOV DS, BX + MOV BX, AX + IRET + + +;--------------------------------------------------------------------------- + +ADDR_OVF: + ; This is the treatment of the overflow + ; of an address variable. + ; This routine is entered with a JUMP from + ; a fast RTS function. Therefore we have to + ; save some info for the dump: + CALL SAVE_CPU_INFO + MOV CUR_PROCESS.PD_STATUS, ADDR_OVF_CODE + JMP TERMINATE ; No return! + + +;--------------------------------------------------------------------------- + +COMM_SUB_ADDR PROC NEAR + ; performs (BX,AX) - DX, and returns result in BX (seg) and AX (off): + + CMP AX, DX ; to check, which offset is larger + JAE SUB_OFFSET + ; IF BELOW means: the offset to subtract is larger then the offset + ; of the address, so we have to borrow as much as we need from the + ; segment: + SUB DX, AX + MOV AX, DX ; DX saves the difference + ADD AX, 0FH ; AX:= (AX+15) MOD 16 + MOV CL, 4 + SHR AX, CL ; AX = number of paragraphs to borrow + SUB BX, AX ; BX = corrected segment value + JB ADDR_OVF + AND DX, 0FH ; normalized offset to subtract + MOV AX, 0 + JZ OFF_OK_3 ; the resulting offset is zero + MOV AX, 10H +SUB_OFFSET: + SUB AX, DX +OFF_OK_3: + RET +COMM_SUB_ADDR ENDP + + +SUB_ADDR: +;======== + ; GOAL: Subtracts the ADDRESS in (DX,DI) from the + ; ADDRESS in (DS,BX). The result is checked + ; for overflow and returned in (DS,BX). + + MOV AX, BX + MOV BX, DS + MOV DS, DX + MOV DX, DI + CALL COMM_SUB_ADDR + ; subtract the segments: + CALL NORM_ONE ; result in (BX,AX) + MOV CX, DS + SUB BX, CX + JB ADDR_OVF + ; check for overflow: + CALL NORM_ADDR + JC ADDR_OVF + MOV DS, BX + MOV BX, AX + IRET + + +SUB_A_C: +;======= + ; GOAL: Subtracts the CARDINAL in (DX) from the + ; ADDRESS in (DS,BX). The result is checked + ; for overflow and returned in (DS,BX). + + MOV AX, BX + MOV BX, DS + CALL COMM_SUB_ADDR + ; check for overflow: + CALL NORM_ADDR + JC ADDR_OVF + MOV DS, BX + MOV BX, AX + IRET + + +;--------------------------------------------------------------------------- + +NORM_ONE PROC NEAR + ; Normalizes 'partially' ADDRESS in (BX,AX), result in (BX,AX). + ; 'Partially' means: segment is as large as possible, offset + ; as small as possible, but the offset might be larger than 15 + ; (in case of addresses out of range). + MOV DX, AX + AND AX, 0FH + MOV CL, 4 + SHR DX, CL + ADD BX, DX ; that's the regular normalization + JC TOO_LARGE_ADDR + RET + +TOO_LARGE_ADDR: + MOV CL, 4 + INC BX ; add 1 paragraph, since the maximum + ; value for the segment is 0FFFFH. + SHL BX, CL ; transform remaining paragraphs in offset + ADD AX, BX ; complete the offset + MOV BX, 0FFFFH ; the highest value for the segment + RET +NORM_ONE ENDP + + +EQ_ADDR: +;======= + ; Compares two ADDRESSes for equality. The values are passed + ; in (DS,BX) and (DX,DI) and the result is in BL (0 = FALSE, + ; 1 = TRUE). The input values are allowed to be out of the + ; legal ADDRESS-range. +; FAST routine. We optimize the path, where the addresses are +; not equal, but have the same segment value. This is the most +; frequent case, when searching elements allocated in the same heap. + + ; first check, if they differ in the last 4 bits: + MOV AX, BX + AND BL, 0FH ; mask out the last 4 bits + MOV CX, DI + AND CL, 0FH + CMP BL, CL + JNE THEY_ARE_DIFF + ; next we check if 1 part of addr is equal: + MOV BX, DS + CMP AX, DI ; compare offsets + JE SAME_OFFSET + CMP BX, DX ; compare segments + JNE DO_NORMALIZE +THEY_ARE_DIFF: + MOV BL, 0 ; value for NOT EQUAL + IRET +SAME_OFFSET: + CMP BX, DX ; compare segments + JNE THEY_ARE_DIFF +THEY_ARE_EQUAL: + MOV BL, 1 ; value for EQUAL + IRET + +DO_NORMALIZE: + MOV SI, DX ; second par in (SI,DI) + CALL NORM_ONE + XCHG BX, SI + XCHG AX, DI + CALL NORM_ONE + ; now, compare the 2 norm. addresses + CMP BX, SI + JNE THEY_ARE_DIFF + CMP AX, DI + JNE THEY_ARE_DIFF + JMP SHORT THEY_ARE_EQUAL + + + +GT_EQ_ADDR: +;========== + ; This routine performs both comparisons, GREATER and + ; GREATER or EQUAL of two ADDRESSes (a1 > a2, a1 >= a2). + ; The ADDRESS a1 is passed in (DX,DI), a2 in (DS,BX). + ; They are allowed to be out of the legal ADDRESS-range. + ; The result is in BL (0 = FALSE, 1 = TRUE). +; FAST routine. We optimize the path, where the addresses +; have same segment value, but different offset. + + MOV SI, AX ; the function code + MOV AX, BX + MOV BX, DS + ; check if segments are equal: + CMP BX, DX + JNE DIFF_SEGMENTS + ; segments are equal: + CMP AX, DI ; compare offsets + JA COND_FALSE ; its LESS THAN + JB COND_TRUE ; its GREATER + ; they are equal: + CMP SI, GT_ADDR_FCT + JE COND_FALSE +COND_TRUE: + MOV BL, 1 + IRET +COND_FALSE: + MOV BL, 0 + IRET + +DIFF_SEGMENTS: + MOV DS, SI + MOV SI, DX ; a1 is in (SI,DI) + CALL NORM_ONE ; normalize a2 + XCHG BX, SI + XCHG AX, DI + CALL NORM_ONE ; normalize a1 + ; now compare the 2 normalized addresses: + CMP BX, SI ; compare segments + JA COND_TRUE + JB COND_FALSE + + ; the segments are equal, now we compare the offsets: + ; Here we have to distinguish between the comp. GT / GT_EQ: + MOV SI, DS + CMP SI, GT_ADDR_FCT + JNE GT_EQ_TEST +GT_TEST: + CMP AX, DI + JA COND_TRUE + JMP SHORT COND_FALSE +GT_EQ_TEST: + CMP AX, DI + JAE COND_TRUE + JMP SHORT COND_FALSE + + + +;--------------------------------------------------------------------------- + +CONV_A_C: +;======== + ; Converts an address in (DS,BX) into a CARDINAL and returns + ; it in DX. The result is checked for overflow: + + MOV DX, DS + MOV CL, 4 + SHL DX, CL ; base * 16 + JC BAD_CONVERT + ADD DX, BX ; result = (base * 16) + offset + JC BAD_CONVERT + IRET +BAD_CONVERT: + CALL SAVE_CPU_INFO +;;; JMP SHORT CARD_OVF + + +;--------------------------------------------------------------------------- + +CARD_OVF: +;======== + ; Treats the CARDINAL overflow: generate a P_M_DUMP, set the process + ; status to CARD_OVF_CODE and terminates the current program: + MOV CUR_PROCESS.PD_STATUS, CARD_OVF_CODE + JMP TERMINATE ; No return! + + +;--------------------------------------------------------------------------- + +INTEGER_OVF: +;=========== + ; Treats the INTEGER overflow: generate a P_M_DUMP, set the process + ; status to INTEGER_OVF_CODE and terminates the current program: + MOV CUR_PROCESS.PD_STATUS, INTEGER_OVF_CODE + JMP TERMINATE ; No return! + + +;--------------------------------------------------------------------------- + +RANGE_ERROR: +;=========== + ; Treats the RANGE ERROR: generate a P_M_DUMP, set the process + ; status to RANGE_ERR_CODE and terminates the current program: + MOV CUR_PROCESS.PD_STATUS, RANGE_ERR_CODE + JMP TERMINATE ; No return! + + +;------------------------------------------------------------------------ + +PSP_POINTER: +;========== + ; Returns a pointer to a static copy of the program segment + ; prefix (PSP) for the RTS. + ; The address is returned in (CX:BX) + LDS BX, BASE_PAGE_PTR + MOV CX, DS + MOV DS, CUR_PROCESS.PD_DS + IRET + +;------------------------------------------------------------------------ + +;data segment +;NYI DB 'RTS-function not yet implemented: $' +;data ends + +NOT_YET: +;======= + ; This function can be called by RTS-functions + ; that are not yet implemented: +; MOV DX, OFFSET NYI +; CALL WRITE_MSG +; MOV AL, FCT_CODE +; CALL WRITE_BYTE +; CALL WRITE_LN +; MOV DS, CUR_PROCESS.PD_DS +; IRET + + MOV CUR_PROCESS.PD_STATUS, ILL_FCT_CODE + JMP TERMINATE + ; No Return! + code ends + end + \ No newline at end of file diff --git a/Logitech Modula-2 v1/SIEVE.MOD b/Logitech Modula-2 v1/SIEVE.MOD new file mode 100644 index 0000000..e744850 --- /dev/null +++ b/Logitech Modula-2 v1/SIEVE.MOD @@ -0,0 +1,46 @@ +(*********************************************************************) +(* The Sieve Benchmark *) +(* *) +(* Compile with test, overflow switches off and native code on. *) +(* *) +(*********************************************************************) +(*$S-*) +(*$R-*) +(*$T-*) + +MODULE sieve; + +FROM SYSTEM IMPORT WORD, BYTE, ADDRESS; +FROM NumberConversion IMPORT StringToCard; +FROM Strings IMPORT Assign; +FROM InOut IMPORT WriteLn, WriteInt, WriteCard, WriteString; + +CONST + size = 8190; + +VAR + flags : ARRAY [ 0 .. size ] OF BOOLEAN; + i, prime, k, count, iter : CARDINAL; + ch : CHAR; + +BEGIN + FOR iter := 1 TO 10 DO + count := 0; + FOR i := 0 TO size DO flags[i] := TRUE END; + FOR i := 0 TO size DO + IF flags[i] THEN + prime := i + i + 3; + k := i + prime; + WHILE k <= size DO + flags[k] := FALSE; + k := k + prime; + END; + count := count + 1; + END; + END; + END; + WriteString( "count of primes: " ); + WriteCard( count, 0 ); + WriteLn; +(* WRITELN( count, " primes" ); *) +END sieve. diff --git a/Logitech Modula-2 v1/STORAGE.DEF b/Logitech Modula-2 v1/STORAGE.DEF new file mode 100644 index 0000000..20b34c6 --- /dev/null +++ b/Logitech Modula-2 v1/STORAGE.DEF @@ -0,0 +1,54 @@ +DEFINITION MODULE Storage; +(* + Standard dynamic storage management + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. + + + Storage management for dynamic variables. Calls to the + Modula-2 standard procedures NEW and DISPOSE are translated + into calls to ALLOCATE and DEALLOCATE. The standard way to + provide these two procedures is to import them from this + module 'Storage'. +*) + +FROM SYSTEM IMPORT ADDRESS; + +EXPORT QUALIFIED + ALLOCATE, DEALLOCATE, Available, InstallHeap, RemoveHeap; + + +PROCEDURE ALLOCATE (VAR a: ADDRESS; size: CARDINAL); +(*- Allocate some dynamic storage. +in: size number of bytes to allocate, +out: a ADDRESS of allocated storage. + +The actual number of bytes allocated may be slightly greater +than 'size', due to administrative overhead. +If not enough space is available, the calling program is +terminated with the status 'heapovf'. +*) + +PROCEDURE DEALLOCATE (VAR a: ADDRESS; size: CARDINAL); +(*- Release some dynamic storage. +in: a ADDRESS of the area to release, + size number of bytes to be released, +out: a set to NIL. +*) + +PROCEDURE Available (size: CARDINAL) : BOOLEAN; +(*- Test whether some number of bytes could be allocated. +in: size number of bytes +out: TRUE if ALLOCATE(p,size) would succeed. +*) + +PROCEDURE InstallHeap; +(*- Used by the loader -*) + +PROCEDURE RemoveHeap; +(*- Used by the loader -*) + +END Storage. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/STORAGE.LNK b/Logitech Modula-2 v1/STORAGE.LNK new file mode 100644 index 0000000..1370de8 Binary files /dev/null and b/Logitech Modula-2 v1/STORAGE.LNK differ diff --git a/Logitech Modula-2 v1/STORAGE.REF b/Logitech Modula-2 v1/STORAGE.REF new file mode 100644 index 0000000..65207eb Binary files /dev/null and b/Logitech Modula-2 v1/STORAGE.REF differ diff --git a/Logitech Modula-2 v1/STORAGE.SYM b/Logitech Modula-2 v1/STORAGE.SYM new file mode 100644 index 0000000..904200a Binary files /dev/null and b/Logitech Modula-2 v1/STORAGE.SYM differ diff --git a/Logitech Modula-2 v1/STRINGS.DEF b/Logitech Modula-2 v1/STRINGS.DEF new file mode 100644 index 0000000..bfb49a3 --- /dev/null +++ b/Logitech Modula-2 v1/STRINGS.DEF @@ -0,0 +1,103 @@ +DEFINITION MODULE Strings; +(* + Variable-length character strings handler. + + + NOTE: For most of these string handling procedures,there is the + possibility of the user not providing a variable large enough to + contain the result of a string operation. + Should this possibility arise truncation may result,as there + will be no other error notification. + The implementation of this module must not cause a range error, + it should instead silently truncate. + + String variables have the following characteristics: + They are ARRAY OF CHAR + Lowest bound must be 0 + The size of the string is the size of the string + variable unless the null character (0C) occurs in + the string to indicate end of string. +*) + +EXPORT QUALIFIED Assign, Insert, Delete, + Pos, Copy, Concat, Length, CompareStr; + +PROCEDURE Assign (VAR source, dest: ARRAY OF CHAR); +(*- Assign the contents of string variable source into string variable dest +in: source +out: dest +*) + +PROCEDURE Insert (substr: ARRAY OF CHAR; + VAR str: ARRAY OF CHAR; + inx: CARDINAL); +(*- Insert the string substr into str,starting at str[inx]. +in: substr + str + inx +out: str + +If inx is equal or greater than Length(str) then substr is appended +to end of dest. +*) + +PROCEDURE Delete (VAR str: ARRAY OF CHAR; + inx: CARDINAL; + len: CARDINAL); +(*- Delete len characters from str, starting at str[inx]. +in: str + inx + len +out: str + +If inx >= Length(str) then nothing happens. +If there are not len characters to delete, characters to +the end of string are deleted. +*) + +PROCEDURE Pos (substr, str: ARRAY OF CHAR): CARDINAL; +(*- Return the index into str of the first occurrence of the substr. +in: substr + str + +Pos returns a value greater then HIGH(str) if no occurrence of the +substring is found +*) + +PROCEDURE Copy (str: ARRAY OF CHAR; + inx: CARDINAL; + len: CARDINAL; + VAR result: ARRAY OF CHAR); +(*- Copy at most len characters from str into result. +in: str source string, + inx starting position in 'str', + len maximum number of characters to copy, +out: result copied string +*) + +PROCEDURE Concat (s1, s2: ARRAY OF CHAR; + VAR result: ARRAY OF CHAR); +(*- Concatenate two strings. +in: s1 left string, + s2 right string, +out: result receives left string followed by right string. +*) + +PROCEDURE Length (VAR str: ARRAY OF CHAR): CARDINAL; +(*- Return the number of characters in a string. +in: str +*) + +PROCEDURE CompareStr (s1, s2: ARRAY OF CHAR): INTEGER; +(*- Compare two strings. +in: s1 + s2 + +Returns an integer value indicating the comparison result: + -1 if s1 is less than s2; + 0 if s1 equals s2; + 1 if s1 is greater than s2 +*) + +END Strings. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/STRINGS.LNK b/Logitech Modula-2 v1/STRINGS.LNK new file mode 100644 index 0000000..e2a2345 Binary files /dev/null and b/Logitech Modula-2 v1/STRINGS.LNK differ diff --git a/Logitech Modula-2 v1/STRINGS.REF b/Logitech Modula-2 v1/STRINGS.REF new file mode 100644 index 0000000..105b1d5 Binary files /dev/null and b/Logitech Modula-2 v1/STRINGS.REF differ diff --git a/Logitech Modula-2 v1/STRINGS.SYM b/Logitech Modula-2 v1/STRINGS.SYM new file mode 100644 index 0000000..170af7f Binary files /dev/null and b/Logitech Modula-2 v1/STRINGS.SYM differ diff --git a/Logitech Modula-2 v1/SYMFILE.LOD b/Logitech Modula-2 v1/SYMFILE.LOD new file mode 100644 index 0000000..9a5a787 Binary files /dev/null and b/Logitech Modula-2 v1/SYMFILE.LOD differ diff --git a/Logitech Modula-2 v1/SYSTEM.DEF b/Logitech Modula-2 v1/SYSTEM.DEF new file mode 100644 index 0000000..494443e --- /dev/null +++ b/Logitech Modula-2 v1/SYSTEM.DEF @@ -0,0 +1,201 @@ +DEFINITION MODULE System; +(* + Additional system-dependent facilities + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. + + + This module may be seen as an extension of the standard + pseudo-module SYSTEM. +*) + + +FROM SYSTEM IMPORT ADDRESS, PROCESS; + +EXPORT QUALIFIED + EOL, + Status, Terminate, + ProcessDescriptor, ProcessPtr, curProcess, + targetSystem, + SetTime, GetTime, Time, + TermProcedure, CallTermProc, InitProcedure, CallInitProc, + RTSCall, + RegAX, RegBX, + RegCX, RegDX, + RegSI, RegDI, + RegES, RegDS, + RegCS, RegSS, + RegBP, RegSP; + + +CONST + EOL = 36C; + (* This constant defines the internal name of the + End-Of-Line character. Using this constant has the + advantage, that only one character is used to + specify line ends (as opposed to CR/LF). + The standard I/O modules interpret this character + and transform it into the End-Of-Line (sequence of) + code(s) required by the device they support. See + definition modules of 'Terminal' and 'FileSystem'. + *) + +TYPE + Status = (normal, warned, + (* no dump produced for these two cases *) + stopped, asserted, halted, + caseerr, stackovf, heapovf, + functionerr, addressoverflow, realoverflow, + cardinaloverflow, integeroverflow, rangeerr, + dividebyzero, coroutineend, + loaderr, callerr, programnotfound, modulenotfound, + incompatiblemodule, filestructureerr, + illegalinstr, RTSfunctionerr, interrupterr); + + (* This type defines the possible values for a program's + status. The meaning of these values can be printed to + the terminal by means of ProgMessage.WriteStatus . + *) + + +PROCEDURE Terminate (st: Status); +(*- Terminate the current (sub) program. +in: st terminating status. + +If the value of 'st' is different from 'normal' or 'warned', +memory is dumped on the disk file MEMORY.PMD, which can be used +for subsequent debugging. The value of 'st' will be returned +to the caller of the terminating program by means of the parameter +'st' of the procedure 'Program.Call'. + +This procedure never returns to the caller. +*) + + +TYPE + ProcessDescriptor = RECORD + AX, BX, CX, DX, SP, BP, SI, DI : CARDINAL; + DS, SS, ES, CS, IP : CARDINAL; + flags : BITSET; + status : Status; + programId, auxId, sharedId : CARDINAL; + fatherProcess : PROCESS; + stackLimit : CARDINAL; + interruptMask : BITSET; + retStack : CARDINAL; + progEndStack : ADDRESS; + intVector : CARDINAL; + oldISR, interruptedProcess : ADDRESS; + heapBase, heapTop : ADDRESS; + modTable : ADDRESS; + END; + + +TYPE + ProcessPtr = POINTER TO ProcessDescriptor; + + +VAR + curProcess: ProcessPtr; + (* Points at any moment to the current process's workspace. + This variable is 'read-only' and must not be used in + application programs. + WARNING: improper use of this variable may cause unpredictable + ======= behaviour of the system. + *) + + +CONST + targetSystem = 0; (* first implementation *) + (* May be used to check compatibility of file or programs with the + present system. + *) + + + +TYPE Time = RECORD day, minute, millisec: CARDINAL; END; + (* 'day' is : Bits 0..4 = day of month (1..31), + Bits 5..8 = month of the year (1..12), + Bits 9..15 = year - 1900. + 'minute' is hour * 60 + minutes. + 'millisec' is second * 1000 + milliseconds, + starting with 0 at every minute. + *) + +PROCEDURE GetTime (VAR curTime: Time); +(*- Return the current date and time. +out: curTime record containing date and time. + +On systems which do not keep date or time, 'GetTime' +returns a pseudo-random number. +*) + +PROCEDURE SetTime (curTime: Time); +(*- Set the current date and time. +in: curTime record containing date and time. + +On systems which do not keep date or time, this call has no effect. +*) + + + +PROCEDURE TermProcedure (p: PROC); +(*- Declare a termination routine. +in: p termination procedure. + +The procedure 'p' will be called upon termination of the current +program or subprogram. +Typical use is for drivers, which have to release resources +used by the terminating program. +Up to 20 termination routines can be installed. +*) + +PROCEDURE CallTermProc; +(*- Call all termination procedures for the current program. + +Calls all procedures declared with 'TermProcedure' in the current +program. 'CallTermProc' is automatically called at the termination +of a program or subprogram. +*) + +PROCEDURE InitProcedure (p: PROC); +(*- Declare an initialization routine. +in: p initialization procedure. + +Analoguous to 'TermProcedure', but for routines that have +to be called before execution of a program. +Up to 20 initialization routines can be installed. +*) + +PROCEDURE CallInitProc; +(*- Call all initialization procedures for the current program. + +Analoguous to 'CallTermProc'. +*) + + +CONST + RTSCall = 228; + (* Interrupt vector for general entry of RTS (for + Run-Time Support). The RTS is a resident assembly + program, providing the basic support for running + Modula-2 programs. + *) + +CONST + (* Define the processor's registers, which may be + used as parameters for the standard procedures + SETREG and GETREG (except that SP, BP, CS, SS + may not be used with SETREG). + *) + RegAX = 0; RegCX = 1; + RegDX = 2; RegBX = 3; + RegSP = 4; RegBP = 5; + RegSI = 6; RegDI = 7; + RegES = 8; RegCS = 9; + RegSS = 10; RegDS = 11; + +END System. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/SYSTEM.LNK b/Logitech Modula-2 v1/SYSTEM.LNK new file mode 100644 index 0000000..c59de5e Binary files /dev/null and b/Logitech Modula-2 v1/SYSTEM.LNK differ diff --git a/Logitech Modula-2 v1/SYSTEM.REF b/Logitech Modula-2 v1/SYSTEM.REF new file mode 100644 index 0000000..3ec0849 Binary files /dev/null and b/Logitech Modula-2 v1/SYSTEM.REF differ diff --git a/Logitech Modula-2 v1/SYSTEM.SYM b/Logitech Modula-2 v1/SYSTEM.SYM new file mode 100644 index 0000000..abb85b2 Binary files /dev/null and b/Logitech Modula-2 v1/SYSTEM.SYM differ diff --git a/Logitech Modula-2 v1/TERMBASE.DEF b/Logitech Modula-2 v1/TERMBASE.DEF new file mode 100644 index 0000000..83b9107 --- /dev/null +++ b/Logitech Modula-2 v1/TERMBASE.DEF @@ -0,0 +1,111 @@ +DEFINITION MODULE Termbase; +(* + Terminal input/output with redirection hooks + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +[Private module of the Modula-2 system] +*) + + +EXPORT QUALIFIED + ReadProcedure, StatusProcedure, WriteProcedure + AssignRead, AssignWrite, UnAssignRead, UnAssignWrite, + Read, KeyPressed, Write; + + +TYPE ReadProcedure = PROCEDURE (VAR CHAR); + (* To assign a private read procedure (for redirection of + input) a procedure of type 'ReadProcedure' must + be provided. This procedure returns a character + from the input device. It waits until a character + hes been entered. + *) + +TYPE StatusProcedure = PROCEDURE (): BOOLEAN; + (* To assign a private status-procedure (for redirection of + input) a procedure of type 'StatusProcedure' must + be provided. This procedure returns TRUE, if a + character is available to read, FALSE otherwise. + *) + + +TYPE WriteProcedure = PROCEDURE (CHAR); + (* To assign a private write procedure (for redirection of + output) a procedure of type 'WriteProcedure' must + be provided. This is typically used to redirect + output to a file or to the screen and a file (log file). + Special interpretation of characters sent to the + screen can be performed in such a private driver + procedure. + *) + + +PROCEDURE AssignRead (rp: ReadProcedure; sp: StatusProcedure; + VAR done: BOOLEAN); +(*- Install read and status routines for terminal input. +in: rp read-a-character procedure, + sp is-character-available function, +out: done TRUE if the installation was done. + +Initially the corresponding procedures of 'Keyboard' are installed. + +Subsequent assignments from the same program overwrite the previous +assignments. Upon termination of a program, the read and status +procedures allocated by that program are removed. Read procedures +are sharable resources (see module 'Program'). + +Up to six levels of re-assignment (corresponding to six levels +of program) are allowed: Done = FALSE if this depth is exceeded. +*) + + +PROCEDURE AssignWrite (wp: WriteProcedure; VAR done: BOOLEAN); +(*- Install write routine for terminal output. +in: wp character output procedure, +out: done set TRUE if the installation was done. + +[See AssignRead above.] +Initially the procedure Display.Write is assigned. +*) + +PROCEDURE UnAssignRead (VAR done: BOOLEAN); +(*- Undo the last AssignRead by the current program. +out: done set TRUE if there was something to unassign. + +The previously valid procedures become active again. +*) + +PROCEDURE UnAssignWrite (VAR done: BOOLEAN); +(*- Undo the last AssignWrite by the current program. +out: done set TRUE if there was something to unassign. + +The previously valid procedure becomes active again. +*) + + +PROCEDURE Read (VAR ch: CHAR); +(*- Read a character using the current input procedure. +out: ch the character read, or NUL. + +If no character is available, NUL (0C) is returned. +Uses the current status-procedure and read-procedure. +*) + +PROCEDURE KeyPressed (): BOOLEAN; +(*- Test if a character is available from the current input. + +Uses the current status-procedure, as assigned by AssignRead. +*) + + +PROCEDURE Write (ch: CHAR); +(*- Write a character to the current output. +in: ch character to write. + +Uses the current write-procedure as assigned by AssignWrite. +*) + +END Termbase. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/TERMBASE.LNK b/Logitech Modula-2 v1/TERMBASE.LNK new file mode 100644 index 0000000..6d30175 Binary files /dev/null and b/Logitech Modula-2 v1/TERMBASE.LNK differ diff --git a/Logitech Modula-2 v1/TERMBASE.REF b/Logitech Modula-2 v1/TERMBASE.REF new file mode 100644 index 0000000..85a4b9a Binary files /dev/null and b/Logitech Modula-2 v1/TERMBASE.REF differ diff --git a/Logitech Modula-2 v1/TERMBASE.SYM b/Logitech Modula-2 v1/TERMBASE.SYM new file mode 100644 index 0000000..52ca4ed Binary files /dev/null and b/Logitech Modula-2 v1/TERMBASE.SYM differ diff --git a/Logitech Modula-2 v1/TERMINAL.DEF b/Logitech Modula-2 v1/TERMINAL.DEF new file mode 100644 index 0000000..5d47616 --- /dev/null +++ b/Logitech Modula-2 v1/TERMINAL.DEF @@ -0,0 +1,70 @@ +DEFINITION MODULE Terminal; +(* + Terminal Input/Output + + +Derived from the Lilith Modula-2 system developed by the +group of Prof. N. Wirth at ETH Zurich, Switzerland. +*) + + +EXPORT QUALIFIED Read, KeyPressed, ReadAgain, ReadString, + Write, WriteString, WriteLn; + + +PROCEDURE Read (VAR ch: CHAR); +(*- Read a character from the terminal. +out: ch character that was read. + +The character is not echoed. +Code ASCII.cr from keyboard is transformed into System.EOL. +*) + +PROCEDURE KeyPressed (): BOOLEAN; +(*- Test if a character is available to Read from terminal. +*) + +PROCEDURE ReadAgain; +(*- Undo the last read: Make the last character be re-read. +*) + +PROCEDURE ReadString(VAR string: ARRAY OF CHAR); +(*- Read a line from the terminal. +out: string receives the text of the line + +Characters are accepted (and echoed) from the keyboard until +is entered. The is not returned or echoed. + and can be used for editing. +Tabs may be entered, but are expanded into blanks immediately. +No other control characters may be entered. +*) + +PROCEDURE Write (ch: CHAR); +(*- Write a character to the terminal. +in: ch character to be written. + +If terminal output has not been redirected, the following +interpretations are made: + + System.EOL (36C) = go to beginning of next line + ASCII.ff (14C) = clear screen and set cursor home + ASCII.del (177C) = erase the last character on the left + ASCII.bs (10C) = move 1 character to the left + ASCII.cr (15C) = go to beginning of current line + ASCII.lf (12C) = move 1 line down, same column +*) + +PROCEDURE WriteString (string: ARRAY OF CHAR); +(*- Write a string to the terminal. +in: string string to be written. + +The string can be terminated by a NUL (0C). +*) + +PROCEDURE WriteLn; +(*- Write a new-line to the terminal. +[Equivalent to Write(EOL)] +*) + +END Terminal. + \ No newline at end of file diff --git a/Logitech Modula-2 v1/TERMINAL.LNK b/Logitech Modula-2 v1/TERMINAL.LNK new file mode 100644 index 0000000..a9cef16 Binary files /dev/null and b/Logitech Modula-2 v1/TERMINAL.LNK differ diff --git a/Logitech Modula-2 v1/TERMINAL.REF b/Logitech Modula-2 v1/TERMINAL.REF new file mode 100644 index 0000000..8db42ea Binary files /dev/null and b/Logitech Modula-2 v1/TERMINAL.REF differ diff --git a/Logitech Modula-2 v1/TERMINAL.SYM b/Logitech Modula-2 v1/TERMINAL.SYM new file mode 100644 index 0000000..97eec29 Binary files /dev/null and b/Logitech Modula-2 v1/TERMINAL.SYM differ diff --git a/Logitech Modula-2 v1/TRANSFER.ASM b/Logitech Modula-2 v1/TRANSFER.ASM new file mode 100644 index 0000000..8282411 --- /dev/null +++ b/Logitech Modula-2 v1/TRANSFER.ASM @@ -0,0 +1,817 @@ +;********************************************************************** +; +; Copyrigth (C) 1984 Logitech. All Rights Reserved. +; +; Permission is hereby granted to registered users to use or +; abstract the following program in the implementation of +; customized versions. This permission does not include the +; right to redistribute the source code of this program. +; +; +; Modula-2/86 Run Time Support package +; +; TRANSFER.ASM - Process/Interrupt Module +; +; Release 1.0 - Jan 24 84 +; +;******************************************************* + + include RTS.INC + +data segment public + extrn CUR_PROCESS:byte ;:ProcessDescriptor + extrn CUR_P_PTR:dword + extrn FCT_CODE:byte +WAITING_PROC dd 0FFFF000Fh + rept NBR_ISR-1 + dd 0FFFF000Fh + endm +; Room for 8 process descriptors, waiting on an interrupt +INT_VECT_OWNER dw NBR_ISR dup ( NIL_CARD ) +; This array holds for every used Interrupt Vector the program id of the owner +TEMP_W dd ? +TEMP_B dd ? +TEMP_P_D ProcessDescriptor ; scratch process descrip. + + + MASK_8259 EQU 21H ; port address of control word 1 + CTRL_W2_8259 EQU 20H ; port address of control word 2 + EOI_8259 EQU 20H ; end-of-interrupt code + BASE_8259 EQU 08H ; first interrupt handled by 8259 + MAX_PRIO_LEVEL EQU 07H ; priority levels 0..MAX_PRIO_LEVEL + +;;; removed jan 24 84: +;OLD_MASK DB NBR_ISR DUP (?) +; ; holds for every ISR the old value of the mask-bit +;NEW_MASK DB NBR_ISR DUP (?) +; ; holds for every used ISR a 1 in the bit, which corresponds +; ; to the mask-bit in the 8259 or a value 0FFH if not handled +; ; by the 8259 + +PRIORITY_MASKS DB 1,3,7,0FH,1FH,3FH,7FH,0FFH + ; his mask may be changed to implement any + ; desired priority schema. + + +data ends + +code segment public + extrn RTS_DS:word ; part of code segment + extrn NORM_ADDR:near + extrn COMP_STACK:near + extrn STACK_OVF:near + extrn TERMINATE:near + extrn SAVE_CPU_INFO:near + + assume CS:code, DS:data +;------------------------------------------------------------ + + + public TRANSFER +TRANSFER: +;======== +; The registers needed for the TRANSFER are already saved. +; Swap the Return Address and the parameters: (interrupts better be off!) + MOV BP, SP + POP WORD PTR TEMP_W ; RetAdd + POP WORD PTR TEMP_W+2 ; RetCodeSeg + POP CUR_PROCESS.PD_FLAGS +; Move the parameters: + POP [BP] + POP 2[BP] + POP 4[BP] + POP 6[BP] + PUSH CUR_PROCESS.PD_FLAGS ; reconstruct interrupt frame + PUSH WORD PTR TEMP_W+2 ; underneath parameters! + PUSH WORD PTR TEMP_W ; flags, segment, offset + MOV CUR_PROCESS.PD_SP, SP ; save SP above parameters.. + SUB SP, 8 ; Set SP so parameters can be popped + + +TRANSFER_BODY: + ; This is the part of TRANSFER, that is used for all transfer + ; functions: TRANSFER, IOTRANSFER, Interrupt Service Routines. + ; Params: 0[SP] ADR of process variable of process to be activated, + ; 4[SP] ADR of p. var., where to save the current one + + ; Get the addr of the NEW process descriptor and copy it into + ; the TEMP_P_D area. This is required by the semantic of this function! + PUSH DS + POP ES ; Destination Segment + ; In the parameter-list is the addr of the pointer (VARPAR): + POP DI + POP DS + LDS SI, dword ptr [DI] + ; save the parameter for the assignement to CUR_P_PTR (see below): + MOV ES: WORD PTR TEMP_B, SI + MOV ES: WORD PTR TEMP_B + 2, DS + MOV DI, OFFSET TEMP_P_D + MOV CX, (size ProcessDescriptor)/2 + REP MOVSW ; Copy it into the TEMP_P_D area + + ; Copy the current-one in the OLD process descriptor: + PUSH ES + POP DS + LES DI, CUR_P_PTR + MOV SI, OFFSET CUR_PROCESS + MOV CX, (size ProcessDescriptor)/2 + REP MOVSW + ; ... and update the varpar: + POP DI + POP ES ; This is the addr of the varpar + MOV SI,OFFSET CUR_P_PTR ; It holds the original of the P.D. + movsw + movsw + + ; Update interrupt mask in current process descriptor: + IN AL, MASK_8259 + XOR AH, AH + MOV CUR_PROCESS.PD_PRIO_MASK, AX + + ; check if both processes have the same priority: + CMP AX, TEMP_P_D.PD_PRIO_MASK ; TEMP_P_D is the new one + JE PRIORITY_SET + ; we have to change the processor's priority: + MOV AX, TEMP_P_D.PD_PRIO_MASK ; the new one + OUT MASK_8259, AL +PRIORITY_SET: + + ; Now, we copy the TEMP_P_D area into the CURRENT descriptor: + PUSH DS + POP ES + MOV SI, OFFSET TEMP_P_D + MOV DI, OFFSET CUR_PROCESS + MOV CX, (size ProcessDescriptor)/2 + REP MOVSW + ; ... and set the pointer to the new process: + MOV SI, OFFSET TEMP_B + MOV DI, OFFSET CUR_P_PTR + movsw + movsw + + ; Now, we restore the machine state: + MOV SS, CUR_PROCESS.PD_SS + MOV SP, CUR_PROCESS.PD_SP + MOV DS, CUR_PROCESS.PD_DS + PUSH DS ; We'll restore it at the very end + MOV AX, ES + MOV DS, AX + MOV ES, CUR_PROCESS.PD_ES + MOV DI, CUR_PROCESS.PD_DI + MOV SI, CUR_PROCESS.PD_SI + MOV BP, CUR_PROCESS.PD_BP + MOV DX, CUR_PROCESS.PD_DX + MOV CX, CUR_PROCESS.PD_CX + MOV BX, CUR_PROCESS.PD_BX + MOV AX, CUR_PROCESS.PD_AX + POP DS ; The new-one + IRET ; resume the new process! + +; END TRANSFER +;------------------------------------------------------------ + + + +; Interrupt service routines: +; ========================== +; There is a fix number of interrupts, that can be treated simultanously. +; Here we allow up to 8 or 16 interrupts at a time, depending on the +; value of 'NBR_ISR'. +; The routines ISRn are the entry points to the common Interrupt +; Service Routine (COM_ISR). +; Every routine is 4 bytes long. This fact is used implicitly in COM_ISR +; and in IOTRANSFER. The Call to COM_ISR allows the identification of the +; Interrupt Vector (return addr of the Call). + +ISR0: NOP + CALL COM_ISR +ISR1: NOP + CALL COM_ISR +ISR2: NOP + CALL COM_ISR +ISR3: NOP + CALL COM_ISR +ISR4: NOP + CALL COM_ISR +ISR5: NOP + CALL COM_ISR +ISR6: NOP + CALL COM_ISR +ISR7: NOP + CALL COM_ISR + +IF NBR_ISR / 8 + ; This block of 8 Interrupt Service Routines has to be repeated for + ; every additional 8259: + +ISR8: NOP + CALL COM_ISR +ISR9: NOP + CALL COM_ISR +ISR10: NOP + CALL COM_ISR +ISR11: NOP + CALL COM_ISR +ISR12: NOP + CALL COM_ISR +ISR13: NOP + CALL COM_ISR +ISR14: NOP + CALL COM_ISR +ISR15: NOP + CALL COM_ISR + +ENDIF + + +COM_ISR: + ; Common part of the Interrupt Service Routines + ; Save all the registers, except SP (has yet to be adjusted) + ; and CS, IP, Flags. They are on the stack and will be + ; used directly there (in the IRET of the next TRANSFER): + PUSH DS + MOV DS, RTS_DS + POP CUR_PROCESS.PD_DS + MOV CUR_PROCESS.PD_AX, AX + MOV CUR_PROCESS.PD_BX, BX + MOV CUR_PROCESS.PD_CX, CX + MOV CUR_PROCESS.PD_DX, DX + MOV CUR_PROCESS.PD_BP, BP + MOV CUR_PROCESS.PD_SI, SI + MOV CUR_PROCESS.PD_DI, DI + MOV CUR_PROCESS.PD_SS, SS + MOV CUR_PROCESS.PD_ES, ES + ; Find the interrupt vector: + POP BX ; Return addr of ISRn + SUB BX, OFFSET ISR1 ; BX is index in table WAITING_PROC +; Complete the update of process descriptor: + MOV CUR_PROCESS.PD_SP, SP + POP CX ; just to get access to the Flags + POP DX + POP AX + MOV CUR_PROCESS.PD_FLAGS, AX + PUSH AX + PUSH DX + PUSH CX +; Push the parameters for the TRANSFER + LES SI, WAITING_PROC [BX] ; get address of PROCESS var + LES SI, ES:DWORD PTR [SI] ; get address of process descriptor +; the interrupted process: + PUSH ES: WORD PTR [SI].PD_INT_PROC+2 + PUSH ES: WORD PTR [SI].PD_INT_PROC +; the waiting process: + PUSH WORD PTR WAITING_PROC+2 [BX] + PUSH WORD PTR WAITING_PROC [BX] + ; A IOTRANSFER is valid only for 1 single interruption, so we have to + ; free the corresponding Interrupt Vector: + CALL FREE_1_VECT + MOV DS, CS: RTS_DS + + +; Send a EOI to the 8259: + MOV AL, EOI_8259 + OUT CTRL_W2_8259, AL + +;;; removed jan 24 84: +; ; Before enabling interrupts, we mask the bit in the 8259 +; ; that corresponds to the current interrupt: +; ; (BX holds number of used ISR * 2) +; SHR BX, 1 ; byte index +; MOV CL, NEW_MASK [BX] +; CMP CL, 0FFH ; NIL? i.e. not handled by 8259? +; JE INT_CTRL_MASKED +; MOV DL, OLD_MASK [BX] +; IN AL, MASK_8259 ; get current mask +; CMP DL, 0 ; was old bit set? +; JE RESET_BIT +; OR AL, CL ; set it +; JMP BIT_IS_OK +;RESET_BIT: +; NOT CL +; AND AL, CL ; reset it +;BIT_IS_OK: +; OUT MASK_8259, AL +;INT_CTRL_MASKED: + + ; at the end of the following TRANSFER we are performing + ; an IRET, which enables the interrupts. + ; Now, we're ready for a TRANSFER: + JMP TRANSFER_BODY + + +; END Interrupt Service Routines +;------------------------------------------------------------ + + page + + public IOTRANSFER + +IOTRANSFER: +;========== + ; The registers needed for the TRANSFER are + ; already saved. + ; Swap the Return Address and the parameters: + MOV BP, SP + POP WORD PTR TEMP_W ; RetAdd + POP WORD PTR TEMP_W+2 ; RetCodeSeg + POP CUR_PROCESS.PD_FLAGS + ; Move the paramaters: + POP AX + MOV [BP], AX + POP AX + MOV [BP]+2, AX + POP AX + MOV [BP]+4, AX + POP AX + MOV [BP]+6, AX + POP AX + MOV [BP]+8, AX + ; Restore the Return Block: + PUSH CUR_PROCESS.PD_FLAGS + PUSH WORD PTR TEMP_W+2 ; RetCodeSeg + PUSH WORD PTR TEMP_W ; RetAdd + + MOV CUR_PROCESS.PD_SP, SP + ; Set SP so, that the parameters can be popped: + SUB SP, 10 + + POP BX ; Interrupt Vector + MOV CUR_PROCESS.PD_INT_VECT, BX + SHL BX, 1 + SHL BX, 1 + ; BX is the offset of the Interrupt Vector + + ; Find a unused Interrupt Service Routine (ISRn), represented by + ; a free entry in the array INT_VECT_OWNER: + MOV DI, OFFSET INT_VECT_OWNER + MOV AX, NIL_CARD + MOV CX, NBR_ISR + INC CX ; Increment it, so we can test for 0 + REPNE SCASW ; Scan the array for a NIL + SUB DI, 2 ; It has already been incremented + MOV AX, OFFSET INT_VECT_OWNER + SUB DI, AX ; Get word index + + CMP CL, 0 + JNE FREE_INT_V + ; There is no more free Interrupt Service Routine: + MOV CUR_PROCESS.PD_STATUS, INT_ERR_CODE + JMP TERMINATE + +FREE_INT_V: + ; BX is the offset of the Interrupt Vector + ; DI is the index in INT_VECT_OWNER of + ; the first free entry + + ; Put the program identifier in the array + ; INT_VECT_OWNER (used to restore it upon + ; termination): + MOV AX, CUR_PROCESS.PD_PROG_ID + MOV INT_VECT_OWNER [DI], AX + + ; Set in the P.D., where to save the running + ; process, when Interrupt will occur. It is + ; the 2nd parameter of IOTRANSFER = addr of + ; proc. variable: + POP WORD PTR CUR_PROCESS.PD_INT_PROC + POP WORD PTR CUR_PROCESS.PD_INT_PROC + 2 + + ; Put the current process in the array + ; WAITING_PROC (the addr of process var): + MOV DX, DI ; save it + SHL DI, 1 ; a pointer-index + POP WORD PTR WAITING_PROC [DI] + POP WORD PTR WAITING_PROC + 2 [DI] + + ; Restore the parameters for the subsequent + ; TRANSFER: + SUB SP, 8 + + ; Save the requested Interrupt Vector and + ; put the new one: + MOV AX, 0 + MOV ES, AX + MOV AX, ES: [BX] + MOV CUR_PROCESS.PD_OLD_ISR, AX + MOV AX, ES: [BX] + 2 + MOV CUR_PROCESS.PD_OLD_ISR + 2, AX + ADD DI, OFFSET ISR0 + ; Implicit use of the fact, that the ISRn have a size of 4 Bytes! + ; DI is the address of the corresponding Interrupt Service Routine + MOV ES: [BX], DI + MOV ES: [BX] + 2, CS + +;;; removed jan 24 84: +; ; Before making the TRANSFER, we are going to unmask the corres- +; ; ponding bit in the 8259 Interrupt Controller, to allow this +; ; interrupt to occur: +; ; (DX is the number of used ISR * 2) +; SHR DX, 1 ; byte index +; MOV DI, DX +; MOV NEW_MASK [DI], 0FFH ; NIL, used by ISR +; MOV AX, CUR_PROCESS.PD_INT_VECT +; SUB AX, BASE_8259 ; check, if this interrupt is +; JB INT_CTRL_READY ; handled by 8259 +; CMP AX, NBR_ISR +; JAE INT_CTRL_READY +; ; it is handled by the 8259 +; MOV CX, AX ; = level inside 8259 +; MOV BX, 1 ; = mask for level 0 +; SHL BX, CL ; = mask for actual level +; MOV NEW_MASK [DI], BL ;;;; temporarily: only 8 levels +; IN AL, MASK_8259 ; fetch old mask +; MOV CL, AL +; AND CL, BL ; get old value of this bit +; MOV OLD_MASK [DI], CL ; and save it +; ; now unmask the bit: +; NOT BL +; AND AL, BL +; OUT MASK_8259, AL +;INT_CTRL_READY: + + + ; Execute a normal TRANSFER: + JMP TRANSFER_BODY ; No return here + + +; END IOTRANSFER +;------------------------------------------------------------ + + page + + public NEWPROCESS +NEWPROCESS proc near + + PUSH BP + MOV BP, SP + MOV AX, [BP] + 14 ; Offset of process workspace + MOV BX, [BP] + 16 ; Segment of it + MOV CX, AX + ADD CX, (size ProcessDescriptor) + 10 + 15 + ; Check, if there is room for process + ; descr and 'free list header' for + ; heap. 15 is needed to round up. + JNC SIZE_OK + JMP STACK_OVF + ; Not even enough room for the workspace +SIZE_OK: + ADD AX, (size ProcessDescriptor) + 15 + ; Free space starts at the + ; first paragraph after PD. + ; 15 is to round up (worst case). + CALL NORM_ADDR + ; Upon return: + ; BX = normalised Segment of + ; free mem (after P.D.) + ; AX = Offset, < 16 + + ; Set the initial values for the heap managment: + MOV TEMP_P_D.PD_HEAP_BASE + 2, BX + MOV TEMP_P_D.PD_HEAP_TOP + 2, BX + MOV TEMP_P_D.PD_HEAP_BASE, 0 + MOV TEMP_P_D.PD_HEAP_TOP, 10 + ; size of a 'FreeElementPtr' + MOV ES, BX ; segment of heap + ; put NILs in the header of Free List: + MOV ES: WORD PTR 0, NIL_OFF + MOV ES: WORD PTR 2, NIL_SEG + MOV ES: WORD PTR 4, NIL_OFF + MOV ES: WORD PTR 6, NIL_SEG + MOV ES: WORD PTR 8, 0 + ; size of free element (redundant) + ; See comment under 'Fill in the Default + ; Process Descriptor'. For a new process + ; however, we must fully install an empty heap, + ; since we can not call 'InstallHeap' as + ; done in the initialization of the module + ; Storage for the MAIN process. + + ; Compute the initial stack values: + MOV DX, (size ProcessDescriptor) + 15 + MOV CL, 4 + SHR DX, CL ; compute PD size in paragrafs + MOV AX, [BP] + 14 ; Get offset of Workspace + AND AX, 0FH + JZ SET_STACK ; We loose one paragraph for rounding + INC DX ; (stack and heap start at a parag. address). +SET_STACK: + MOV AX, [BP] + 12 ; Size of process' WSP, in paragrafs + SUB AX, DX ; Size minus proc-descriptor + CALL COMP_STACK ; Sets stack to end of WSP + ; BX = SS, AX = SP + ; SP has to be set after the return block + ; that we're going to put: + SUB AX, SP_INI_SIZE + MOV TEMP_P_D.PD_SP, AX ; Set SP and SS in new descriptor + MOV TEMP_P_D.PD_SS, BX + MOV SI, AX + MOV ES, BX + SUB AX, SP_RESERVE + MOV TEMP_P_D.PD_SP_LIM, AX ; Set Stack Limit + ; Stack Limit is actual value + ; of SP minus some reserve + + ; Prepare the error return on the new stack: + ; (ES,SI) are the initial stack of this new process. + MOV ES:WORD PTR 8[SI], CS + MOV ES:WORD PTR 6[SI], OFFSET PROCESS_END + ; A process should never terminate! + MOV AX, SI + ADD AX, 6 + MOV TEMP_P_D.PD_RET_SP, AX + ; Return Stack Value (not used) + + ; Copy the Program End Stack: + MOV CX, CUR_PROCESS.PD_PROG_END + MOV TEMP_P_D.PD_PROG_END, CX + MOV CX, CUR_PROCESS.PD_PROG_END+2 + MOV TEMP_P_D.PD_PROG_END+2, CX + + ; Copy the program IDs from the current process: + MOV AX, CUR_PROCESS.PD_PROG_ID + MOV TEMP_P_D.PD_PROG_ID, AX + MOV AX, CUR_PROCESS.PD_SHARED_ID + MOV TEMP_P_D.PD_SHARED_ID, AX + + ; Copy the Module Table Header: + MOV AX, CUR_PROCESS.PD_MOD_TABLE + MOV TEMP_P_D.PD_MOD_TABLE, AX + MOV AX, CUR_PROCESS.PD_MOD_TABLE+2 + MOV TEMP_P_D.PD_MOD_TABLE+2, AX + + ; Copy the father process: + MOV AX, CUR_PROCESS.PD_FATHER_PROC + MOV TEMP_P_D.PD_FATHER_PROC, AX + MOV AX, CUR_PROCESS.PD_FATHER_PROC+2 + MOV TEMP_P_D.PD_FATHER_PROC+2, AX + ; Check if the father process is NIL, in which + ; case we have to put the addr of the current PD: + CMP AX, 0FFFFH + JNE NOT_FATHER + MOV AX, CUR_P_PTR + MOV TEMP_P_D.PD_FATHER_PROC, AX + MOV AX, CUR_P_PTR + 2 + MOV TEMP_P_D.PD_FATHER_PROC + 2, AX +NOT_FATHER: + + ; Copy the priority mask from the current process: + MOV AX, CUR_PROCESS.PD_PRIO_MASK + MOV TEMP_P_D.PD_PRIO_MASK, AX + + ; Set the Continuation Address: + ; (We put it on the stack, for a IRET) + MOV AX, [BP] + 18 + MOV BX, [BP] + 20 + MOV ES: [SI] + 0, AX + MOV ES: [SI] + 2, BX + + ; Copy the Flags: + MOV CX, CUR_PROCESS.PD_FLAGS + MOV TEMP_P_D.PD_FLAGS, CX + MOV ES: [SI] + 4, CX + ; And on stack, for the IRET + + ; Set Status to Normal: + MOV AX, 0 + MOV TEMP_P_D.PD_STATUS, AX + ; don't modify AX here! + ; Set dynamic link to 0, used by the + ; debugger to detect end of calling sequence: + MOV TEMP_P_D.PD_BP, AX + + ; Set the address of the descriptor in the VAR-PAR: + MOV ES, [BP] + 10 ; addr of varpar + MOV BX, [BP] + 8 + MOV DI, [BP] + 14 ; addr of workspace + MOV CX, [BP] + 16 + MOV ES: [BX], DI + MOV ES: [BX] + 2, CX + + ; Copy the new descriptor from the TEMP_P_D + ; area into the real workspace: + MOV ES, CX ; (ES,DI) = workspace + MOV SI, OFFSET TEMP_P_D ; (DS,SI) = TEMP_P_D + MOV CX, (size ProcessDescriptor)/2 + REP MOVSW + MOV DS, CUR_PROCESS.PD_DS + POP BP + IRET +;------------------------------------------------------------ + + +PROCESS_END: +;=========== +; We arrive here, when the code of a process is executed and a +; return from its code is performed. Since a process is not called +; like a procedure, but started through a TRANSFER, this situation +; is illegal: + MOV CUR_PROCESS.PD_STATUS, PROCESS_END_CODE + JMP TERMINATE +NEWPROCESS endp +;------------------------------------------------------------ + + page + + public MON_ENTRY, MON_EXIT +MON_ENTRY: +;========= +; Upon entry: BX holds requested priority level. +; The interrupt controller is set to disable all +; interrupts of the requested or lower levels. + ; check the parameter: + CMP BX, MAX_PRIO_LEVEL + JBE LEVEL_OK + MOV BX, MAX_PRIO_LEVEL +LEVEL_OK: + POP SI ; remove return block + POP DX + POP CX + IN AL, MASK_8259 + XOR AH, AH + PUSH AX ; save old mask + OR AL, PRIORITY_MASKS [BX] + OUT MASK_8259, AL + MOV CUR_PROCESS.PD_PRIO_MASK, AX + PUSH CX ; restore return block + PUSH DX + PUSH SI + MOV DS, CUR_PROCESS.PD_DS + IRET + + +MON_EXIT: +;======== +; Restore the mask that has been saved on the stack +; at the entry to that procedure. Note that changes +; in the interrupt mask that occured during execution +; of this 'priority procedure' are not conserved! +; If interrupts are treated with IOTRANSFER, such +; changes should never occur. + POP SI ; remove return block + POP DX + POP CX + POP AX ; old mask + MOV CUR_PROCESS.PD_PRIO_MASK, AX + OUT MASK_8259, AL + PUSH CX ; restore return block + PUSH DX + PUSH SI + MOV DS, CUR_PROCESS.PD_DS + IRET + + + public LISTEN + +LISTEN: +;====== +; This function lowers the priority and enables interrupts +; tempoarily. Note that changes in the interrupt mask that +; occur during the execution of pending interrupts are not +; conserved, the old mask is restored at the end! If +; interrupts are treated with IOTRANSFER, such changes +; should never occur. + IN AL, MASK_8259 + XOR AH, AH ; update current mask + PUSH AX ; and save it + XOR AX, AX + MOV CUR_PROCESS.PD_PRIO_MASK, AX + OUT MASK_8259, AL ; unmask all bits + STI ; Allow all interrupts + NOP ; (there is a one-instruction lag) + MOV CX, 20H +LISTEN_AGAIN: + DEC CX ; we have to wait longer, to give + ; all pending interrupts a chance + JNZ LISTEN_AGAIN + CLI + POP AX + MOV CUR_PROCESS.PD_PRIO_MASK, AX + OUT MASK_8259, AL ; restore old mask + MOV DS, CUR_PROCESS.PD_DS + IRET + +;------------------------------------------------------------ + + public GET_INTERRUPT_MASK + +GET_INTERRUPT_MASK proc near + IN AL, MASK_8259 + XOR AH, AH + RET +GET_INTERRUPT_MASK endp + +;------------------------------------------------------------ + + public REST_INTERRUPT_MASK + +REST_INTERRUPT_MASK proc near + OUT MASK_8259, AL + RET +REST_INTERRUPT_MASK endp + +;------------------------------------------------------------ + + +FREE_1_VECT proc near +; Upon entry: (ES,SI) hold addr of P.D. that owns the vector. +; BX holds number of used ISR (0..NBR_ISR-1) times 4 +; Upon exit: BX holds number of used ISR times 2 +; We have to do both: +; a) free its entry in WAITING_PROC and in INT_VECT_OWNER + MOV AX, 0FFFFH ; used as NIL + MOV WAITING_PROC [BX], AX + SHR BX, 1 + MOV INT_VECT_OWNER [BX], AX + ; b) and to restore the interrupt vector + PUSH ES + MOV AX, 0 + MOV ES, AX + POP DS ; DS is segm of waiting process + ; and SI is its offset + MOV DI, PD_INT_VECT [SI] + SHL DI, 1 + SHL DI, 1 ; multiply by 4, to get addr. + ADD SI, PD_OLD_ISR + MOVSW + MOVSW + RET +FREE_1_VECT endp + + + public REST_I_V +REST_I_V proc near + MOV AX, CUR_PROCESS.PD_PROG_ID + ; AX holds the current ID + MOV DI, NBR_ISR + SHL DI, 1 ; WORD index +NEXT_I_V: + DEC DI + DEC DI + MOV BX, INT_VECT_OWNER [DI] + ; BX holds the owner + CMP AX, BX + JE FREE_THIS_ONE + CMP AX, 0 ; 0 is a joker ! + JNE I_V_DONE ; It's not 0 + CMP BX, NIL_CARD + JE I_V_DONE ; It's NIL +FREE_THIS_ONE: + ; This entry is owned by the current program: + MOV BX, DI + SHL BX, 1 + LES SI, WAITING_PROC [BX] ; get addr of PROCESS variable + LES SI, ES:DWORD PTR [SI] ; get addr of process descriptor + PUSH DI ; save it + CALL FREE_1_VECT + POP DI + +I_V_DONE: + CMP DI, 0 + JNE NEXT_I_V + RET +REST_I_V endp + + public FREE_INT_VECT +FREE_INT_VECT: +;============= + ; Restores the old Interrupt Vectors of all entries, used by the + ; current program. + CALL REST_I_V + MOV DS, CUR_PROCESS.PD_DS + IRET + + +;------------------------------------------------------------ + + public STOPPED +STOPPED: +;====== + ; We arrive here when ctrl-break is entered from the + ; keyboard. + MOV ES, RTS_DS + ; We are coming from a DOS function (which we don't want to + ; debug), so we have first to remove the return block that + ; points to the DOS: + POP AX + POP AX + POP AX + CALL SAVE_CPU_INFO + ; Give the interrupt controller an End-Of-Interrupt. + ; There is for sure one that we have to send (for the KBD + ; routine that has made the software interrupt to arrive + ; here). We might be in a nested ISR (timer has a lower + ; priority than KBD), so let's send 2 EOI (it doesn't harm): + MOV AL, EOI_8259 + OUT CTRL_W2_8259, AL + OUT CTRL_W2_8259, AL + ; Set status to some reasonable value: + MOV FCT_CODE, TERMINATE_FCT + MOV CUR_PROCESS.PD_STATUS, STOP_CODE + JMP TERMINATE + + +;------------------------------------------------------------ + +code ends + end + \ No newline at end of file diff --git a/Logitech Modula-2 v1/TTT.MOD b/Logitech Modula-2 v1/TTT.MOD new file mode 100644 index 0000000..be7155f --- /dev/null +++ b/Logitech Modula-2 v1/TTT.MOD @@ -0,0 +1,315 @@ +(* Logitech Modula-2 version of proving you can't win at tic-tac-toe if the opponent is competent + To build from the Modula-2 install directory: + + ntvdm m2 comp %1 + ntvdm m2 link %1 + ntvdm m2 %1 +*) + +(*$S-*) +(*$R-*) +(*$T-*) + +MODULE ttt; + +FROM SYSTEM IMPORT WORD, BYTE, ADDRESS; +FROM NumberConversion IMPORT StringToCard; +FROM Strings IMPORT Assign; +FROM InOut IMPORT WriteLn, WriteInt, WriteCard, WriteString; + +CONST + scoreWin = 6; + scoreTie = 5; + scoreLose = 4; + scoreMax = 9; + scoreMin = 2; + scoreInvalid = 0; + + pieceBlank = 0; + pieceX = 1; + pieceO = 2; + + defaultIterations = 10; + +TYPE + boardType = ARRAY[ 0..8 ] OF CARDINAL; + scoreProc = PROCEDURE() : CARDINAL; + +VAR + evaluated: CARDINAL; (* # of board positions evaluated *) + board: boardType; + procs : ARRAY[ 0..8 ] OF scoreProc; + +PROCEDURE lookForWinner() : CARDINAL; +VAR t : CARDINAL; +BEGIN + t := board[ 0 ]; + IF pieceBlank <> t THEN + IF ( ( ( t = board[1] ) AND ( t = board[2] ) ) OR + ( ( t = board[3] ) AND ( t = board[6] ) ) ) THEN + RETURN t; + END; + END; + + t := board[1]; + IF ( t = board[4] ) AND ( t = board[7] ) THEN RETURN t; END; + + t := board[2]; + IF ( t = board[5] ) AND ( t = board[8] ) THEN RETURN t; END; + + t := board[3]; + IF ( t = board[4] ) AND ( t = board[5] ) THEN RETURN t; END; + + t := board[6]; + IF ( t = board[7] ) AND ( t = board[8] ) THEN RETURN t; END; + + t := board[4]; + IF pieceBlank <> t THEN + IF ( ( ( t = board[0] ) AND ( t = board[8] ) ) OR + ( ( t = board[2] ) AND ( t = board[6] ) ) ) THEN + RETURN t; + END; + END; + + RETURN pieceBlank; +END lookForWinner; + +PROCEDURE proc0() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[0]; + IF ( ( ( x = board[1] ) AND ( x = board[2] ) ) OR + ( ( x = board[3] ) AND ( x = board[6] ) ) OR + ( ( x = board[4] ) AND ( x = board[8] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc0; + +PROCEDURE proc1() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[1]; + IF ( ( ( x = board[0] ) AND ( x = board[2] ) ) OR + ( ( x = board[4] ) AND ( x = board[7] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc1; + +PROCEDURE proc2() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[2]; + IF ( ( ( x = board[0] ) AND ( x = board[1] ) ) OR + ( ( x = board[5] ) AND ( x = board[8] ) ) OR + ( ( x = board[4] ) AND ( x = board[6] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc2; + +PROCEDURE proc3() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[3]; + IF ( ( ( x = board[4] ) AND ( x = board[5] ) ) OR + ( ( x = board[0] ) AND ( x = board[6] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc3; + +PROCEDURE proc4() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[4]; + IF ( ( ( x = board[0] ) AND ( x = board[8] ) ) OR + ( ( x = board[2] ) AND ( x = board[6] ) ) OR + ( ( x = board[1] ) AND ( x = board[7] ) ) OR + ( ( x = board[3] ) AND ( x = board[5] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc4; + +PROCEDURE proc5() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[5]; + IF ( ( ( x = board[3] ) AND ( x = board[4] ) ) OR + ( ( x = board[2] ) AND ( x = board[8] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc5; + +PROCEDURE proc6() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[6]; + IF ( ( ( x = board[7] ) AND ( x = board[8] ) ) OR + ( ( x = board[0] ) AND ( x = board[3] ) ) OR + ( ( x = board[4] ) AND ( x = board[2] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc6; + +PROCEDURE proc7() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[7]; + IF ( ( ( x = board[6] ) AND ( x = board[8] ) ) OR + ( ( x = board[1] ) AND ( x = board[4] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc7; + +PROCEDURE proc8() : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[8]; + IF ( ( ( x = board[6] ) AND ( x = board[7] ) ) OR + ( ( x = board[2] ) AND ( x = board[5] ) ) OR + ( ( x = board[0] ) AND ( x = board[4] ) ) ) + THEN RETURN x; END; + RETURN pieceBlank; +END proc8; + +PROCEDURE winner2( move: CARDINAL ) : CARDINAL; +VAR x : CARDINAL; +BEGIN + x := board[ move ]; + CASE move OF + 0: IF NOT ( ( ( x = board[1] ) AND ( x = board[2] ) ) OR + ( ( x = board[3] ) AND ( x = board[6] ) ) OR + ( ( x = board[4] ) AND ( x = board[8] ) ) ) + THEN RETURN pieceBlank; END; | + 1: IF NOT ( ( ( x = board[0] ) AND ( x = board[2] ) ) OR + ( ( x = board[4] ) AND ( x = board[7] ) ) ) + THEN x := pieceBlank; END; | + 2: IF NOT ( ( ( x = board[0] ) AND ( x = board[1] ) ) OR + ( ( x = board[5] ) AND ( x = board[8] ) ) OR + ( ( x = board[4] ) AND ( x = board[6] ) ) ) + THEN x := pieceBlank; END; | + 3: IF NOT ( ( ( x = board[4] ) AND ( x = board[5] ) ) OR + ( ( x = board[0] ) AND ( x = board[6] ) ) ) + THEN x := pieceBlank; END; | + 4: IF NOT ( ( ( x = board[0] ) AND ( x = board[8] ) ) OR + ( ( x = board[2] ) AND ( x = board[6] ) ) OR + ( ( x = board[1] ) AND ( x = board[7] ) ) OR + ( ( x = board[3] ) AND ( x = board[5] ) ) ) + THEN x := pieceBlank; END; | + 5: IF NOT ( ( ( x = board[3] ) AND ( x = board[4] ) ) OR + ( ( x = board[2] ) AND ( x = board[8] ) ) ) + THEN x := pieceBlank; END; | + 6: IF NOT ( ( ( x = board[7] ) AND ( x = board[8] ) ) OR + ( ( x = board[0] ) AND ( x = board[3] ) ) OR + ( ( x = board[4] ) AND ( x = board[2] ) ) ) + THEN x := pieceBlank; END; | + 7: IF NOT ( ( ( x = board[6] ) AND ( x = board[8] ) ) OR + ( ( x = board[1] ) AND ( x = board[4] ) ) ) + THEN x := pieceBlank; END; | + 8: IF NOT ( ( ( x = board[6] ) AND ( x = board[7] ) ) OR + ( ( x = board[2] ) AND ( x = board[5] ) ) OR + ( ( x = board[0] ) AND ( x = board[4] ) ) ) + THEN x := pieceBlank; END; + END; + + RETURN x; +END winner2; + +PROCEDURE minmax( alpha: CARDINAL; beta: CARDINAL; move: CARDINAL; depth: CARDINAL ): CARDINAL; +VAR p, value, pieceMove, score : CARDINAL; +BEGIN + evaluated := evaluated + 1; + value := scoreInvalid; + IF depth >= 4 THEN + (* lookForWinner is >14% slower than using scoring procs, unlike Turbo Modula-2 on CP/M *) + (* p := lookForWinner(); *) + (* p := winner2( move ); *) + p := procs[ move ](); + + IF p <> pieceBlank THEN + IF p = pieceX THEN + RETURN scoreWin; + ELSE + RETURN scoreLose; + END; + ELSIF depth = 8 THEN + RETURN scoreTie; + END; + END; + + IF ODD( depth ) THEN + value := scoreMin; + pieceMove := pieceX; + ELSE + value := scoreMax; + pieceMove := pieceO; + END; + + p := 0; + REPEAT + IF board[ p ] = pieceBlank THEN + board[ p ] := pieceMove; + score := minmax( alpha, beta, p, depth + 1 ); + board[ p ] := pieceBlank; + + IF ODD( depth ) THEN + IF ( score = scoreWin ) THEN RETURN scoreWin; END; + IF ( score > value ) THEN + value := score; + IF ( value >= beta ) THEN RETURN value; END; + IF ( value > alpha ) THEN alpha := value; END; + END; + ELSE + IF ( score = scoreLose ) THEN RETURN scoreLose; END; + IF ( score < value ) THEN + value := score; + IF ( value <= alpha ) THEN RETURN value; END; + IF ( value < beta ) THEN beta := value; END; + END; + END; + END; + p := p + 1 + UNTIL p > 8; + + RETURN value; +END minmax; + +PROCEDURE runit( move : CARDINAL ); +VAR score : CARDINAL; +BEGIN + board[move] := pieceX; + score := minmax( scoreMin, scoreMax, move, 0 ); + board[move] := pieceBlank; +END runit; + +VAR + i, loops, tsstart, tsend : CARDINAL; + cmd : ARRAY[0..127] OF CHAR; + done : BOOLEAN; +BEGIN + loops := 0; + IF ( loops = 0 ) THEN loops := defaultIterations; END; + + procs[ 0 ] := proc0; + procs[ 1 ] := proc1; + procs[ 2 ] := proc2; + procs[ 3 ] := proc3; + procs[ 4 ] := proc4; + procs[ 5 ] := proc5; + procs[ 6 ] := proc6; + procs[ 7 ] := proc7; + procs[ 8 ] := proc8; + + FOR i := 0 TO 8 DO + board[i] := pieceBlank; + END; + + FOR i := 1 TO loops DO + evaluated := 0; (* once per loop to prevent overflow *) + runit( 0 ); + runit( 1 ); + runit( 4 ); + END; + + WriteString( "moves evaluated: " ); WriteInt( evaluated, 8 ); WriteLn; + WriteString( "iterations: " ); WriteInt( loops, 8 ); WriteLn; +END ttt. + diff --git a/Logitech Modula-2 v1/m.bat b/Logitech Modula-2 v1/m.bat new file mode 100644 index 0000000..5b2fc4e --- /dev/null +++ b/Logitech Modula-2 v1/m.bat @@ -0,0 +1,8 @@ +del %1.lod +del %1.lnk +del %1.ref +del %1.map +ntvdm m2 comp %1.mod /S- /R- /T- +ntvdm m2 link %1 +ntvdm -p m2 %1.lod +