OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

microsoft quickbasic v1

Browse Source
This commit is contained in:
davidly 2024-07-01 06:02:54 -07:00
parent fd7a36d0ac
commit 663a14d010
25 changed files with 967 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Microsoft QuickBASIC v1/BASCOM.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft QuickBASIC v1/BCOM10.LIB Normal file
View File

Binary file not shown.

BIN
Microsoft QuickBASIC v1/BRUN10.EXE Normal file
View File

Binary file not shown.

BIN
Microsoft QuickBASIC v1/BRUN10.LIB Normal file
View File

Binary file not shown.

30
Microsoft QuickBASIC v1/CALL.BAS Normal file
View File

@ -0,0 +1,30 @@
dim file$(2)
cmd$ = command$
call split(cmd$,file$())
call strip(file$(2))
call printout(file$())
end
sub split(c$,f$(1)) static
mark = instr(c$," ")
f$(1) = left$(c$,mark - 1)
f$(2) = mid$(c$,mark + 1)
end sub
sub strip(f$) static
first$ = left$(f$,1)
while first$ = " "
lng = len(f$)
f$ = right$(f$,lng - 1)
first$ = left$(f$,1)
wend
end sub
sub printout(f$(1)) static
for file% = 1 to 2
open f$(file%) for input as #1
while not eof(1)
line input #1, temp$
print temp$
wend
close #1
next
end sub


32
Microsoft QuickBASIC v1/COMMAND.BAS Normal file
View File

@ -0,0 +1,32 @@
bs = 10
power = 1
lg = 0
sign = 1
x = val(command$)
test1: if x > 0 then goto test2 _
else _
print "log(";command$;") not defined."
print "Input must be greater than zero."
end
test2: if x >= 1 then goto test3 _
else _
x = 1/x
sign = -1
test3: if x < 100 then goto main _
else _
while x >= 100
x = x/10
lg = lg + 1
wend
main:
while abs(bs - 1) > .0000001
if bs > x then goto newval _
else _
x = x/bs
lg = lg + power
newval:
bs = sqr(bs)
power = power/2
wend
print "log(";command$;") = ";lg*sign


11
Microsoft QuickBASIC v1/DEC.BAS Normal file
View File

@ -0,0 +1,11 @@
rem ** compile this with main.bas and digit.bas **
common a(1),n$,b,ln
dec = 0
for i = 0 to (ln-1)
dec = dec + a(i)*b^i
next
erase a
print "Decimal # = ";dec : print
print "Input 0 for base to end program."
chain "main"


14
Microsoft QuickBASIC v1/DEFFN.BAS Normal file
View File

@ -0,0 +1,14 @@
def fndegrad(d,m,s)
pi = 3.14159263
d = d + m/60 + s/3600
fndegrad = d * (pi/180)
end def
deg = 45:min = 10
print tab(5);"Angle measurement";tab(38);"SINE"
print:print
for sec = 0 to 50 step 10
print tab(5);deg;chr$(248);",";min;"',";sec;chr$(34);
rad = fndegrad(deg,min,sec)
print tab(35);sin(rad)
next


10
Microsoft QuickBASIC v1/DIGIT.BAS Normal file
View File

@ -0,0 +1,10 @@
rem ** compile this with main.bas and dec.bas **
common a(1),n$,b,ln
m = ln -1
for j = 0 to m
a$ = mid$(n$,j+1,1)
if a$ < "A" then a(m-j) = val(a$) _
else a(m-j) = asc(a$) - 55
next
chain "dec"


29
Microsoft QuickBASIC v1/DRAW.BAS Normal file
View File

@ -0,0 +1,29 @@
screen 2
loop = 1
while loop
gosub split
check = min
while check = min
a$ = inkey$
if len(a$) <> 0 then end _
else _
gosub split
gosub face
wend
cls
wend
split: rem ** This splits time$ into numeric values
let t$ = time$
hr$ = left$(t$,2) : min$ = mid$(t$,4,2)
hr = val(hr$) : min = val(min$)
return
face: rem ** This draws clock face
circle (320,100),175
little = 360 -(30 * hr + min/2)
draw "ta=" + varptr$(little) + "nu40"
big = 360 -(6*min)
draw "ta=" + varptr$(big) + "nu70"
locate 2,37 : print time$
locate 23,25 : print "Press any key to return to system"
return


