-
Notifications
You must be signed in to change notification settings - Fork 4.3k
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
* Fix FreeBASIC capitalization * Add QuickBASIC with samples * Make regexes case-insensitive + small tweak * Fix comment after CLS issue * Include statement and second pass * Add CONST + VBA second pass * Improve quickbasic and freebasic heuristics * del: Remove VBA fallback for now
- Loading branch information
1 parent
120e0e5
commit d713788
Showing
12 changed files
with
374 additions
and
3 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,41 @@ | ||
| 10 PRINT "PROGRAM FILE 180: EXCEPTION - EVALUATION OF NUMERIC" | ||
| 20 PRINT " EXPRESSIONS IN THE ON-GOTO STATEMENT." | ||
| 30 PRINT " ANSI STANDARD 7.5, 10.2, 10.5" | ||
| 40 PRINT | ||
| 50 PRINT "SECTION 180.1: EXCEPTION - EVALUATION OF NUMERIC" | ||
| 60 PRINT " EXPRESSIONS IN THE ON-GOTO STATEMENT." | ||
| 70 PRINT | ||
| 80 PRINT "THIS SECTION TESTS THE EFFECT OF USING EXPRESSIONS," | ||
| 90 PRINT "WHICH CAUSE NON-FATAL EXCEPTIONS, TO CONTROL THE ON-GOG." | ||
| 100 PRINT | ||
| 130 PRINT "TO PASS THIS TEST:" | ||
| 140 PRINT | ||
| 150 PRINT " 1) TWO EXCEPTIONS MUST BE REPORTED: DIVISION " | ||
| 160 PRINT " BY ZERO AND ON-GOTO OUT OF RANGE, AND" | ||
| 170 PRINT | ||
| 180 PRINT " 2) EXECUTION MUST TERMINATE." | ||
| 190 PRINT | ||
| 193 PRINT " BEGIN TEST." | ||
| 196 PRINT | ||
| 200 PRINT "ABOUT TO EXECUTE:" | ||
| 210 PRINT " ON 1E-33 / 0 GOTO ..." | ||
| 220 LET A=0 | ||
| 230 LET C=1E-33 | ||
| 240 PRINT | ||
| 250 ON C/A GOTO 280,300,320 | ||
| 260 LET I=0 | ||
| 270 GOTO 340 | ||
| 280 LET I=1 | ||
| 290 GOTO 340 | ||
| 300 LET I=2 | ||
| 310 GOTO 340 | ||
| 320 LET I=3 | ||
| 330 GOTO 340 | ||
| 340 PRINT | ||
| 350 PRINT " PATH TAKEN FOR CONTROL-EXPRESSION = ";I | ||
| 360 PRINT "*** TEST FAILED: EXECUTION DID NOT TERMINATE ***" | ||
| 370 PRINT | ||
| 380 PRINT " END TEST." | ||
| 390 PRINT | ||
| 400 PRINT "END PROGRAM 180" | ||
| 410 END |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,57 @@ | ||
| '*********** FGetRT.Bas - demonstrates FGetRT and FPutRT in context | ||
|
|
||
| 'Copyright (c) 1989 Ethan Winer | ||
|
|
||
|
|
||
| DEFINT A-Z | ||
| DECLARE SUB FClose (Handle) | ||
| DECLARE SUB FCreate (FileName$) | ||
| DECLARE SUB FGetRT (Handle, Destination AS ANY, RecNumber&, RecLength) | ||
| DECLARE SUB FOpen (FileName$, Handle) | ||
| DECLARE SUB FPutRT (Handle, Source AS ANY, RecNumber&, RecLength) | ||
| DECLARE SUB KillFile (FileName$) | ||
|
|
||
| DECLARE FUNCTION DOSError% () | ||
| DECLARE FUNCTION WhichError% () | ||
| DECLARE FUNCTION ErrorMsg$ (ErrNumber) | ||
|
|
||
| TYPE FTest 'this is the sample type for the file test | ||
| FirstName AS STRING * 15 | ||
| LastName AS STRING * 15 | ||
| Company AS STRING * 25 | ||
| AccountNum AS LONG | ||
| WhatNot AS DOUBLE | ||
| WhyNot AS SINGLE | ||
| END TYPE | ||
| DIM TestRec AS FTest 'TestRec will hold the data to/from the file | ||
|
|
||
| CLS | ||
| F$ = "Random.Tst" 'this will be our test file | ||
| RecLength = LEN(TestRec) 'this sets the record length for gets and puts | ||
|
|
||
| FCreate F$ 'create the file | ||
| IF DOSError% THEN 'see if an error occurred creating the file | ||
| PRINT ErrorMsg$(WhichError%) | ||
| END | ||
| END IF | ||
|
|
||
| FOpen F$, Handle 'open the file for QuickPak Pro Binary | ||
|
|
||
| FOR Record& = 1 TO 100 'create one hundred records | ||
| TestRec.FirstName = "Testing" + STR$(Record&) | ||
| TestRec.WhatNot = Record& | ||
| FPutRT Handle, TestRec, Record&, RecLength | ||
| IF DOSError% THEN 'check for possible full disk | ||
| PRINT ErrorMsg$(WhichError%) | ||
| END | ||
| END IF | ||
| NEXT | ||
|
|
||
| FOR Record& = 99 TO 1 STEP -10 'read records backwards to prove it all works | ||
| FGetRT Handle, TestRec, Record&, RecLength | ||
| PRINT "Record"; Record&, TestRec.FirstName; TestRec.WhatNot | ||
| NEXT | ||
|
|
||
| FClose Handle 'close the file | ||
| KillFile F$ 'why clutter up the disk with this nonsense? | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,67 @@ | ||
| '********** VLong.Bas demos three math functions and eight byte packing | ||
|
|
||
| 'Copyright (c) 1988 Paul Passarelli | ||
| 'Copyright (c) 1988 Crescent Software | ||
|
|
||
|
|
||
| DEFINT A-Z | ||
| DECLARE SUB VLAdd (Addend1#, Addend2#, Sum#, ErrFlag%) | ||
| DECLARE SUB VLSub (Minuend#, Subtrahend#, Difference#, ErrFlag%) | ||
| DECLARE SUB VLMul (Multiplicand#, Multiplier#, Product#, ErrFlagg%) | ||
| DECLARE SUB VLPack (Number$, Value#, ErrFlag%) | ||
| DECLARE SUB VLUnpack (Value#, Number$, ErrFlag%) | ||
| DECLARE FUNCTION StripZ$ (X$) 'strips leading zeros for the demo | ||
|
|
||
|
|
||
| CLS | ||
| LINE INPUT "Enter a big number (up to 19 digits): ", Num1$ | ||
| LINE INPUT " Enter another big number: ", Num2$ | ||
|
|
||
| VLPack Num1$, Num1#, ErrFlag | ||
| IF ErrFlag% GOTO ErrHandler | ||
|
|
||
| VLPack Num2$, Num2#, ErrFlag | ||
| IF ErrFlag% GOTO ErrHandler | ||
|
|
||
| VLAdd Num1#, Num2#, Sum#, ErrFlag | ||
| UPSum$ = SPACE$(20) | ||
| VLUnpack Sum#, UPSum$, ErrFlag% | ||
| IF ErrFlag% GOTO ErrHandler | ||
|
|
||
| PRINT Num1$; " + "; Num2$; " = "; StripZ$(UPSum$) | ||
|
|
||
| VLSub Num1#, Num2#, Sum#, ErrFlag | ||
| UPSum$ = SPACE$(20) | ||
| VLUnpack Sum#, UPSum$, ErrFlag% | ||
| IF ErrFlag% GOTO ErrHandler | ||
|
|
||
| PRINT Num1$; " - "; Num2$; " = "; StripZ$(UPSum$) | ||
|
|
||
| VLPack "2", Num3#, ErrFlag | ||
| VLMul Num1#, Num3#, Prod#, ErrFlag | ||
| IF ErrFlag% GOTO ErrHandler | ||
| VLUnpack Prod#, UPSum$, ErrFlag% | ||
| PRINT Num1$; " * 2 = "; StripZ$(UPSum$) | ||
|
|
||
| VLPack "3", Num3#, ErrFlag | ||
| VLMul Num1#, Num3#, Prod#, ErrFlag | ||
| IF ErrFlag% GOTO ErrHandler | ||
| VLUnpack Prod#, UPSum$, ErrFlag% | ||
| PRINT Num1$; " * 3 = "; StripZ$(UPSum$) | ||
|
|
||
| END | ||
|
|
||
| ErrHandler: | ||
| PRINT "Error - press any key "; | ||
|
|
||
| FUNCTION StripZ$ (X$) | ||
| FOR X = 2 TO LEN(X$) | ||
| IF MID$(X$, X, 1) <> "0" THEN | ||
| StripZ$ = LEFT$(X$, 1) + MID$(X$, X) | ||
| EXIT FUNCTION | ||
| END IF | ||
| NEXT | ||
| END FUNCTION | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,115 @@ | ||
| ' Sponge4: a sponge construction based on RC4 | ||
| ' Ref: https://nullprogram.com/blog/2020/11/17/ | ||
| ' This is free and unencumbered software released into the public domain. | ||
|
|
||
| TYPE sponge4 | ||
| i AS INTEGER | ||
| j AS INTEGER | ||
| k AS INTEGER | ||
| s(0 TO 255) AS INTEGER | ||
| END TYPE | ||
|
|
||
| DECLARE SUB init (r AS sponge4) | ||
| DECLARE SUB absorb (r AS sponge4, b AS INTEGER) | ||
| DECLARE SUB absorbstop (r AS sponge4) | ||
| DECLARE SUB absorbstr (r AS sponge4, x AS STRING) | ||
|
|
||
| DECLARE FUNCTION squeeze% (r AS sponge4) | ||
| DECLARE FUNCTION squeeze24& (r AS sponge4) | ||
| DECLARE FUNCTION squeezen% (r AS sponge4, n AS INTEGER) | ||
|
|
||
| CONST ntickets = 208 | ||
| CONST nresults = 12 | ||
|
|
||
| DIM tickets(0 TO ntickets - 1) AS INTEGER | ||
| FOR i = 0 TO ntickets - 1 | ||
| tickets(i) = i | ||
| NEXT | ||
|
|
||
| DIM sponge AS sponge4 | ||
| init sponge | ||
| absorbstr sponge, DATE$ | ||
| absorbstr sponge, MKS$(TIMER) | ||
| absorbstr sponge, MKI$(ntickets) | ||
|
|
||
| CLS | ||
| PRINT "Press Esc to finish, any other key for entropy..." | ||
| t = TIMER | ||
| DO | ||
| c& = c& + 1 | ||
| LOCATE 2, 1 | ||
| PRINT "cycles ="; c&; "; keys ="; k% | ||
|
|
||
| FOR i% = ntickets - 1 TO 1 STEP -1 | ||
| j% = squeezen%(sponge, i% + 1) | ||
| SWAP tickets(i%), tickets(j%) | ||
| NEXT | ||
|
|
||
| k$ = INKEY$ | ||
| IF k$ = CHR$(27) THEN | ||
| EXIT DO | ||
| ELSEIF k$ <> "" THEN | ||
| k% = k% + 1 | ||
| absorbstr sponge, k$ | ||
| END IF | ||
| absorbstr sponge, MKS$(TIMER) | ||
| LOOP | ||
|
|
||
| FOR i% = 1 TO nresults | ||
| PRINT tickets(i%) | ||
| NEXT | ||
|
|
||
| SUB absorb (r AS sponge4, b AS INTEGER) | ||
| r.j = (r.j + r.s(r.i) + b) MOD 256 | ||
| SWAP r.s(r.i), r.s(r.j) | ||
| r.i = (r.i + 1) MOD 256 | ||
| r.k = (r.k + 1) MOD 256 | ||
| END SUB | ||
|
|
||
| SUB absorbstop (r AS sponge4) | ||
| r.j = (r.j + 1) MOD 256 | ||
| END SUB | ||
|
|
||
| SUB absorbstr (r AS sponge4, x AS STRING) | ||
| FOR i% = 1 TO LEN(x) | ||
| absorb r, ASC(MID$(x, i%)) | ||
| NEXT | ||
| END SUB | ||
|
|
||
| SUB init (r AS sponge4) | ||
| r.i = 0 | ||
| r.j = 0 | ||
| r.k = 0 | ||
| FOR i% = 0 TO 255 | ||
| r.s(i%) = i% | ||
| NEXT | ||
| END SUB | ||
|
|
||
| FUNCTION squeeze% (r AS sponge4) | ||
| IF r.k > 0 THEN | ||
| absorbstop r | ||
| DO WHILE r.k > 0 | ||
| absorb r, r.k | ||
| LOOP | ||
| END IF | ||
|
|
||
| r.j = (r.j + r.i) MOD 256 | ||
| r.i = (r.i + 1) MOD 256 | ||
| SWAP r.s(r.i), r.s(r.j) | ||
| squeeze% = r.s((r.s(r.i) + r.s(r.j)) MOD 256) | ||
| END FUNCTION | ||
|
|
||
| FUNCTION squeeze24& (r AS sponge4) | ||
| b0& = squeeze%(r) | ||
| b1& = squeeze%(r) | ||
| b2& = squeeze%(r) | ||
| squeeze24& = b2& * &H10000 + b1& * &H100 + b0& | ||
| END FUNCTION | ||
|
|
||
| FUNCTION squeezen% (r AS sponge4, n AS INTEGER) | ||
| DO | ||
| x& = squeeze24&(r) - &H1000000 MOD n | ||
| LOOP WHILE x& < 0 | ||
| squeezen% = x& MOD n | ||
| END FUNCTION | ||
|
|
Oops, something went wrong.