31
Microsoft QuickBASIC v1/E.BAS Normal file
View File

@ -0,0 +1,31 @@
100 DIGITS% = 200
110 DIM A%( 200 )
120 HIGH% = DIGITS%
130 X% = 0
140 N% = HIGH% - 1
150 IF N% <= 0 GOTO 200
160 A%[ N% ] = 1
170 N% = N% - 1
180 GOTO 150
200 A%[ 1 ] = 2
210 A%[ 0 ] = 0
220 IF HIGH% <= 9 GOTO 400
230 HIGH% = HIGH% - 1
235 N% = HIGH%
240 IF N% = 0 GOTO 300
250 A%[ N% ] = X% MOD N%
255 rem PRINT "a[n-1]"; A%[ N% - 1 ]
260 X% = ( 10 * A%[ N% - 1 ] ) + ( X% \ N% )
265 rem PRINT "x: "; X%, "n: "; N%
270 N% = N% - 1
280 GOTO 240
300 IF X% >= 10 GOTO 330
310 PRINT USING "#"; X%;
320 GOTO 220
330 PRINT USING "##"; X%;
340 GOTO 220
400 PRINT ""
410 PRINT "done"
420 SYSTEM

BIN
Microsoft QuickBASIC v1/GWCASS.OBJ Normal file
View File

Binary file not shown.

BIN
Microsoft QuickBASIC v1/GWCOM.OBJ Normal file
View File

Binary file not shown.

BIN
Microsoft QuickBASIC v1/LINK.EXE Normal file
View File

Binary file not shown.

11
Microsoft QuickBASIC v1/MAIN.BAS Normal file
View File

@ -0,0 +1,11 @@
rem ** compile this with digit.bas and dec.bas **
common a(1),n$,b,ln
input "base,number: ",b,n$
print
while b
ln = len(n$)
dim a(ln)
chain "digit"
wend
end


10
Microsoft QuickBASIC v1/PLAY.BAS Normal file
View File

@ -0,0 +1,10 @@
scale$ = "cdefgab"
play "o0 x" + varptr$(scales$)
for i = 1 to 6
play ">x" + varptr$(scale$)
next
play "o6 x" + varptr$(scale$)
for i = 1 to 6
play "<x" + varptr$(scale$)
next


196
Microsoft QuickBASIC v1/README.DOC Normal file
View File

@ -0,0 +1,196 @@
MICROSOFT
QuickBASIC Compiler
README.DOC
July 18, 1985
The following file contains information in addition to the
Microsoft QuickBASIC Manual.
The following files are on your QuickBASIC diskette:
Compiler Files:
BASCOM EXE The QuickBASIC Compiler
BCOM10 LIB The QuickBASIC Compiler Library
BRUN10 EXE The QuickBASIC Runtime
BRUN10 LIB The QuickBASIC Runtime Library
LINK EXE The Microsoft Linker
GWCASS OBJ Object module for cassette support
GWCOM OBJ Object module for communications support
SMALLERR OBJ Object module for producing small error
messages, and therefore, a smaller EXE file
README DOC This information file
Demonstration Files: The following examples have been
placed on the disk for your convenience. These examples are
identical to the examples in chapter 9 of the manual, under
the sections headed by the statement/function noted.
CALL BAS This demonstrates the use of the CALL
statement
COMMAND BAS This shows the use of the COMMAND$ function
DEFFN BAS This shows the use of DEF FN in multi-line
functions
MAIN BAS This example, combined with DIGIT.BAS and
DEC.BAS show the use of the CHAIN statement
as well as COMMON variables
DIGIT BAS See MAIN.BAS
DEC BAS See MAIN.BAS
SUB BAS This shows the use of SUB..SUB END/SUB EXIT
to create named subroutines
DRAW BAS This shows the use of the DRAW statement
PLAY BAS This shows the use of the PLAY statement
REDIM BAS This shows the use of the REDIM statement
with dynamic arrays and ERASE
SHARED BAS This shows the use of SHARE statement in
named subroutines with shared variables
REMLINE BAS This program is designed to take programs
written for a Microsoft BASIC Interpreter
and remove the unreferenced line numbers
for use with QuickBASIC. REMLINE assumes
that the program is syntactically correct.
GENERAL NOTES:
- QuickBASIC can read Microsoft Word formatted files. For
those users of QuickBASIC who own Microsoft Word,
you can use Word to edit your programs. There is no need to
save the file non-formatted, as QuickBASIC will disreguard
any formatting information and compile the program.
- if you are using the runtime library and either cassette or
communications support, you must link in either
GWCASS.OBJ (for cassette support) or GWCOM.OBJ (for
communications support).
- If you are using the LOCK or UNLOCK statements, or the
LOCK type clause in the OPEN statement , you should
be aware that they will only function at runtime if you are
using MS-DOS 3.00 or higher. The code will be compiled,
however, if you are using a DOS below 3.00 you will receive
an ADVANCED FEATURE runtime ERROR if either a LOCK or an
UNLOCK is performed.
If you are using MS-DOS 3.00 you must run the SHARE
program to perform any locking operation.
ADDITIONS TO THE MANUAL:
OPEN STATEMENT:
The compiler fully supports the syntax of the IBM BASICA 3.00
interpreter OPEN statement. The functionality of the OPEN statement
has been enhanced to control access to opened files in a
network environment. The new, expanded syntax is:
OPEN "<filespec>" [FOR <mode>][ACCESS <access>]
[<locktype>] AS [#] <filenum> [LEN=<record length>]
<mode> specifications may now include the RANDOM keyword.
When no <mode> is specified, RANDOM file mode is assumed.
In RANDOM mode, if no ACCESS clause is present, three
attempts are made to open the file when the OPEN
statement is executed. Access is attempted in the
following order:
1. Read/write
2. Write-only
3. Read-only
The ACCESS clause specifies the type of operation to be
performed on the opened file. If the file is already opened
by another process and access of the type specified is
not allowed, the OPEN will fail and a "Permission Denied"
error message is generated.
The ACCESS types are:
READ Opens the file for reading only.
WRITE Opens the file for writing only.
READ WRITE Opens the file for both reading and
writing. This mode is invalid for all
except RANDOM files and files opened for APPEND.
The <locktype> clause restricts access by other processes
to an open file. The locktypes are
default If <locktype> is not specified, the file
may be opened for reading and
writing any number of times by this process,
but other processes are
denied access to the file while it is opened.
SHARED Any process on any machine may read from or write
to this file.
LOCK READ No other process is granted read access to this file.
This access is granted only if no other process has
a previous LOCK READ access to the file.
LOCK WRITE No other process is granted write access to this
file. This also is granted only if no other process
has a previous access
of this kind to the file.
LOCK READ WRITE No other process is granted either read or write
access to this file. This access is
granted only if LOCK READ WRITE
has not already been granted to another process.
OPEN now generates error 70 "Permission Denied", when the
OPEN is restricted by a previous process. Error 70 was
previously "Disk Write Protect." A write protected disk will
still give you an error 70.
SEGMENT MAPS: Section 8.5
The following entry showed be added to the Segment Maps
found in both tables 8.1 and 8.2. If you use named
COMMON, the named COMMON segment will be in the segment
table.
In the Low DS section of the tables, after the entry which
looks like:
BC_DATA BC_VARS
If named COMMONs are used there will be one entry for each
named COMMON which looks like:
FOO BC_VARS
where "FOO" is the name of the COMMON.

23
Microsoft QuickBASIC v1/REDIM.BAS Normal file
View File

@ -0,0 +1,23 @@
rem $dynamic
r$ = "n"
while r$ = "n"
input "Range (low,high): ",low,high
input "Total to choose: ",total
m = high - low + 1
redim range(m)
for k = 1 to m
range(k) = k + low - 1
next
randomize timer/10
for i = 1 to total
x = int(m*rnd + 1)
print range(x),
range(x) = range(m)
m = m - 1
next
print
erase range
input "End program (y or n)";r$
wend
end


372
Microsoft QuickBASIC v1/REMLINE.BAS Normal file
View File

@ -0,0 +1,372 @@
'$linesize:132
' REMLINE.BAS is a program to remove line number from Microsoft BASIC
' Programs. It removes only those line numbers that are not the object
' of a goto, gosub or if-then
'
' REMLINE is run by typing:
'
' REMLINE [<input file> [, <output file>]]
'
' where <input file> is any input file name and <output file> is
' is any output file name. If <output file> is no present
' the output goes to the console. If <input file> is not
' present the input is from the keyboard. If <output file>
' is present <input file> has to be present.
'
' It makes several assumptions about the program
' 1. Program is correct syntactically, and runs in an MS Interpreter.
' 2. 200 limit on referenced line numbers. If larger, change LineTable
' declaration.
' 3. The first number encountered on a line is considered a line num-
' ber; thus some continuation lines (in a compiler specific
' construct) may not work correctly.
' 4. Remember that ERL assumes the existence of line numbers, so
' REMLINE should not be used on programs which depend on ERL.
DEFINT a - z
DIM SHARED KeyWordTable$( 6 )
DIM SHARED LineTable( 400 )
DIM KeyWordCount, LineCount, Seps$
DIM KeyBoard, Console
DIM InputFile$, OutputFile$
'
' FNToUpper$ - Convert string to upper case
' Description:
' This routine converts a string to upper case. If already upper case
' nothing is done. Returns a null string if input is null
' Input:
' InString$ - string to convert
' Output:
' FNToUpper$ - upper case string
' Uses:
' AscChar - temp used to hold ASCII form of character
' LenInString - Length of input string
' IndexInstring - Current index into input string
Def FNToUpper$(InString$)
LenInString = len(InString$)
' Exit if input string is empty (null)
if (LenInString = 0) then FNToUpper$ = "" : Exit Def
for IndexInstring = 1 to LenInString
AscChar = asc(mid$(InString$, IndexInstring, 1))
' &hdf is special bit pattern that converts from lower to upper
if ((AscChar >= asc("a")) and (AscChar <= asc("z"))) then _
AscChar = AscChar and &hdf: _
mid$(InString$, IndexInstring, 1) = chr$(AscChar)
next IndexInString
FNToUpper$ = InString$
End Def
'
' FNStrSpn - Get the index of the first character within InString$ that is
' NOT one of the characters from Separater$
' Description:
' This routine will search the parameter string InString$ until it finds
' a character that is not part of the Separater string. This can be used
' with FNStrBrk to isolate strings within strings that are separated by
' blanks, comma etc. whatever is specified in Separater$. This is especially
' helpfull in extracting parameters from the command line. See FNGetToken$
' for example of use.
'
' Input:
' InString$ = string to search
' Separater$ = string of Separater
'
' Output:
' FNStrSpn = index into InString$ if 0 then all character in Separater$
' are in InString$
' Uses:
' LenInString, LenSeprater = length parameter strings
' ChTemp$ = temp used for current character from InString$
' StartFound = Logical flag if search was successful
' IndexSeparater, IndexInString = current indexes into parameter strings
'
Def FNStrSpn(InString$, Separater$)
LenInString = Len(InString$)
LenSeparater = Len(Separater$)
' Examine each character from InString$ to see if it is in Separater$
for IndexInString = 1 to LenInString
ChTemp$ = Mid$(InString$, IndexInString, 1)
StartFound = false
' search all of the Separaters to see of any equal this character
for IndexSeparater = 1 to LenSeparater
if (ChTemp$ = Mid$(Separater$, IndexSeparater, 1)) then _
goto NextChar
next IndexSeparater
' found a character not equal to one of the Separaters$
' exit from loops
StartFound = true
goto EndStrSpn
NextChar:
Next IndexInString
EndStrSpn:
if (StartFound) then _
FNStrSpn = IndexInString _
else FnStrSpn = 0
End Def
'
' FNStrBrk - finds the first occurance of any character in string2$ in
' string1$
' Description:
' This routine is the opposite to FNStrSpn. It finds the first occurance
' of one of the characters from String2$ within String$. It is used
' generally for search from specific strings within strings. See FNSeparater
' on use. See FNGetToken$ to see the routines in use.
'
' Input:
' string1$ = string to search for first occurance
' string2$ = string of characters to search for
' Output:
' FNStrBrk = index to character in string1$ of first occurance
'
' Uses:
' LenString1 = length parameter string
' ChTemp$ = temp used for current character from String1$
' IndexString1 = current indexes into parameter string
'
Def FNStrBrk(String1$, String2$)
LenString1 = Len(String1$)
' Search String1$ until one of the characters from String2$ is found
' or run out of characters from String$2
for IndexString1 = 1 to LenString1
ChTemp$ = Mid$(String1$, IndexString1, 1)
if (instr(String2$, ChTemp$)) then _
StartFound = true: _
FNStrBrk = IndexString1: _
Exit Def
Next IndexString1
FnStrBrk = 0
End Def
'
' FNGetToken$ - Extract a token for a string.
' Description:
' This routine extracts tokens from strings. A token is a word that is
' surrounded by separaters, such as spaces or commas. It is us ually the
' word of interest and examining sentences or commands. If the string
' to search for tokens "Search$" is null (.i.e "") then the last
' non-null string passed will be used. The allows for multiple calls
' to FNGetToken$ to move through the string. The sequences then of calls
' would be:
' token$ = FNGetToken$("token string, a short one", " ,")
' while (token$ <> "")
' print token$
' token$ = FNGetToken$("", " ,")
' wend
' This will return "token", "string", "a", "short", "one"
'
' Note that the token is returned as an UPPER case character string.
'
' Input:
' Search$ = string to search
' InSeps$ = String of Seps$
' Output:
' FNGetToken$ = next token
' Uses:
' TokenString$ = last non-null string passed as parameter (do not modify)
' TokenIndex2 = index to last separater (do not modify)
' TokenIndex1 = index to last token
'
def FNGetToken$(Search$, InSeps$)
' Null strings indicate use of last string used
' TokenString$ is set to last string if Search$ is not null
if (Search$ = "") then _
Search$ = TokenString$ _
else TokenIndex2 = 1: _
TokenString$ = Search$
' If last separater position is past end of search string then no more
' tokens can be on string, since searching is started from this position
' Exit with null return in this case
if (TokenIndex2 >= len(Search$)) then _
FNGetToken$ = "": Exit Def
' Section out a token from the search string. This is done by finding the
' start of a token then locating it's end by the start of separaters
TokenIndex1 = FNStrSpn(mid$(Search$, TokenIndex2, len(Search$)), InSeps$)
' If no more token bump to end of line so we move past current point
if (TokenIndex1 = 0) then _
TokenIndex1 = len(Search$): _
else TokenIndex1 = TokenIndex1 + TokenIndex2 - 1
TokenIndex2 = FNStrBrk(mid$(Search$, TokenIndex1, len(Search$)), InSeps$)
' If separater position (end of token) came back zero the token must be
' up against end of string. Set the separater position one past string
' length so that size of token computation is correct and next call
' with same string will return null for no more tokens
if (TokenIndex2 = 0) then _
TokenIndex2 = len(Search$) + 1 _
else TokenIndex2 = TokenIndex1 + TokenIndex2 - 1
' Cut out token from search string and convert to upper case.
' It is converted to upper case since string compares are case sensitive
FNGetToken$ = FNToUpper$(mid$(Search$,TokenIndex1,TokenIndex2 - TokenIndex1))
end def
'
' FNIsNumber - Checks to see if character a number or alpha
' Description:
' This routine returns true if character passed in the range 0 - 9
' It returns false if not. It is used to tell wither a token is
' a number or apha.
' Input:
' Char - character to check
' Output:
' FNIsNumber - true if within 0 - 9
'
def FNIsNumber(Char$)
if (Char$ = "") then _
FNIsNumber = false: _
else CharAsc = asc(Char$): _
FNIsNumber = ((CharAsc >= asc("0")) and (CharAsc <= asc("9")))
end def
'
' GetFileNames - Parses the input and output file names from command$
' Description:
' This routine retrieves the input and output file names. These should
' be separated by a comma with the input file name coming first.
' Input:
' Command$ - Command line
' true, false - logical flags
' Output:
' Console - flag if no output file
' InputFile$, OutputFile$ - Input/Output file name
'
sub GetFileNames static
shared Console, InputFile$, OutputFile$, Seps$, true, false
Console = false
if (Command$ = "") then _
print "No Input file. ": Inputfile$ = "": goto ExitGet
InputFile$ = FNGetToken$(Command$, Seps$)
OutputFile$ = FNGetToken$("", Seps$)
if (OutputFile$ = "") then _
Console = true
ExitGet:
end sub
'
' BuildTable - Build a table of line numbers that are references
' Description:
' This routine examines all of the text file looking for line numbers
' that are the object of goto, gosub etc. As each is found it is entered
' into a table of these line numbers. This table is used during a second
' pass at the source to remove all line numbers not in this list
' Input:
' KeyWordTable$ - array of keyword that have line number following them
' KeyWordCount - number of entries in KeyWordTable$
' Seps$ - current token Seps$
' true, false - true, false flags
' Output:
' LineTable - table of references line numbers
' LineCount - number of lines in LineTable
'
sub BuildTable static
shared KeyWordCount, Seps$, LineCount, false, true
WHILE NOT EOF( 1 )
LINE INPUT #1, inlin$
token$ = FNGetToken$(inlin$, Seps$)
WHILE (token$ <> "")
for KeyIndex = 0 to KeyWordCount
if (KeyWordTable$(KeyIndex) <> token$) then goto KeyNotFound
token$ = FNGetToken$("", Seps$)
' loop through looking for multiple lines in the case
' of a computed gosub or goto. A non-numeric will terminate
' search (another keyword etc.)
while (FNIsNumber(Left$(token$,1)))
LineCount = LineCount + 1
LineTable(LineCount) = val(token$)
token$ = FNGetToken$("", Seps$)
wend
KeyNotFound:
next KeyIndex
KeyFound:
token$ = FNGetToken$("", Seps$)
WEND
WEND
end Sub
'
' GenOutFile - Generate output file
' Description:
' This routine generates the output file removing the unreferenced line
' numbers.
' Input:
' LineTable - Table of line number that are referenced
' LineCount - number of entries in LineTable
' Seps$ - Separaters used between keywords
' Console - flags if output to file
' false, true - logical flags
'
sub GenOutFile static
shared false, true, Seps$, LineCount, Console
WHILE NOT EOF( 1 )
LINE INPUT #1, inlin$
if (inlin$ = "") then goto NoLine
token$ = FNGetToken$(inlin$, Seps$)
if (not FNIsNumber(Left$(token$,1))) then goto NoLine
LineNumber = VAL(token$)
FoundNumber = false
for index = 1 to LineCount
if (LineNumber = LineTable(index)) then _
FoundNumber = true
next index
if (not FoundNumber) then _
mid$(inlin$,FNStrSpn(inlin$,Seps$),len(token$)) = space$(len(token$))
NoLine:
if (Console) then _
PRINT inlin$ _
else Print #2, inlin$
WEND
end sub
'
' initialize the system
'
SUB initsys STATIC
SHARED true, false, KeyWordCount, Seps$, KeyWordTable$()
Seps$ = " ,:": true = -1: false = 0
RESTORE keydata 'keywords
' Initialize the keyword table. Keywords are recognized so that
' the difference between a line number and a numeric contstant can
' be determined
KeyWordCount = 0
READ KeyWord$
WHILE KeyWord$ <> ""
KeyWordCount = KeyWordCount + 1
KeyWordTable$( KeyWordCount ) = KeyWord$
READ KeyWord$
WEND
END SUB
' keyword search data
keydata:
DATA THEN, ELSE, GOSUB, GOTO, RESUME, RESTORE, ""
main:
CALL initsys
CALL GetFileNames
if (InputFile$ = "") goto ExitMain
OPEN InputFile$ FOR INPUT AS 1
call BuildTable
CLOSE #1
OPEN InputFile$ FOR INPUT AS 1
if (not Console) then _
OPEN OutputFile$ FOR OUTPUT AS 2
call GenOutFile
CLOSE #1
ExitMain:
end

33
Microsoft QuickBASIC v1/SHARED.BAS Normal file
View File

@ -0,0 +1,33 @@
loop = 1
while loop
n$ = ""
print
input "Decimal number";d
input "New base";b
print : print d;" base 10 equals ";
while d
call convert
wend
print n$;" base ";b : print
input "Convert another";r$
c$ = left$(r$,1)
if (c$ = "y" or c$ = "Y") _
then loop = 1 _
else loop = 0
wend
end
sub convert static
shared d,b,n$
r = d mod b
d = d\b
if r > 9 then goto letter _
else _
dgt$ = str$(r)
ln = len(dgt$) - 1
n$ = right$(dgt$,ln) + n$
exit sub
letter:
dgt$ = chr$(65 + r -10)
n$ = dgt$ + n$
end sub


21
Microsoft QuickBASIC v1/SIEVE.BAS Normal file
View File

@ -0,0 +1,21 @@
1 SIZE% = 8190
2 DIM FLAGS%(8191)
3 PRINT "10 iterations"
4 FOR X% = 1 TO 10
5 COUNT% = 0
6 FOR I% = 0 TO SIZE%
7 FLAGS%(I%) = 1
8 NEXT I%
9 FOR I% = 0 TO SIZE%
10 IF FLAGS%(I%) = 0 THEN 18
11 PRIME% = I% + I% + 3
12 K% = I% + PRIME%
13 IF K% > SIZE% THEN 17
14 FLAGS%(K%) = 0
15 K% = K% + PRIME%
16 GOTO 13
17 COUNT% = COUNT% + 1
18 NEXT I%
19 NEXT X%
20 PRINT COUNT%," PRIMES"
21 SYSTEM

BIN
Microsoft QuickBASIC v1/SMALLERR.OBJ Normal file
View File

Binary file not shown.

17
Microsoft QuickBASIC v1/SUB.BAS Normal file
View File

@ -0,0 +1,17 @@
input "File to be searched";f$
input "Pattern to search for";p$
open f$ for input as #1
while not eof(1)
line input #1, test$
call basgrep(test$,p$)
wend
end
sub basgrep(test$,p$) static
static num
num = num + 1
x = instr(test$,p$)
if x = 0 then exit sub _
else _
print "Line #";num;": ";test$
end sub


121
Microsoft QuickBASIC v1/TTT.BAS Normal file
View File

@ -0,0 +1,121 @@
1 REM Tic Tac Toe solving app that learns what WOPR learned: you can't win
2 REM Only three starting positions are examined. Others are just reflections of these
3 REM b% -- The board
4 REM al% -- Alpha, for pruning
5 REM be% -- Beta, for pruning
6 REM l% -- Top-level loop iteration
7 REM wi% -- The winning piece (0 none, 1 X, 2, O )
8 REM re% -- Resulting score of 4000/minmax board position. 5 draw, 6 X win, 4 Y win
9 REM sx% -- Stack array for "recursion" X can be P, V, A, or B for those variables.
10 REM v% -- Value of a board position
11 REM st% -- Stack Pointer. Even for alpha/beta pruning Minimize plys, Odd for Maximize
12 REM p% -- Current position where a new piece is played
14 REM rw% -- Row in the Winner function (2000)
15 REM cw% -- Column in the Winner function (2000)
18 REM mc% -- Move count total for debugging. Should be a multiple of 6493
19 REM Note: Can't use real recursion with GOSUB because stack is limited to roughly 5 deep
20 REM BASIC doesn't support goto/gosub using arrays for target line numbers
23 li% = val( command$ )
24 if 0 = li% then li% = 1
30 DIM b%(9)
32 DIM sp%(10)
34 DIM sv%(10)
36 DIM sa%(10)
37 DIM sb%(10)
38 mc% = 0
39 PRINT "start time: "; TIME$
40 FOR l% = 1 TO li%
41 mc% = 0
42 al% = 2
43 be% = 9
44 b%(0) = 1
45 GOSUB 4000
58 al% = 2
59 be% = 9
60 b%(0) = 0
61 b%(1) = 1
62 GOSUB 4000
68 al% = 2
69 be% = 9
70 b%(1) = 0
71 b%(4) = 1
72 GOSUB 4000
73 b%(4) = 0
74 REM print "mc: "; mc%; " l is "; l%
80 NEXT l%
82 REM print elap$
83 PRINT "end time: "; TIME$
84 print "iterations: "; li%
85 PRINT "final move count "; mc%
88 SYSTEM
100 END
2000 wi% = b%(0)
2010 IF 0 = wi% GOTO 2100
2020 IF wi% = b%(1) AND wi% = b%(2) THEN RETURN
2030 IF wi% = b%(3) AND wi% = b%(6) THEN RETURN
2100 wi% = b%(3)
2110 IF 0 = wi% GOTO 2200
2120 IF wi% = b%(4) AND wi% = b%(5) THEN RETURN
2200 wi% = b%(6)
2210 IF 0 = wi% GOTO 2300
2220 IF wi% = b%(7) AND wi% = b%(8) THEN RETURN
2300 wi% = b%(1)
2310 IF 0 = wi% GOTO 2400
2320 IF wi% = b%(4) AND wi% = b%(7) THEN RETURN
2400 wi% = b%(2)
2410 IF 0 = wi% GOTO 2500
2420 IF wi% = b%(5) AND wi% = b%(8) THEN RETURN
2500 wi% = b%(4)
2510 IF 0 = wi% THEN RETURN
2520 IF wi% = b%(0) AND wi% = b%(8) THEN RETURN
2530 IF wi% = b%(2) AND wi% = b%(6) THEN RETURN
2540 wi% = 0
2550 RETURN
4000 REM minmax function to find score of a board position
4010 REM recursion is simulated with gotos
4030 st% = 0
4040 v% = 0
4060 re% = 0
4100 mc% = mc% + 1
4102 REM gosub 3000
4104 IF st% < 4 THEN GOTO 4150
4105 GOSUB 2000
4106 IF 0 = wi% THEN GOTO 4140
4110 IF wi% = 1 THEN re% = 6: GOTO 4280
4115 re% = 4
4116 GOTO 4280
4140 IF st% = 8 THEN re% = 5: GOTO 4280
4150 IF st% AND 1 THEN v% = 2 ELSE v% = 9
4160 p% = 0
4180 IF 0 <> b%(p%) THEN GOTO 4500
4200 IF st% AND 1 THEN b%(p%) = 1 ELSE b%(p%) = 2
4210 sp%(st%) = p%
4230 sv%(st%) = v%
4245 sa%(st%) = al%
4246 sb%(st%) = be%
4260 st% = st% + 1
4270 GOTO 4100
4280 st% = st% - 1
4290 p% = sp%(st%)
4310 v% = sv%(st%)
4325 al% = sa%(st%)
4326 be% = sb%(st%)
4328 b%(p%) = 0
4330 IF st% AND 1 THEN GOTO 4340
4331 IF re% = 4 THEN GOTO 4530
4332 IF re% < v% THEN v% = re%
4334 IF v% < be% THEN be% = v%
4336 IF be% <= al% THEN GOTO 4520
4338 GOTO 4500
4340 IF re% = 6 THEN GOTO 4530
4341 IF re% > v% THEN v% = re%
4342 IF v% > al% THEN al% = v%
4344 IF al% >= be% THEN GOTO 4520
4500 p% = p% + 1
4505 IF p% < 9 THEN GOTO 4180
4520 re% = v%
4530 IF st% = 0 THEN RETURN
4540 GOTO 4280

6
Microsoft QuickBASIC v1/m.bat Normal file
View File

@ -0,0 +1,6 @@
ntvdm -c bascom %1.bas,,,
ntvdm -c link %1,,%1,.\,nul.def
ntvdm %1