RHA (Minisystems) ALGOL v5.5
This commit is contained in:
davidly
parent
b37bf2b3b2
commit
240ab1b0fc
BIN
RHA (Minisystems) ALGOL v55/ALGOL.EXE
Normal file
BIN
RHA (Minisystems) ALGOL v55/ALGOL.EXE
Normal file
Binary file not shown.
1710
RHA (Minisystems) ALGOL v55/ALGOL.IAG
Normal file
1710
RHA (Minisystems) ALGOL v55/ALGOL.IAG
Normal file
File diff suppressed because it is too large
Load Diff
107
RHA (Minisystems) ALGOL v55/ALGOL60.CNT
Normal file
107
RHA (Minisystems) ALGOL v55/ALGOL60.CNT
Normal file
@ -0,0 +1,107 @@
|
||||
|
||||
1 Introduction
|
||||
2 Licence agreement - please read this first=Sec_1_1
|
||||
2 History=Sec_1_2
|
||||
2 Document overview=Sec_1_3
|
||||
1 Z80 User manual
|
||||
2 Z80 manual introduction=Sec_2_1
|
||||
2 Language elements
|
||||
2 Identifiers and symbols=Sec_2_3
|
||||
2 Key words=Sec_2_4
|
||||
2 Pre-declared identifiers=Sec_2_5
|
||||
2 String literals=Sec_2_6
|
||||
2 Character literals=Sec_2_7
|
||||
2 The structure of an Algol program
|
||||
2 Program structure=Sec_2_9
|
||||
2 Blocks and declarations=Sec_2_10
|
||||
2 Program layout and style=Sec_2_11
|
||||
2 Conditional compilation=Sec_2_12
|
||||
2 Algol program variables
|
||||
2 Data types=Sec_2_14
|
||||
2 Arrays=Sec_2_15
|
||||
2 Array memory layout and bound checking=Sec_2_16
|
||||
2 Byte arrays=Sec_2_17
|
||||
2 Expressions
|
||||
2 Simple expressions=Sec_2_19
|
||||
2 Conditional expressions=Sec_2_20
|
||||
2 Statements
|
||||
2 Conditional statements=Sec_2_22
|
||||
2 Assignment statements=Sec_2_23
|
||||
2 FOR statements=Sec_2_24
|
||||
2 The CASE statement=Sec_2_25
|
||||
2 The WHILE statement=Sec_2_26
|
||||
2 The REPEAT statement=Sec_2_27
|
||||
2 Dummy statements=Sec_2_28
|
||||
2 Comments=Sec_2_29
|
||||
2 Labels, switches and GOTO statements=Sec_2_30
|
||||
2 Designational expressions=Sec_2_31
|
||||
2 Procedures
|
||||
2 Standard functions=Sec_2_33
|
||||
2 Operating system identification=Sec_2_34
|
||||
2 Procedures without parameters=Sec_2_35
|
||||
2 Procedures with parameters=Sec_2_36
|
||||
2 Numeric and Boolean parameters by value=Sec_2_37
|
||||
2 Variables called by name=Sec_2_38
|
||||
2 String and switch procedure parameters=Sec_2_39
|
||||
2 Labels and procedures as parameters=Sec_2_40
|
||||
2 Summary of points on procedures=Sec_2_41
|
||||
2 Differences from the Algol 60 report
|
||||
2 Differences from the Algol 60 report=Sec_2_43
|
||||
2 Language restrictions=Sec_2_44
|
||||
2 Language extensions=Sec_2_45
|
||||
2 The input/output mechanism
|
||||
2 Stream or device numbers=Sec_2_47
|
||||
2 ALGOL fixed stream numbers=Sec_2_48
|
||||
2 Printer position on streams 3 and 6=Sec_2_49
|
||||
2 Device names in command Lines=Sec_2_50
|
||||
2 Creating a command line for I/O streams=Sec_2_51
|
||||
2 Parsing the I/O command line=Sec_2_52
|
||||
2 Input/output directly to or from memory=Sec_2_53
|
||||
2 Switch lists on I/O selections=Sec_2_54
|
||||
2 Closing and deleting files=Sec_2_55
|
||||
2 Serial input/output procedures=Sec_2_56
|
||||
2 Formatted number output=Sec_2_57
|
||||
2 Random access files=Sec_2_58
|
||||
2 Input/output support routines=Sec_2_59
|
||||
2 Direct BDOS and BIOS CP/M calls=Sec_2_60
|
||||
2 Library procedures
|
||||
2 Library procedures=Sec_2_62
|
||||
2 Library inserts=Sec_2_63
|
||||
2 Example programs=Sec_2_64
|
||||
2 Compiling and running programs
|
||||
2 Compiling and running programs=Sec_2_66
|
||||
2 Compiling=Sec_2_67
|
||||
2 Compiler directives=Sec_2_68
|
||||
2 Character and bitstream compiler output files=Sec_2_69
|
||||
2 Pre-compiled libraries and the linker=Sec_2_70
|
||||
2 Runtime program=Sec_2_71
|
||||
2 Switches on the loader filename=Sec_2_72
|
||||
2 Long integer (32 bit) Algol=Sec_2_73
|
||||
2 The chaining mechanism=Sec_2_74
|
||||
2 Compiler error messages and diagnostic information
|
||||
2 Compiler error messages=Sec_2_76
|
||||
2 Compiler identifier table and identifier types=Sec_2_77
|
||||
2 Compiler representation of basic symbols=Sec_2_78
|
||||
2 Run time errors and diagnostic information
|
||||
2 Run time errors=Sec_2_80
|
||||
2 Recovery from run time errors=Sec_2_81
|
||||
2 Runtime error numbers=Sec_2_82
|
||||
2 Runtime stack organisation=Sec_2_83
|
||||
2 Runtime operation codes=Sec_2_84
|
||||
2 Summary of ioc() procedure calls=Sec_2_85
|
||||
2 Summary of pre-declared procedures=Sec_2_86
|
||||
2 Procedures in the library ALIB.ALG=Sec_2_87
|
||||
2 Distributed programs and files=Sec_2_88
|
||||
1 Rogalgol for the 80x86
|
||||
2 Overview of 80x86 Rogalgol=Sec_3_1
|
||||
2 Extra features available on the 80x86 versions
|
||||
2 Using extra data memory beyond 64K=Sec_3_3
|
||||
2 The Runtime Debugger=Sec_3_4
|
||||
2 File handling under PCDOS and MSDOS
|
||||
2 Overview of MSDOS file handling=Sec_3_6
|
||||
2 File Control Block usage=Sec_3_7
|
||||
2 The operating system interface
|
||||
2 Overview of BIOS and SYSTEM calls=Sec_3_9
|
||||
2 BDOS (system) calls under MSDOS/PCDOS=Sec_3_10
|
||||
2 BIOS calls under MSDOS/PCDOS=Sec_3_11
|
||||
2 Compiling and linking the 80x86 Rogalgol executables=Sec_3_12
|
||||
BIN
RHA (Minisystems) ALGOL v55/ALGOL60.HLP
Normal file
BIN
RHA (Minisystems) ALGOL v55/ALGOL60.HLP
Normal file
Binary file not shown.
4465
RHA (Minisystems) ALGOL v55/ALGOL60.TXT
Normal file
4465
RHA (Minisystems) ALGOL v55/ALGOL60.TXT
Normal file
File diff suppressed because it is too large
Load Diff
47
RHA (Minisystems) ALGOL v55/ALIB.ALG
Normal file
47
RHA (Minisystems) ALGOL v55/ALIB.ALG
Normal file
@ -0,0 +1,47 @@
|
||||
'PROCEDURE' ERROR 'EXT' ;
|
||||
|
||||
'INTEGER' 'PROCEDURE' LOCATION 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' RBLOCK 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' WBLOCK 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' FSPACE 'EXT';
|
||||
|
||||
'PROCEDURE' SETI 'EXT';
|
||||
|
||||
'PROCEDURE' SETO 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' IPOINT 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' OPOINT 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' EXFLT 'EXT';
|
||||
|
||||
'PROCEDURE' BLMOVE 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' SWLIST 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' FINDINPUT 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' FINDOUTPUT 'EXT';
|
||||
|
||||
'PROCEDURE' GETLIST 'EXT';
|
||||
|
||||
'PROCEDURE' OUT 'EXT';
|
||||
|
||||
'PROCEDURE' ATEXT 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' TLEN 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' SLOC 'EXT';
|
||||
|
||||
'INTEGER' 'PROCEDURE' SMATCH 'EXT';
|
||||
|
||||
'PROCEDURE' POINT 'EXT';
|
||||
|
||||
'PROCEDURE' CHPOS 'EXT';
|
||||
|
||||
'PROCEDURE' LINE 'EXT';
|
||||
|
||||
|
||||
BIN
RHA (Minisystems) ALGOL v55/ALIB.ASC
Normal file
BIN
RHA (Minisystems) ALGOL v55/ALIB.ASC
Normal file
Binary file not shown.
121
RHA (Minisystems) ALGOL v55/ALIB.SRC
Normal file
121
RHA (Minisystems) ALGOL v55/ALIB.SRC
Normal file
@ -0,0 +1,121 @@
|
||||
'DIRECTIVE' P;
|
||||
'BEGIN'
|
||||
|
||||
'INTEGER''PROCEDURE' CPM(N,DE); 'VALUE' N,DE;
|
||||
'INTEGER' N,DE; IOC(48);
|
||||
|
||||
'PROCEDURE' ERROR(L);
|
||||
'LABEL' L; IOC(23);
|
||||
|
||||
'INTEGER' 'PROCEDURE' LOCATION(I);
|
||||
'VALUE' I; 'REAL' I; IOC(24);
|
||||
|
||||
'INTEGER' 'PROCEDURE' RBLOCK(C,A,B,N);
|
||||
'VALUE' C,A,B,N; 'INTEGER' C,A,B,N; IOC(26);
|
||||
|
||||
'INTEGER' 'PROCEDURE' WBLOCK(C,A,B,N);
|
||||
'VALUE' C,A,B,N; 'INTEGER' C,A,B,N; IOC(27);
|
||||
|
||||
|
||||
'INTEGER' 'PROCEDURE' FSPACE;
|
||||
IOC(29);
|
||||
|
||||
'PROCEDURE' SETI(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(30);
|
||||
|
||||
'PROCEDURE' SETO(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(31);
|
||||
|
||||
'INTEGER' 'PROCEDURE' IPOINT;
|
||||
IOC(32);
|
||||
|
||||
'INTEGER' 'PROCEDURE' OPOINT;
|
||||
IOC(33);
|
||||
|
||||
'INTEGER' 'PROCEDURE' EXFLT(A,T);
|
||||
'VALUE' A,T; 'INTEGER' A,T; IOC(34);
|
||||
|
||||
'PROCEDURE' BLMOVE(S,D,L);
|
||||
'VALUE' S,D,L; 'INTEGER' S,D,L; IOC(35);
|
||||
|
||||
'INTEGER' 'PROCEDURE' SWLIST;
|
||||
IOC(39);
|
||||
|
||||
'INTEGER' 'PROCEDURE' FINDINPUT(S);
|
||||
'STRING' S;
|
||||
'BEGIN' GETLIST(S); IOC(5);
|
||||
FINDINPUT:=INPUT; IOC(1)
|
||||
'END';
|
||||
|
||||
'INTEGER' 'PROCEDURE' FINDOUTPUT(S);
|
||||
'STRING' S;
|
||||
'BEGIN' GETLIST(S); IOC(3);
|
||||
FINDOUTPUT:=OUTPUT; IOC(1)
|
||||
'END';
|
||||
|
||||
'PROCEDURE' GETLIST(S);
|
||||
'STRING' S;
|
||||
'BEGIN' 'INTEGER' I;
|
||||
IOC(0); IOC(1); TEXT(7,S);
|
||||
CHOUT(7,0);
|
||||
I:=CHIN(7);
|
||||
'IF' I=&? 'THEN'
|
||||
'BEGIN' 'FOR' I:=CHIN(7) 'WHILE'
|
||||
I#0 'DO' CHOUT(1,I);
|
||||
I:=CHIN(7)
|
||||
'END';
|
||||
IOC(0);
|
||||
'END';
|
||||
|
||||
'PROCEDURE' OUT(C,V);
|
||||
'VALUE' C,V; 'INTEGER' C,V; IOC(52);
|
||||
|
||||
'PROCEDURE' ATEXT(D,A);
|
||||
'VALUE' D,A; 'INTEGER' D,A; IOC(53);
|
||||
|
||||
'INTEGER' 'PROCEDURE' TLEN(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(54);
|
||||
|
||||
'INTEGER' 'PROCEDURE' SLOC(S);
|
||||
'STRING' S; IOC(55);
|
||||
|
||||
'INTEGER' 'PROCEDURE' SMATCH(L,S);
|
||||
'VALUE' L,S; 'INTEGER' L,S; IOC(56);
|
||||
|
||||
'PROCEDURE' POINT(X,Y,Z);
|
||||
'VALUE' X,Y,Z; 'INTEGER' X,Y,Z; IOC(61);
|
||||
|
||||
'PROCEDURE' CHPOS(X,Y);
|
||||
'VALUE' X,Y; 'INTEGER' X,Y; IOC(62);
|
||||
|
||||
'PROCEDURE' LINE(XC,YC,DX,DY,Z);
|
||||
'VALUE' XC,YC,DX,DY,Z; 'INTEGER' XC,YC,DX,DY,Z;
|
||||
'BEGIN' 'INTEGER' I,R,S,SX,SY,SXX,SYY,M,XX,YY;
|
||||
|
||||
DX:=DX-XC; DY:=DY-YC;
|
||||
XX:=ABS(DX); YY:=ABS(DY);
|
||||
SXX:=SIGN(DX); SYY:=SIGN(DY);
|
||||
'IF' XX>YY 'THEN'
|
||||
'BEGIN' M:=XX; R:=XX%2; S:=YY;
|
||||
SX:=SXX; SY:=0;
|
||||
'END' 'ELSE'
|
||||
'BEGIN' M:=YY; R:=YY%2; S:=XX;
|
||||
SX:=0; SY:=SYY;
|
||||
'END' ;
|
||||
POINT(XC,YC,Z);
|
||||
'FOR' I:=1 'STEP' 1 'UNTIL' M 'DO'
|
||||
'BEGIN' R:=R-S;
|
||||
'IF' R<0 'THEN'
|
||||
'BEGIN' XC:=XC+SXX;
|
||||
YC:=YC+SYY;
|
||||
R:=R+M
|
||||
'END' 'ELSE'
|
||||
'BEGIN' XC:=XC+SX;
|
||||
YC:=YC+SY
|
||||
'END' ;
|
||||
POINT(XC,YC,Z)
|
||||
'END'
|
||||
'END' ;
|
||||
'END''FINISH'
|
||||
|
||||
|
||||
10
RHA (Minisystems) ALGOL v55/ALIBL.ALG
Normal file
10
RHA (Minisystems) ALGOL v55/ALIBL.ALG
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
'PROCEDURE' POW10(N);
|
||||
'VALUE' N; 'INTEGER' N;
|
||||
IOC(46);
|
||||
|
||||
'REAL' 'PROCEDURE' LREM(T,B);
|
||||
'VALUE' T,B; 'REAL' T,B;
|
||||
IOC(63);
|
||||
|
||||
|
||||
BIN
RHA (Minisystems) ALGOL v55/ALINK.EXE
Normal file
BIN
RHA (Minisystems) ALGOL v55/ALINK.EXE
Normal file
Binary file not shown.
BIN
RHA (Minisystems) ALGOL v55/ALINKL.EXE
Normal file
BIN
RHA (Minisystems) ALGOL v55/ALINKL.EXE
Normal file
Binary file not shown.
BIN
RHA (Minisystems) ALGOL v55/ALINKS.EXE
Normal file
BIN
RHA (Minisystems) ALGOL v55/ALINKS.EXE
Normal file
Binary file not shown.
BIN
RHA (Minisystems) ALGOL v55/ARUN.EXE
Normal file
BIN
RHA (Minisystems) ALGOL v55/ARUN.EXE
Normal file
Binary file not shown.
BIN
RHA (Minisystems) ALGOL v55/ARUNL.EXE
Normal file
BIN
RHA (Minisystems) ALGOL v55/ARUNL.EXE
Normal file
Binary file not shown.
39
RHA (Minisystems) ALGOL v55/E.ALG
Normal file
39
RHA (Minisystems) ALGOL v55/E.ALG
Normal file
@ -0,0 +1,39 @@
|
||||
BEGIN
|
||||
|
||||
PROCEDURE main;
|
||||
BEGIN
|
||||
INTEGER ARRAY a[0:200];
|
||||
INTEGER high, n, x;
|
||||
|
||||
high := 200;
|
||||
x := 0;
|
||||
|
||||
n := high - 1;
|
||||
WHILE n > 0 DO BEGIN
|
||||
a[ n ] := 1;
|
||||
n := n - 1;
|
||||
END;
|
||||
|
||||
a[ 1 ] := 2;
|
||||
a[ 0 ] := 0;
|
||||
|
||||
WHILE high > 9 DO BEGIN
|
||||
n := high;
|
||||
high := high - 1;
|
||||
WHILE 0 # n DO BEGIN
|
||||
a[ n ] := x MOD n;
|
||||
x := 10 * a[ n - 1 ] + x % n;
|
||||
n := n - 1;
|
||||
END;
|
||||
write( 1, x );
|
||||
END;
|
||||
|
||||
text( 1, "*Ndone*N" );
|
||||
ioc(22);
|
||||
END;
|
||||
|
||||
main;
|
||||
|
||||
END
|
||||
FINISH
|
||||
|
||||
26
RHA (Minisystems) ALGOL v55/HELLO.ALG
Normal file
26
RHA (Minisystems) ALGOL v55/HELLO.ALG
Normal file
@ -0,0 +1,26 @@
|
||||
BEGIN
|
||||
|
||||
INTEGER ARRAY board[0:8];
|
||||
|
||||
PROCEDURE winner;
|
||||
BEGIN
|
||||
INTEGER t, p;
|
||||
text( 1, "hello from winner" );
|
||||
|
||||
p := 0;
|
||||
t := board[ 0 ];
|
||||
IF 0 # t THEN BEGIN
|
||||
IF ( ( ( t = board[1] ) AND ( t = board[2] ) ) OR
|
||||
( ( t = board[3] ) AND ( t = board[6] ) ) ) THEN
|
||||
p := t;
|
||||
END;
|
||||
|
||||
END winner;
|
||||
|
||||
text( 1, "hello from algol, dave" );
|
||||
winner;
|
||||
ioc(22);
|
||||
|
||||
END
|
||||
FINISH
|
||||
|
||||
BIN
RHA (Minisystems) ALGOL v55/ICOM.EXE
Normal file
BIN
RHA (Minisystems) ALGOL v55/ICOM.EXE
Normal file
Binary file not shown.
892
RHA (Minisystems) ALGOL v55/ICOM.IAG
Normal file
892
RHA (Minisystems) ALGOL v55/ICOM.IAG
Normal file
@ -0,0 +1,892 @@
|
||||
|
||||
'BEGIN'
|
||||
'BYTE''ARRAY' DIG[1:20],IDN[0:100];
|
||||
|
||||
'INTEGER' INDEV,DEV,SIZE,CHAR,LINE,BS,DECL,TYPE,NLAB,FIRST,
|
||||
MAX,LDPT,NADR,DBASE,NODEC,ADDR,HEL1,DEPTH,FIXSP,HMPD,
|
||||
DEVT,ITEM,MAXNID,MAXLAB,DOS,ILFP,FRFP;
|
||||
|
||||
'BOOLEAN' SECOND,DOLL,LETTER,DIGIT,FOUND,
|
||||
TABLES,FRED,HOL1,STRING,CPR;
|
||||
|
||||
'INTEGER''PROCEDURE' FREESP; IOC(10);
|
||||
|
||||
MAXNID:=FREESP%2; 'IF' MAXNID<0 'THEN' MAXNID:=MAXNID+32767;
|
||||
MAXNID:=(MAXNID-1500)%6;
|
||||
MAXLAB:=150;
|
||||
|
||||
'BEGIN'
|
||||
'INTEGER''ARRAY' ILNP,VADR[1:MAXNID],
|
||||
FRNP,FRLN,FLINE[1:MAXLAB];
|
||||
'BYTE''ARRAY' IL[0:MAXNID*6],ILVT,ILBD[1:MAXNID],
|
||||
FLVT,FLBD[1:MAXLAB],FRN[0:MAXLAB*6];
|
||||
|
||||
'PROCEDURE' INCH;
|
||||
'BEGIN'
|
||||
'IF' HOL1 'THEN' HOL1:='FALSE'
|
||||
'ELSE''BEGIN' CHIN(,CHAR);
|
||||
'IF' CHAR=13 'THEN' LINE:=LINE+1;
|
||||
'END';
|
||||
'END';
|
||||
|
||||
'PROCEDURE' ABS;
|
||||
'BEGIN' 'IF' DOLL 'THEN''BEGIN' WARN(27); 'GOTO' EPROG;
|
||||
'END' READING BEYOND THE END;
|
||||
LYY: 'IF' HOL1 'THEN' HOL1:='FALSE'
|
||||
'ELSE''BEGIN' CHIN(,CHAR);
|
||||
'IF' CHAR=13 'THEN''BEGIN' LINE:=LINE+1;
|
||||
'GOTO' LYY; 'END';
|
||||
'END';
|
||||
'IF'CHAR=39'THEN'
|
||||
'BEGIN' CHIN(,CHAR);
|
||||
BS:=40*(CHAR-64);
|
||||
CHIN(,CHAR); BS:=BS+CHAR-64;
|
||||
'IF'BS<64'THEN'BS:=BS+64;
|
||||
LZZ: CHIN(,CHAR);
|
||||
'IF' CHAR#39 'THEN''GOTO' LZZ;
|
||||
DIGIT:='FALSE'; LETTER:='FALSE'; DOLL:='FALSE';
|
||||
'END''ELSE'
|
||||
'IF' CHAR<33 'THEN''GOTO' LYY 'ELSE'
|
||||
'IF' CHAR<58 'THEN''BEGIN' LETTER:='FALSE';
|
||||
DOLL:=CHAR=36; DIGIT:=CHAR>47;
|
||||
BS:=CHAR; 'END''ELSE'
|
||||
'IF' CHAR<65 'THEN''BEGIN' BS:=CHAR;
|
||||
'IF' BS=58 'THEN''BEGIN'
|
||||
INCH; 'IF' CHAR=61 'THEN' BS:=33
|
||||
'ELSE' HOL1:='TRUE';
|
||||
'END''ELSE''IF' BS=60 'THEN''BEGIN'
|
||||
INCH; 'IF' CHAR=61 'THEN' BS:=63
|
||||
'ELSE' HOL1:='TRUE';
|
||||
'END''ELSE''IF' BS=62 'THEN''BEGIN'
|
||||
INCH; 'IF' CHAR=61 'THEN' BS:=38
|
||||
'ELSE' HOL1:='TRUE';
|
||||
'END';
|
||||
LETTER:='FALSE'; DIGIT:='FALSE'; DOLL:='FALSE';
|
||||
'END' BS<65
|
||||
'ELSE''BEGIN' BS:=CHAR-64;
|
||||
LETTER:=BS<27; DIGIT:='FALSE'; DOLL:='FALSE';
|
||||
'END' CHAR>=65;
|
||||
'END' ABS;
|
||||
|
||||
'BOOLEAN''PROCEDURE' TERM;
|
||||
TERM:=BS=214 'OR' BS=59 'OR' BS=212 'OR' BS=36;
|
||||
|
||||
'PROCEDURE' SEMI(FNO); 'VALUE' FNO; 'INTEGER' FNO;
|
||||
'BEGIN' CHFAIL(59,FNO); COMMENT 'END';
|
||||
|
||||
'PROCEDURE' COMMENT;
|
||||
L: 'IF' BS=135 'THEN'
|
||||
'BEGIN' CL: INCH; 'IF' CHAR#59 'THEN''GOTO' CL 'ELSE'
|
||||
'BEGIN' ABS; 'GOTO' L
|
||||
'END'
|
||||
'END' CHECK FOR COMMENT;
|
||||
|
||||
'BOOLEAN''PROCEDURE' BTYPE;
|
||||
BTYPE:=TYPE=3 'OR' TYPE=7 'OR' TYPE=13;
|
||||
|
||||
'PROCEDURE' DEFINE(L1,L2); 'VALUE' L1,L2; 'INTEGER' L1,L2;
|
||||
'BEGIN' SKIP(); WRITE(,"L",L1);
|
||||
'IF' DOS=2 'THEN' WRITE(," EQU ") 'ELSE' WRITE(,"=");
|
||||
WRITE(,"L",L2); SKIP();
|
||||
ITEM:=0;
|
||||
'END';
|
||||
|
||||
'INTEGER''PROCEDURE' LOWER(X); 'VALUE' X; 'INTEGER' X;
|
||||
LOWER:=X-X%256*256;
|
||||
|
||||
'PROCEDURE' IDENT;
|
||||
'BEGIN''INTEGER' I,J;
|
||||
IDN[0]:='IF' BS<27 'THEN' BS+64 'ELSE' BS+21;
|
||||
I:=1;
|
||||
NCH: INCH;
|
||||
'IF' CHAR>64 'AND' CHAR<91 'THEN'
|
||||
'BEGIN'
|
||||
IDN[I]:=CHAR; I:=I+1; 'GOTO' NCH;
|
||||
'END'
|
||||
'ELSE''IF' CHAR>47 'AND' CHAR<58 'THEN'
|
||||
'BEGIN'
|
||||
IDN[I]:=CHAR; I:=I+1; 'GOTO' NCH;
|
||||
'END'
|
||||
'ELSE''IF' CHAR<33 'THEN''GOTO' NCH;
|
||||
IDN[I]:=0; HOL1:='TRUE'; ABS; FOUND:='FALSE';
|
||||
'FOR' DECL:=NODEC 'STEP' -1 'UNTIL' 1 'DO'
|
||||
'BEGIN' J:=ILNP[DECL];
|
||||
'FOR' I:=0 'STEP' 1 'UNTIL' 100 'DO'
|
||||
'BEGIN''IF' IL[J+I] # IDN[I] 'THEN''GOTO' ID5;
|
||||
'IF' IDN[I]=0 'THEN'
|
||||
'BEGIN' FOUND:='TRUE';
|
||||
TYPE:=ILVT[DECL]; ADDR:=VADR[DECL];
|
||||
'GOTO' ESRC;
|
||||
'END' IDENTIFIER FOUND;
|
||||
'END' LOOK AT ONE CHARACTER;
|
||||
ID5: 'END' LOOK AT ONE IDENTIFIER;
|
||||
ESRC:
|
||||
'END' SEARCH DECLARATION LIST;
|
||||
|
||||
'PROCEDURE' CODE(X); 'VALUE' X; 'INTEGER' X;
|
||||
'BEGIN' 'IF' ITEM=0 'THEN'
|
||||
'BEGIN' SKIP();
|
||||
'IF' DOS>1 'THEN' WRITE(," DB ");
|
||||
'END'
|
||||
'ELSE' WRITE(,",");
|
||||
WRITE(,X); ITEM:=ITEM+1;
|
||||
'IF' ITEM>8 'THEN' ITEM:=0;
|
||||
SIZE:=SIZE+1;
|
||||
'END' CODE OUTPUT;
|
||||
|
||||
'PROCEDURE' SIXBIT(CONST); 'VALUE' CONST; 'INTEGER' CONST;
|
||||
'IF' CONST=0 'THEN' CODE(29)
|
||||
'ELSE''IF' CONST>64 'THEN'
|
||||
'BEGIN' CODE(42); CODE(CONST) 'END'
|
||||
'ELSE' CODE(63+CONST);
|
||||
|
||||
'PROCEDURE' LDEC(LNO); 'VALUE' LNO; 'INTEGER' LNO;
|
||||
'BEGIN' SKIP(); WRITE(,"L",LNO);
|
||||
'IF' DOS=3 'THEN'
|
||||
'BEGIN' WRITE(,"="); CHOUT(,36) 'END'
|
||||
'ELSE' WRITE(,":");
|
||||
ITEM:=0;
|
||||
'END';
|
||||
|
||||
'PROCEDURE' LABEL(LNO); 'VALUE' LNO; 'INTEGER' LNO;
|
||||
'BEGIN' SKIP();
|
||||
'IF' DOS>1 'THEN' WRITE(," DW OFFSET L")
|
||||
'ELSE' WRITE(,"#L");
|
||||
WRITE(,LNO); SIZE:=SIZE+2; ITEM:=0;
|
||||
'END';
|
||||
|
||||
'INTEGER''PROCEDURE' JMPNEW;
|
||||
'BEGIN' JMP(NLAB);
|
||||
JMPNEW:=NLAB; NLAB:=NLAB+1 'END';
|
||||
|
||||
'PROCEDURE' JMP(LNO); 'VALUE' LNO; 'INTEGER' LNO;
|
||||
'BEGIN' CODE(9); LABEL(LNO) 'END';
|
||||
|
||||
'INTEGER''PROCEDURE' CJMP;
|
||||
'BEGIN' CODE(28); LABEL(NLAB);
|
||||
CJMP:=NLAB; NLAB:=NLAB+1 'END';
|
||||
|
||||
'PROCEDURE' SID;
|
||||
'BEGIN''INTEGER' I;
|
||||
'IF' TABLES 'THEN'
|
||||
'BEGIN' SKIP(DEVT); IDOUT;
|
||||
WRITE(DEVT," ",ADDR," ",TYPE); CHOUT(DEV);
|
||||
'END';
|
||||
'IF' NODEC=MAXNID 'THEN' WARN(15) 'ELSE' NODEC:=NODEC+1;
|
||||
'IF' FOUND 'AND' DECL>DBASE 'THEN' WARN(1);
|
||||
'IF' TYPE#4 'AND' TYPE<10 'THEN'
|
||||
'BEGIN' 'IF' ADDR>FIXSP 'THEN' FIXSP:=ADDR;
|
||||
'IF' ADDR>255 'THEN' WARN(5)
|
||||
'END';
|
||||
ILNP[NODEC]:=ILFP;
|
||||
'FOR' I:=0 'STEP' 1 'UNTIL' 100 'DO'
|
||||
'BEGIN' IL[ILFP+I]:=IDN[I];
|
||||
'IF' IDN[I]=0 'THEN'
|
||||
'BEGIN' ILFP:=ILFP+I+1;
|
||||
'IF' ILFP>=MAXNID*6 'THEN' WARN(15);
|
||||
'GOTO' SID1;
|
||||
'END' END OF NAME;
|
||||
'END';
|
||||
SID1:
|
||||
ILVT[NODEC]:=TYPE; ILBD[NODEC]:=DEPTH;
|
||||
VADR[NODEC]:=ADDR;
|
||||
'END' STORE IDENT IN LIST;
|
||||
|
||||
'PROCEDURE' DARR;
|
||||
'BEGIN''INTEGER' FIRST, COUNT,STYP;
|
||||
STYP:=TYPE;
|
||||
DAR1: FIRST:=NADR; COUNT:=1;
|
||||
DAR2: IDENT; TYPE:=STYP;
|
||||
ADDR:=NADR; NADR:=NADR+1; SID;
|
||||
'IF' BS=44 'THEN''BEGIN' COUNT:=COUNT+1;
|
||||
ABS; 'GOTO' DAR2 'END';
|
||||
CHFAIL(27,18); GET INTEGER;
|
||||
CHFAIL(58,18); GET INTEGER;
|
||||
CHFAIL(29,18);
|
||||
'IF' STYP=8 'THEN' CODE(53) 'ELSE' CODE(1);
|
||||
CODE(COUNT); CODE(FIRST);
|
||||
'IF' BS#59 'THEN''BEGIN' CHFAIL(44,18); 'GOTO' DAR1 'END';
|
||||
ABS; COMMENT 'END' DECLARE ARRAY;
|
||||
|
||||
'PROCEDURE' DTV;
|
||||
'BEGIN''INTEGER' STYP; STYP:=TYPE;
|
||||
DTV1: IDENT; TYPE:=STYP; ADDR:=NADR; NADR:=NADR+1;
|
||||
SID; 'IF' BS=44 'THEN''BEGIN' ABS; 'GOTO' DTV1 'END';
|
||||
'IF' BS=59 'THEN''BEGIN' ABS; COMMENT 'END''ELSE' ABS;
|
||||
'END' DECLARE VARIABLE LIST;
|
||||
|
||||
|
||||
'PROCEDURE' GET INTEGER;
|
||||
AE;
|
||||
|
||||
'PROCEDURE' SFR;
|
||||
'BEGIN''INTEGER' I,J,K;
|
||||
'IF' FOUND 'AND' (DECL<=10 'OR' TYPE>9 'OR'
|
||||
DEPTH=ILBD[DECL]) 'THEN''GOTO' ESFR;
|
||||
'IF' LDPT#0 'THEN'
|
||||
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
||||
'BEGIN' J:=FRNP[I];
|
||||
'FOR' K:=0 'STEP' 1 'UNTIL' 100 'DO'
|
||||
'BEGIN' 'IF' IDN[K] # FRN[J+K] 'THEN''GOTO' NO;
|
||||
'IF' IDN[K]=0 'THEN'
|
||||
'BEGIN''IF' DEPTH=FLBD[I] 'OR' TYPE>9 'THEN'
|
||||
'BEGIN' ADDR:=FRLN[I];
|
||||
'IF' FLVT[I]#TYPE 'THEN' WARN(52);
|
||||
'GOTO' ESFR;
|
||||
'END' FORWARD REFERENCE EXISTS ALREADY;
|
||||
'GOTO' NO;
|
||||
'END' NAME MATCHES;
|
||||
'END' LOOK AT ONE CHARACTER;
|
||||
NO: 'END' LOOK AT ONE FORWARD REFERNECE;
|
||||
|
||||
'IF' LDPT=MAXLAB 'THEN' WARN(30) 'ELSE' LDPT:=LDPT+1;
|
||||
'IF' LDPT>MAX 'THEN' MAX:=LDPT;
|
||||
FRNP[LDPT]:=FRFP;
|
||||
'FOR' I:=0 'STEP' 1 'UNTIL' 100 'DO'
|
||||
'BEGIN' FRN[FRFP+I]:=IDN[I];
|
||||
'IF' IDN[I]=0 'THEN'
|
||||
'BEGIN' FRFP:=FRFP+I+1;
|
||||
'GOTO' SFR1;
|
||||
'IF' FRFP>=MAXLAB*6 'THEN' WARN(30);
|
||||
'END' END OF NAME;
|
||||
'END';
|
||||
SFR1:
|
||||
FLVT[LDPT]:=TYPE; FLBD[LDPT]:=DEPTH;
|
||||
ADDR:=NLAB; FRLN[LDPT]:=NLAB; NLAB:=NLAB+1; FLINE[LDPT]:=LINE;
|
||||
ESFR:
|
||||
'END' RETURN PROCEDURE LABEL IF DECLARED, ELSE SET FORWARD REF;
|
||||
|
||||
'PROCEDURE' DLAB;
|
||||
'BEGIN''INTEGER' I,J,K;
|
||||
ADDR:=NLAB; SID; LDEC(NLAB); NLAB:=NLAB+1;
|
||||
'IF' LDPT#0 'THEN'
|
||||
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
||||
'BEGIN' J:=FRNP[I];
|
||||
'FOR' K:=0 'STEP' 1 'UNTIL' 100 'DO'
|
||||
'BEGIN' 'IF' IDN[K] # FRN[J+K] 'THEN''GOTO' NO;
|
||||
'IF' IDN[K]=0 'THEN'
|
||||
'BEGIN''IF' DEPTH=FLBD[I] 'OR' TYPE>9 'THEN'
|
||||
'BEGIN' DEFINE(FRLN[I],ADDR);
|
||||
'IF' FLVT[I]#TYPE 'THEN' WARN(52);
|
||||
D2ELETE(I); I:=I-1;
|
||||
'END' DELETE SATISFIED REFERENCE;
|
||||
'GOTO' NO;
|
||||
'END' NAME MATCHES;
|
||||
'END' LOOK AT ONE CHARACTER;
|
||||
NO: 'END' LOOK AT ONE FORWARD REFERNECE;
|
||||
'END' PUT LABEL OR PROCEDURE DECLARATION IN LIST;
|
||||
|
||||
'PROCEDURE' D2ELETE(ITEM); 'VALUE' ITEM; 'INTEGER' ITEM;
|
||||
'IF' ITEM=LDPT 'THEN'
|
||||
'BEGIN' LDPT:=LDPT-1; FRFP:=FRNP[ITEM];
|
||||
'END' DELETE LAST ITEM
|
||||
'ELSE'
|
||||
'BEGIN''INTEGER' I,J,K,LEN;
|
||||
FRNP[LDPT+1]:=FRFP; FRFP:=FRNP[ITEM];
|
||||
'FOR' I:=ITEM 'STEP' 1 'UNTIL' LDPT-1 'DO'
|
||||
'BEGIN' K:=FRNP[I+1]; LEN:=FRNP[I+2] - K;
|
||||
FRNP[I]:=FRFP;
|
||||
'FOR' J:=0 'STEP' 1 'UNTIL' LEN-1 'DO'
|
||||
FRN[FRFP+J]:=FRN[K+J];
|
||||
FRFP:=FRFP + LEN;
|
||||
FLVT[I]:=FLVT[I+1]; FLBD[I]:=FLBD[I+1];
|
||||
FLINE[I]:=FLINE[I]+1; FRLN[I]:=FRLN[I+1];
|
||||
'END' MOVE 1 ITEM DOWN;
|
||||
LDPT:=LDPT-1;
|
||||
'END' DELETE INTERNAL ITEM;
|
||||
|
||||
'PROCEDURE' PCALL; 'BEGIN' 'INTEGER' STYP; STYP:=TYPE;
|
||||
'IF' FOUND 'AND' DECL<=10 'THEN'
|
||||
'BEGIN' CHFAIL(40,32);
|
||||
'IF' ADDR=1 'THEN'
|
||||
'BEGIN''IF' BS#41 'THEN'
|
||||
'BEGIN' GET INTEGER; CODE(2);
|
||||
'END' DEVICE NUMBER GIVEN;
|
||||
CODE(40); 'GOTO' ECAL
|
||||
'END' COMPILE SKIP
|
||||
'ELSE''IF' ADDR=2 'THEN'
|
||||
'BEGIN''IF' BS#44 'THEN'
|
||||
'BEGIN' GET INTEGER; CODE(49);
|
||||
'END' DEVICE GIVEN;
|
||||
CAL1: 'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
||||
CODE(3); IDENT; PUTOUT; 'GOTO' CAL1
|
||||
'END' COMPILE READ
|
||||
'ELSE''IF' ADDR=3 'THEN'
|
||||
'BEGIN''IF' BS#44 'THEN'
|
||||
'BEGIN' GET INTEGER; CODE(2);
|
||||
'END' DEVICE NUMBER GIVEN;
|
||||
CAL2: 'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
||||
'IF' BS=34 'THEN'
|
||||
'BEGIN'
|
||||
STRING:='TRUE'; INCH; CODE(5);
|
||||
CAL3: CODE(CHAR); INCH;
|
||||
'IF' CHAR#34 'THEN''GOTO' CAL3;
|
||||
ABS; CODE(0);
|
||||
SKIP(); ITEM:=0; STRING:='FALSE'; 'GOTO' CAL2
|
||||
'END'
|
||||
'ELSE''BEGIN' GET INTEGER; CODE(6);
|
||||
'GOTO' CAL2
|
||||
'END'
|
||||
'END' COMPILE WRITE
|
||||
'ELSE''IF' ADDR=4 'THEN'
|
||||
'BEGIN''IF' BS#44 'THEN'
|
||||
'BEGIN' GET INTEGER; CODE(49);
|
||||
'END' DEVICE NUMBER GIVEN;
|
||||
'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
||||
CODE(7); IDENT; PUTOUT
|
||||
'END' COMPILE CHIN
|
||||
'ELSE''IF' ADDR=5 'THEN'
|
||||
'BEGIN''IF' BS#44 'THEN'
|
||||
'BEGIN' GET INTEGER; CODE(2);
|
||||
'END' DEVICE NUMBER GIVEN;
|
||||
'IF' BS#44 'THEN''GOTO' ECAL; ABS;
|
||||
GET INTEGER; CODE(8);
|
||||
'END' COMPILE CHOUT
|
||||
'ELSE''IF' ADDR=6 'THEN''BEGIN' GET INTEGER; CODE(39)
|
||||
'END' COMPILE IOC
|
||||
'ELSE' 'IF' ADDR=7 'THEN' 'BEGIN' GETINTEGER; CODE(48)
|
||||
'END' COMPILE CLOSE
|
||||
'ELSE' 'IF' ADDR=8 'THEN'
|
||||
'BEGIN' GETINTEGER; CODE(50) 'END' COMPILE DELETE
|
||||
'ELSE' 'IF' ADDR=9 'OR' ADDR=10 'THEN'
|
||||
'BEGIN' CODE(42+ADDR); IDENT; PUTOUT 'END' COMPILE INPUT AND OUTPUT
|
||||
'END' CALL OF BUILT IN ROUTINES
|
||||
'ELSE''BEGIN' 'INTEGER' COUNT,PRAD;
|
||||
SFR; 'IF' BS#40 'THEN'
|
||||
'BEGIN' CODE(11); LABEL(ADDR); 'GOTO' ECL2
|
||||
'END' CALL OF PARAMETERLESS PROCEDURE;
|
||||
COUNT:=0; PRAD:=ADDR; ABS;
|
||||
NPAR: 'IF' 'NOT' LETTER 'THEN'
|
||||
'BEGIN' 'IF' BS=575 'OR' BS=818 'OR' BS=241 'THEN' BE
|
||||
'ELSE' AE
|
||||
'END' PARAMETER NOT STARTING WITH LETTER
|
||||
'ELSE'
|
||||
'BEGIN' IDENT; 'IF''NOT' FOUND 'THEN' WARN(29);
|
||||
FRED:='TRUE'; EXPRESSION;
|
||||
'END' PARAM STARTING WITH IDENT;
|
||||
COUNT:=COUNT+1; 'IF' BS=44 'THEN'
|
||||
'BEGIN' ABS; 'GOTO' NPAR
|
||||
'END';
|
||||
'IF' COUNT<5 'THEN'
|
||||
'BEGIN' CODE(COUNT+42); LABEL(PRAD)
|
||||
'END'
|
||||
'ELSE''BEGIN' CODE(36);
|
||||
CODE(COUNT); LABEL(PRAD);
|
||||
'END'
|
||||
'END' USER DECLARED PROCEDURE CALL;
|
||||
ECAL: CHFAIL(41,21);
|
||||
ECL2: TYPE:=STYP 'END' PROCEDURE CALL;
|
||||
|
||||
|
||||
'PROCEDURE' STATEMENT;
|
||||
'BEGIN'
|
||||
ST:
|
||||
'IF' LETTER 'THEN'
|
||||
'BEGIN' IDENT;
|
||||
'IF' BS=58 'THEN'
|
||||
'BEGIN' TYPE:=4; DLAB; ABS; 'GOTO' ST 'END'
|
||||
'ELSE''IF' BS=27 'OR' BS=33 'THEN' ASSIGNMENT
|
||||
'ELSE' 'BEGIN' TYPE:=10; PCALL 'END'
|
||||
'END' UNCONDITIONAL NON-GOTO
|
||||
|
||||
'ELSE''IF' BS=366 'THEN'
|
||||
'BEGIN''INTEGER' L1,L2;
|
||||
L1:=IFCLAUSE; STATEMENT;
|
||||
'IF' BS#212 'THEN' LDEC(L1)
|
||||
'ELSE''BEGIN' ABS; L2:=JMPNEW; LDEC(L1);
|
||||
STATEMENT; LDEC(L2) 'END'
|
||||
'END' CONDITIONAL
|
||||
|
||||
'ELSE' 'IF' BS=295 'THEN'
|
||||
'BEGIN' ABS; IDENT; TYPE:=4; SFR;
|
||||
JMP(ADDR);
|
||||
'END' GOTO STATEMENT
|
||||
|
||||
'ELSE' 'IF' BS=255 'THEN'
|
||||
'BEGIN''INTEGER' L1,L2,L3,CVA,GLOBAL;
|
||||
ABS; IDENT; 'IF''NOT' FOUND 'OR' TYPE#2 'THEN' WARN(13);
|
||||
CVA:=ADDR;
|
||||
GLOBAL:='IF' DECL<=HMPD 'AND' CPR 'THEN' 0 'ELSE' 2;
|
||||
ASSIGNMENT; CHFAIL(780,22);
|
||||
L1:=NLAB; L2:=NLAB+1; NLAB:=NLAB+2;
|
||||
JMP(L1); LDEC(L2);
|
||||
GET INTEGER; CHFAIL(854,22);
|
||||
GET INTEGER; CHFAIL(175,22);
|
||||
CODE(34); CODE(GLOBAL); CODE(CVA);
|
||||
L3:=CJMP; LDEC(L1); STATEMENT;
|
||||
JMP(L2); LDEC(L3);
|
||||
'END' FORSTATEMENT
|
||||
|
||||
'ELSE' 'IF' BS=85 'THEN'
|
||||
'BEGIN''INTEGER' I,J,SDBASE,SNADR,SILFP,JPPL;
|
||||
'BOOLEAN' PLS,BLOCK;
|
||||
ABS; COMMENT; PLS:='FALSE'; BLOCK:='FALSE';
|
||||
NDEC: 'IF' BS=374 'OR' BS=95 'THEN'
|
||||
'BEGIN' 'IF''NOT' BLOCK 'THEN'
|
||||
'BEGIN' BLOCK:='TRUE'; DEPTH:=DEPTH+1;
|
||||
SDBASE:=DBASE; DBASE:=NODEC; SNADR:=NADR;
|
||||
SILFP:=ILFP;
|
||||
'END';
|
||||
TYPE:='IF' BS=374 'THEN' 2 'ELSE' 3; ABS;
|
||||
'IF' BS=658 'THEN'
|
||||
'BEGIN' ABS; 'IF' 'NOT' PLS 'THEN'
|
||||
'BEGIN' JPPL:=JMPNEW; PLS:='TRUE'
|
||||
'END';
|
||||
DPROC; 'GOTO' NDEC
|
||||
'END' TYPE PROCEDURE
|
||||
'ELSE' 'IF' BS=122 'THEN'
|
||||
'BEGIN' ABS;
|
||||
ADEC: 'IF' PLS 'THEN'
|
||||
'BEGIN' LDEC(JPPL); PLS:='FALSE'
|
||||
'END';
|
||||
TYPE:=TYPE+4; DARR; 'GOTO' NDEC
|
||||
'END' INTEGER OR BOOLEAN ARRAY
|
||||
'ELSE'
|
||||
'BEGIN' DTV; 'GOTO' NDEC;
|
||||
'END' UNSUBSCRIPTED VARIABLE
|
||||
'END' DECLARATION STARTS INTEGER OR BOOLEAN
|
||||
'ELSE''IF' BS=658 'THEN'
|
||||
'BEGIN' 'IF''NOT' BLOCK 'THEN'
|
||||
'BEGIN' BLOCK:='TRUE'; DEPTH:=DEPTH+1;
|
||||
SDBASE:=DBASE; DBASE:=NODEC; SNADR:=NADR;
|
||||
SILFP:=ILFP;
|
||||
'END';
|
||||
TYPE:=0; ABS; 'IF' 'NOT' PLS 'THEN'
|
||||
'BEGIN' JPPL:=JMPNEW; PLS:='TRUE'
|
||||
'END';
|
||||
DPROC; 'GOTO' NDEC
|
||||
'END' PROCEDURE
|
||||
'ELSE''IF' BS=105 'THEN'
|
||||
'BEGIN' ABS;
|
||||
'IF' BS=122 'THEN' ABS;
|
||||
TYPE:=4; 'GOTO' ADEC;
|
||||
'END' BYTE ARRAY;
|
||||
|
||||
'IF' PLS 'THEN''BEGIN' PLS:='FALSE'; LDEC(JPPL) 'END';
|
||||
TAIL: STATEMENT; 'IF' BS=59 'THEN'
|
||||
'BEGIN' ABS; COMMENT; 'GOTO' TAIL 'END'
|
||||
'ELSE''IF' BS#214 'THEN' FAIL(16);
|
||||
ECOM: ABS; 'IF''NOT' TERM 'THEN''GOTO' ECOM;
|
||||
|
||||
'IF' BLOCK 'THEN'
|
||||
'BEGIN'
|
||||
DEPTH:=DEPTH-1; NODEC:=DBASE; DBASE:=SDBASE; NADR:=SNADR;
|
||||
ILFP:=SILFP; RESOLVE;
|
||||
'END' BLOCK END
|
||||
'END' BLOCK OR COMPOUND;
|
||||
'END' STATEMENT;
|
||||
|
||||
'PROCEDURE' RESOLVE;
|
||||
'BEGIN''INTEGER' I,J,K,L,M,FTYP;
|
||||
'IF' LDPT#0 'THEN'
|
||||
'FOR' I:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
||||
'IF' FLBD[I]>DEPTH 'THEN'
|
||||
'BEGIN' FLBD[I]:=DEPTH; FTYP:=FLVT[I];
|
||||
'FOR' J:=NODEC 'STEP' -1 'UNTIL' 11 'DO'
|
||||
'BEGIN' K:=ILNP[J]; L:=FRNP[I];
|
||||
'FOR' M:=0 'STEP' 1 'UNTIL' 100 'DO'
|
||||
'BEGIN''IF' FRN[L+M] # IL[K+M] 'THEN''GOTO' NO;
|
||||
'IF' FRN[L+M]=0 'THEN'
|
||||
'BEGIN'
|
||||
'IF' ILBD[J]=DEPTH 'OR' FTYP>9 'THEN'
|
||||
'BEGIN' DEFINE(FRLN[I],VADR[J]);
|
||||
'IF' FTYP#ILVT[J] 'THEN'
|
||||
WARN(53);
|
||||
D2ELETE(I); I:=I-1; 'GOTO' EXLOOP;
|
||||
'END' DECLARATION FOUND, CORRECT DEPTH;
|
||||
'END' NAME MATCHES;
|
||||
'END' CHARACTER LOOP;
|
||||
NO: 'END' DECLARED VARIABLE;
|
||||
EXLOOP:
|
||||
'END' FORWARD LABEL SATISFACTION DEPTH CHANGE;
|
||||
'END' RESOLVE LABELS AT BLOCK/PROCEDURE END;
|
||||
|
||||
'PROCEDURE' DPROC;
|
||||
'BEGIN' 'INTEGER' SNADR,SDBASE,SFIXSP,SILFP,
|
||||
PINL,SLTYP;
|
||||
CPR:='TRUE';
|
||||
SLTYP:=TYPE+10; IDENT; TYPE:=SLTYP; DLAB;
|
||||
SILFP:=ILFP; HMPD:=NODEC; SFIXSP:=FIXSP; SNADR:=NADR;
|
||||
SDBASE:=DBASE; DBASE:=NODEC; DEPTH:=DEPTH+1;
|
||||
FIXSP:=3; NADR:=4; LABEL(NLAB);
|
||||
PINL:=NLAB; NLAB:=NLAB+1;
|
||||
'IF' BS=40 'THEN'
|
||||
'BEGIN' ABS; TYPE:=0; DTV 'END';
|
||||
SEMI(28);
|
||||
LOOP: 'IF' BS=881 'THEN'
|
||||
'BEGIN'
|
||||
LOP: ABS; 'IF' BS#59 'THEN''GOTO' LOP;
|
||||
ABS; 'GOTO' LOOP
|
||||
'END' IGNORE VALUE
|
||||
'ELSE''IF' BS=374 'OR' BS=95 'THEN'
|
||||
'BEGIN' 'BOOLEAN' BOOL; BOOL:=BS=95; ABS;
|
||||
LOP: IDENT; 'IF''NOT' FOUND 'OR' TYPE#0 'THEN' WARN(29)
|
||||
'ELSE'
|
||||
ILVT[DECL]:='IF' BOOL 'THEN' 3 'ELSE' 2;
|
||||
ILBD[DECL]:=DEPTH;
|
||||
'IF' BS=44 'THEN''BEGIN' ABS; 'GOTO' LOP 'END'
|
||||
'ELSE''BEGIN' SEMI(43); 'GOTO' LOOP 'END'
|
||||
'END' TYPE SPECIFICATION;
|
||||
'FOR' DECL:=NODEC 'STEP' -1 'UNTIL' DBASE+1 'DO'
|
||||
'IF' ILVT[DECL]=0 'THEN' WARN(40);
|
||||
STATEMENT;
|
||||
CODE('IF' SLTYP>10 'THEN' 47 'ELSE' 10);
|
||||
SKIP(); ITEM:=0;
|
||||
WRITE(,"L",PINL);
|
||||
'IF' DOS=2 'THEN' WRITE(," EQU ") 'ELSE' WRITE(,"=");
|
||||
WRITE(,FIXSP); SKIP(); ITEM:=0;
|
||||
NADR:=SNADR; NODEC:=HMPD; FIXSP:=SFIXSP;
|
||||
ILFP:=SILFP; DBASE:=SDBASE; DEPTH:=DEPTH-1;
|
||||
SEMI(23); CPR:='FALSE';
|
||||
RESOLVE;
|
||||
'END' DECLARE PROCEDURE;
|
||||
|
||||
'PROCEDURE' SUBSCRIPT;
|
||||
'BEGIN''INTEGER' STYPE; STYPE:=TYPE-4;
|
||||
'IF' STYPE=4 'THEN' STYPE:=2; 'COMMENT' BYTE ARRAY;
|
||||
CHFAIL(27,3); GETINTEGER; CHFAIL(29,4);
|
||||
TYPE:=STYPE 'END';
|
||||
|
||||
'PROCEDURE' FETCH;
|
||||
'BEGIN'
|
||||
'IF' FRED 'THEN' FRED:='FALSE''ELSE' IDENT;
|
||||
'IF' 'NOT' FOUND 'THEN' TYPE:=TYPE+10;
|
||||
'IF' TYPE>10 'THEN'
|
||||
'BEGIN' PCALL; TYPE:=TYPE-10
|
||||
'END'
|
||||
'ELSE' 'IF' TYPE>4 'THEN'
|
||||
'BEGIN' 'INTEGER' SDEC,STYP;
|
||||
'IF' BS=29 'THEN'
|
||||
'BEGIN' ABS; 'GOTO' GETV;
|
||||
'END' FETCH ADDRESS OF ELEMENT 0;
|
||||
STYP:=TYPE; SDEC:=DECL;
|
||||
SUBSCRIPT;
|
||||
'IF' STYP=8 'THEN' CODE(54) 'ELSE' CODE(14);
|
||||
CODE(VADR[SDEC]);
|
||||
'END' ARRAY NAME
|
||||
'ELSE'
|
||||
GETV: GETOUT;
|
||||
'END' FETCH VARIABLE;
|
||||
|
||||
'PROCEDURE' EXPRESSION;
|
||||
'IF' BTYPE 'THEN' BE 'ELSE' AE;
|
||||
|
||||
'PROCEDURE' ASSIGNMENT;
|
||||
'BEGIN' 'IF''NOT' FOUND 'THEN' WARN(17);
|
||||
'IF' TYPE>10 'THEN'
|
||||
'BEGIN' CHFAIL(33,24); TYPE:=TYPE-10; EXPRESSION;
|
||||
CODE(147); 'COMMENT' STORE LOCAL 3;
|
||||
'END'
|
||||
'ELSE''IF' TYPE>4 'THEN'
|
||||
'BEGIN' 'INTEGER' SDEC,STYP;
|
||||
STYP:=TYPE; SDEC:=DECL;
|
||||
SUBSCRIPT; CHFAIL(33,24); EXPRESSION;
|
||||
'IF' STYP=8 'THEN' CODE(55) 'ELSE' CODE(15);
|
||||
CODE(VADR[SDEC]);
|
||||
'END'
|
||||
'ELSE''BEGIN''INTEGER' SDECL;
|
||||
SDECL:=DECL; CHFAIL(33,24); EXPRESSION;
|
||||
ADDR:=VADR[SDECL]; DECL:=SDECL; PUTOUT;
|
||||
'END'
|
||||
'END' ASSIGNMENT;
|
||||
|
||||
'PROCEDURE' IDOUT;
|
||||
'BEGIN''INTEGER' I; I:=0;
|
||||
L: CHOUT(DEVT,IDN[I]); I:=I+1;
|
||||
'IF' IDN[I]#0 'THEN''GOTO' L;
|
||||
'END' OUTPUT IDENTIFIER;
|
||||
|
||||
'PROCEDURE' WARN(X); 'VALUE' X; 'INTEGER' X;
|
||||
'BEGIN' SKIP(DEVT); DELETE(DEV); DEV:=0;
|
||||
WRITE(DEVT,"FAIL ",X," LINE ",LINE,
|
||||
" CHAR ",CHAR," BS ",BS," IDENT ");
|
||||
IDOUT; WRITE(DEVT," TYPE ",TYPE);
|
||||
CHOUT(0);
|
||||
'END' FAILURE WARNING;
|
||||
|
||||
'PROCEDURE' FAIL(X); 'VALUE' X; 'INTEGER' X;
|
||||
'BEGIN' WARN(X); 'IF' TERM 'THEN' ABS;
|
||||
NEXT: ABS; 'IF''NOT' TERM 'THEN''BEGIN' ABS; 'GOTO' NEXT 'END';
|
||||
'END' FAILURE OUTPUT;
|
||||
|
||||
'PROCEDURE' CHFAIL(SYM,FNO); 'VALUE' SYM,FNO; 'INTEGER' SYM,FNO;
|
||||
'BEGIN''IF' BS#SYM 'THEN' WARN(FNO); ABS 'END';
|
||||
|
||||
'PROCEDURE' APRIME;
|
||||
'BEGIN''BOOLEAN' NEG;
|
||||
'IF' FRED 'THEN''BEGIN' FETCH; 'GOTO' EAPR
|
||||
'END';
|
||||
'IF' BS=43 'THEN''BEGIN' ABS; NEG:='FALSE' 'END'
|
||||
'ELSE''IF' BS=45 'THEN''BEGIN' ABS; NEG:='TRUE' 'END'
|
||||
'ELSE' NEG:='FALSE';
|
||||
|
||||
'IF' BS=40 'THEN'
|
||||
'BEGIN' ABS; AE; CHFAIL(41,12)
|
||||
'END'
|
||||
'ELSE''IF' LETTER 'THEN'
|
||||
'BEGIN' TYPE:=2;
|
||||
FETCH; 'IF' TYPE#2 'THEN' WARN(17);
|
||||
'END'
|
||||
'ELSE''IF' BS=38 'THEN'
|
||||
'BEGIN' CHIN(,CHAR); SIXBIT(CHAR); ABS;
|
||||
TYPE:=2;
|
||||
'END' CHARACTER LITERAL
|
||||
'ELSE' 'BEGIN''INTEGER' I,J,K,L; I:=0;
|
||||
'IF''NOT' DIGIT 'THEN' FAIL(10);
|
||||
APR1: I:=I+1; DIG[I]:=BS;
|
||||
ABS; 'IF' DIGIT 'THEN''GOTO' APR1;
|
||||
K:=0; L:=0;
|
||||
'FOR' J:=1 'STEP' 1 'UNTIL' I 'DO'
|
||||
'BEGIN' K:=10*K+DIG[J]-48; L:=L*10;
|
||||
'IF' K>=256 'THEN'
|
||||
'BEGIN' L:=L+K%256;
|
||||
K:=K-256*(K%256)
|
||||
'END';
|
||||
'IF' L>255 'THEN' WARN(44);
|
||||
'END';
|
||||
'IF' K=0 'AND' L=0 'THEN' CODE(29)
|
||||
'ELSE' 'IF' L=0 'THEN'
|
||||
'BEGIN' SIXBIT(K) 'END'
|
||||
'ELSE'
|
||||
'BEGIN' CODE(16); CODE(K); CODE(L) 'END'
|
||||
'END';
|
||||
'IF' NEG 'THEN' CODE(17);
|
||||
EAPR: 'END' ARITHMETIC PRIMARY;
|
||||
|
||||
'PROCEDURE' AFAC;
|
||||
'BEGIN' APRIME;
|
||||
AFA1: 'IF' BS=30 'THEN'
|
||||
'BEGIN' ABS; APRIME; CODE(18);
|
||||
'GOTO' AFA1
|
||||
'END';
|
||||
'END' ARITHMETIC FACTOR;
|
||||
|
||||
|
||||
|
||||
'PROCEDURE' ATERM;
|
||||
'BEGIN'
|
||||
AFAC;
|
||||
ATE1: 'IF' BS=42 'THEN'
|
||||
'BEGIN' ABS; AFAC; CODE(19);
|
||||
'GOTO' ATE1
|
||||
'END' MULTIPLY CASE
|
||||
'ELSE''IF' BS=47 'THEN' WARN(19)
|
||||
'ELSE''IF' BS=37 'THEN'
|
||||
'BEGIN' ABS; AFAC;
|
||||
CODE(20); 'GOTO' ATE1
|
||||
'END' INTEGER DIVISION CASE;
|
||||
'END' ARITHMETIC TERM;
|
||||
|
||||
'PROCEDURE' SAE;
|
||||
'BEGIN' ATERM;
|
||||
SAE1: 'IF' BS=43 'THEN'
|
||||
'BEGIN' ABS; ATERM;
|
||||
CODE(13); 'GOTO' SAE1
|
||||
'END' ADDITION CASE
|
||||
'ELSE''IF' BS=45 'THEN'
|
||||
'BEGIN' ABS; ATERM;
|
||||
CODE(21); 'GOTO' SAE1
|
||||
'END' SUBTRACTION CASE;
|
||||
'END' SIMPLE ARITHMETIC EXPRESSION;
|
||||
|
||||
'PROCEDURE' AE;
|
||||
'IF' BS=366 'THEN'
|
||||
'BEGIN' 'INTEGER' L1,L2;
|
||||
L1:=IFCLAUSE; SAE; CHFAIL(212,7);
|
||||
L2:=JMPNEW; LDEC(L1); AE;
|
||||
LDEC(L2);
|
||||
'END'
|
||||
'ELSE' SAE;
|
||||
|
||||
|
||||
|
||||
'PROCEDURE' SETO(I); 'VALUE' I;
|
||||
'INTEGER' I; IOC(12);
|
||||
|
||||
'INTEGER' 'PROCEDURE' SWLIST; IOC(16);
|
||||
|
||||
|
||||
'PROCEDURE' RE;
|
||||
'BEGIN''INTEGER' SBS;
|
||||
AE; SBS:=BS; ABS; AE;
|
||||
'IF' SBS=61 'THEN' CODE(22)
|
||||
'ELSE''IF' SBS=35 'THEN' CODE(23)
|
||||
'ELSE''IF' SBS=60 'THEN' CODE(24)
|
||||
'ELSE''IF' SBS=62 'THEN' CODE(25)
|
||||
'ELSE''IF' SBS=63 'THEN' CODE(26)
|
||||
'ELSE''IF' SBS=38 'THEN' CODE(27)
|
||||
'ELSE' FAIL(9);
|
||||
'END' RELATIONAL BOOLEAN;
|
||||
|
||||
'PROCEDURE' PUTOUT;
|
||||
'IF' DECL<=HMPD 'THEN'
|
||||
'BEGIN' 'IF' ADDR>31 'THEN'
|
||||
'BEGIN' CODE(37); CODE(ADDR);
|
||||
'END' STORE GLOBAL>31
|
||||
'ELSE' CODE(160+ADDR)
|
||||
'END' GLOBAL VARIABLE
|
||||
'ELSE'
|
||||
'BEGIN' 'IF' ADDR>15 'THEN'
|
||||
'BEGIN' CODE(4); CODE(ADDR);
|
||||
'END' STORE LOCAL>15
|
||||
'ELSE' CODE(144+ADDR)
|
||||
'END' LOCAL VARIABLE;
|
||||
|
||||
'PROCEDURE' GETOUT;
|
||||
'IF' DECL<=HMPD 'THEN'
|
||||
'BEGIN' 'IF' ADDR>63 'THEN'
|
||||
'BEGIN' CODE(38); CODE(ADDR);
|
||||
'END' FETCH GLOBAL >63
|
||||
'ELSE' CODE(192+ADDR);
|
||||
'END' FETCH GLOBAL
|
||||
'ELSE'
|
||||
'BEGIN' 'IF' ADDR>15 'THEN'
|
||||
'BEGIN' CODE(12); CODE(ADDR);
|
||||
'END' FETCH LOCAL>15
|
||||
'ELSE' CODE(128+ADDR);
|
||||
'END' FETCH LOCAL;
|
||||
|
||||
'INTEGER''PROCEDURE' IFCLAUSE;
|
||||
'BEGIN' ABS; BE; CHFAIL(808,25);
|
||||
IFCLAUSE:=CJMP 'END' IFCLAUSE;
|
||||
|
||||
'PROCEDURE' BPRIM;
|
||||
'BEGIN' 'BOOLEAN' NOT;
|
||||
'IF' FRED 'THEN''BEGIN' FETCH; 'GOTO' EBPRIM 'END';
|
||||
'IF' BS=575 'THEN''BEGIN' NOT:='TRUE'; ABS 'END''ELSE' NOT:='FALSE';
|
||||
'IF' BS=818 'THEN'
|
||||
'BEGIN' ABS; CODE(29); CODE(30) 'END'
|
||||
'ELSE''IF' BS=241 'THEN'
|
||||
'BEGIN' ABS; CODE(29) 'END'
|
||||
'ELSE''IF' LETTER 'THEN'
|
||||
'BEGIN' TYPE:=3; IDENT; FRED:='TRUE';
|
||||
'IF' BTYPE 'THEN' FETCH 'ELSE' RE; TYPE:=3;
|
||||
'END'
|
||||
'ELSE''IF' BS=40 'THEN'
|
||||
'BEGIN' ABS; BE; CHFAIL(41,14) 'END'
|
||||
'ELSE' RE;
|
||||
'IF' NOT 'THEN' CODE(30);
|
||||
EBPRIM:
|
||||
'END' BPRIME;
|
||||
|
||||
'PROCEDURE' BTERM;
|
||||
'BEGIN' BPRIM;
|
||||
BTM1: 'IF' BS=118 'THEN'
|
||||
'BEGIN' ABS; BPRIM; CODE(31); 'GOTO' BTM1 'END';
|
||||
'END' BOOL TERM;
|
||||
|
||||
'PROCEDURE' SBE;
|
||||
'BEGIN' BTERM;
|
||||
SBE1: 'IF' BS=618 'THEN'
|
||||
'BEGIN' ABS; BTERM; CODE(32); 'GOTO' SBE1 'END';
|
||||
'END' SIMPLE BOOLEAN EXPRESSION;
|
||||
|
||||
'PROCEDURE' BE;
|
||||
'BEGIN''IF' BS#366 'THEN' SBE 'ELSE'
|
||||
'BEGIN''INTEGER' L1,L2;
|
||||
L1:=IFCLAUSE; SBE; CHFAIL(212,8);
|
||||
L2:=JMPNEW; LDEC(L1);
|
||||
BE; LDEC(L2) 'END';
|
||||
'END' BOOLEAN EXPRESSION;
|
||||
|
||||
'PROCEDURE' STID(LEN); 'VALUE' LEN; 'INTEGER' LEN;
|
||||
'BEGIN' DECL:=DECL+1; ILNP[DECL]:=ILFP;
|
||||
IL[ILFP+LEN]:=0; ILFP:=ILFP+LEN+1; SETO(IL] + ILFP);
|
||||
ILVT[DECL]:=10; ILBD[DECL]:=0;
|
||||
VADR[DECL]:=DECL;
|
||||
'END' PUT STANDARD IDENTIFIER IN THE LIST;
|
||||
|
||||
ITEM:=0; MAX:=0;
|
||||
STRT: SKIP(1);
|
||||
WRITE(1,"RHA (Minisystems) Ltd subset Algol compiler"); SKIP(1);
|
||||
|
||||
WRITE(1,"CP/M-80, CP/M-86 or MS-DOS [1, 2 or 3] : ");
|
||||
READ(1,DOS);
|
||||
'IF' DOS<0 'OR' DOS>3 'THEN''GOTO' STRT;
|
||||
'IF' DOS>1 'THEN'
|
||||
'BEGIN' WRITE(1,"Origin in decimal : "); READ(1,FIRST);
|
||||
SKIP(1);
|
||||
'END';
|
||||
|
||||
HOL1:='FALSE'; CPR:='FALSE'; STRING:='FALSE';
|
||||
HMPD:=0; LDPT:=0; FIXSP:=0; DEPTH:=0; DOLL:='FALSE'; LINE:=1;
|
||||
NLAB:=1; NODEC:=10; NADR:=1; FRED:='FALSE'; SECOND:='FALSE';
|
||||
ILFP:=0; FRFP:=0; SIZE:=4;
|
||||
IOC(8); IOC(3); SETO(SWLIST+13);
|
||||
WRITE(10,"IAG"); INPUT(INDEV);
|
||||
'IF' INDEV>0 'THEN' 'GOTO' IOK;
|
||||
IOC(5); INPUT(INDEV);
|
||||
'IF' INDEV<0 'THEN' 'GOTO' IOCH; IOC(3); IOC(6); 'GOTO' IOK;
|
||||
IOCH: IOC(2); SETO(SWLIST+13); WRITE(10,"IAG");
|
||||
INPUT(INDEV); 'IF' INDEV<0 'THEN' 'GOTO' IOCH;
|
||||
IOK: SETO(SWLIST+13);
|
||||
'IF' DOS=1 'THEN' WRITE(10,"ZSM")
|
||||
'ELSE''IF' DOS=2 'THEN' WRITE(10,"A86")
|
||||
'ELSE' WRITE(10,"ASM");
|
||||
OUTPUT(DEV);
|
||||
SETO(SWLIST+13); WRITE(10,"MON"); OUTPUT(DEVT);
|
||||
SETO(SWLIST+13); WRITE(10,"IAG"); IOC(7);
|
||||
TABLES:=DEVT>0;
|
||||
'IF' DEVT<1 'THEN' DEVT:=1;
|
||||
'IF' TABLES 'THEN''BEGIN' SKIP(DEVT);
|
||||
WRITE(DEVT,"IDENTIFIER TABLE SIZE = ",MAXNID); SKIP(DEVT);
|
||||
'END';
|
||||
|
||||
SKIP(DEV);
|
||||
'IF' DOS=1 'THEN'
|
||||
'BEGIN' WRITE(DEV,"BASE QUERY 'ORIGIN'");
|
||||
SKIP(DEV); WRITE(DEV,"ORG BASE"); SKIP(DEV);
|
||||
WRITE(DEV,"#L0");
|
||||
'END'
|
||||
'ELSE' 'BEGIN'
|
||||
'IF' DOS=3 'THEN'
|
||||
WRITE(DEV,"DATA SEGMENT COMMON 'ALGOL'")
|
||||
'ELSE' WRITE(DEV,"DSEG");
|
||||
SKIP(DEV); WRITE(DEV,"ORG ",FIRST,"D");
|
||||
SKIP(DEV); WRITE(DEV," DW OFFSET L0");
|
||||
'END';
|
||||
SKIP(DEV);
|
||||
|
||||
DECL:=0; SETO(IL]);
|
||||
WRITE(10,"SKIP"); STID(4);
|
||||
WRITE(10,"READ"); STID(4);
|
||||
WRITE(10,"WRITE"); STID(5);
|
||||
WRITE(10,"CHIN"); STID(4);
|
||||
WRITE(10,"CHOUT"); STID(5);
|
||||
WRITE(10,"IOC"); STID(3);
|
||||
WRITE(10,"CLOSE"); STID(5);
|
||||
WRITE(10,"DELETE"); STID(6);
|
||||
WRITE(10,"INPUT"); STID(5);
|
||||
WRITE(10,"OUTPUT"); STID(6);
|
||||
|
||||
CHOUT(DEV); CHIN(INDEV); ABS; STATEMENT;
|
||||
'IF' BS#36 'THEN' WARN(6); CODE(18);
|
||||
'IF' LDPT#0 'THEN'
|
||||
'FOR' DECL:=1 'STEP' 1 'UNTIL' LDPT 'DO'
|
||||
'BEGIN'
|
||||
'FOR' FIRST:=0 'STEP' 1 'UNTIL' 100 'DO'
|
||||
IDN[FIRST]:=FRN[FRNP[DECL]+FIRST];
|
||||
LINE:=FLINE[DECL]; WARN(2)
|
||||
'END';
|
||||
FIXSP:=FIXSP+FIXSP+2;
|
||||
|
||||
SKIP(DEV);
|
||||
'IF' DOS=3 'THEN'
|
||||
'BEGIN' WRITE(DEV,"L0="); CHOUT(,36); 'END'
|
||||
'ELSE' WRITE(DEV,"L0:");
|
||||
SKIP();
|
||||
'IF' DOS=1 'THEN' WRITE(,"#") 'ELSE' WRITE(," DW ");
|
||||
WRITE(,FIXSP);
|
||||
'IF' DOS=3 'THEN'
|
||||
'BEGIN' SKIP(DEV); WRITE(DEV,"DATA ENDS"); 'END';
|
||||
SKIP(DEV); WRITE(DEV,"END");
|
||||
SKIP(DEV);
|
||||
|
||||
EPROG: CLOSE(DEV); CLOSE(INDEV); CLOSE(DEVT); SKIP(1);
|
||||
WRITE(1,"SIZE ",SIZE);
|
||||
WRITE(1," MAX ",MAX);
|
||||
'END' IDENT TABLE BLOCK
|
||||
'END' OF INTEGER SUBSET COMPILER
|
||||
$$$$$$$$
|
||||
|
||||
|
||||
13
RHA (Minisystems) ALGOL v55/KEY.ALG
Normal file
13
RHA (Minisystems) ALGOL v55/KEY.ALG
Normal file
@ -0,0 +1,13 @@
|
||||
BEGIN INTEGER c, dev;
|
||||
|
||||
start:
|
||||
text(1,"Input device ? "); dev:=read(1);
|
||||
IF dev < 0 OR dev > 10 THEN GOTO start;
|
||||
|
||||
REPEAT
|
||||
REPEAT c:=chin(dev) UNTIL c#0;
|
||||
skip(1); rwrite(1,c,4,0);
|
||||
IF c>32 THEN chout(1,c)
|
||||
UNTIL c=3;
|
||||
END FINISH
|
||||
|
||||
65
RHA (Minisystems) ALGOL v55/LCASE.ALG
Normal file
65
RHA (Minisystems) ALGOL v55/LCASE.ALG
Normal file
@ -0,0 +1,65 @@
|
||||
'BEGIN' 'INTEGER' IN,OUT,C;
|
||||
|
||||
|
||||
'COMMENT' THIS PROGRAM CONVERTS FROM
|
||||
THE UPPER CASE IN QUOTES MODE TO THE
|
||||
UPPER/LOWER CASE CONVENTION;
|
||||
|
||||
'PROCEDURE' SETO(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(31);
|
||||
|
||||
'INTEGER' 'PROCEDURE' SWLIST;
|
||||
IOC(39);
|
||||
|
||||
'PROCEDURE' GETC;
|
||||
'BEGIN' C:=CHIN(IN);
|
||||
'IF' C<0 'OR' C=&^Z 'THEN' 'GOTO' FIN
|
||||
'END' ;
|
||||
|
||||
|
||||
|
||||
SETO(SWLIST+13);
|
||||
TEXT(10,"ALG"); {DEFAULT EXTENSION}
|
||||
A1: IOC(2); IN:=INPUT;
|
||||
'IF' IN<1 'THEN' 'GOTO' A1;
|
||||
OUT:=OUTPUT;
|
||||
'IF' OUT<1 'THEN'
|
||||
'BEGIN' CLOSE(IN); 'GOTO' A1;
|
||||
'END' ;
|
||||
LOOP: GETC;
|
||||
A2: 'IF' C=&' 'THEN'
|
||||
'BEGIN'
|
||||
A3: GETC;
|
||||
'IF' C=&' 'THEN'
|
||||
'BEGIN' GETC;
|
||||
'IF' C>&*S 'AND' C#&; 'THEN'
|
||||
CHOUT(OUT,&*S); 'GOTO' A2;
|
||||
'END' 'ELSE'
|
||||
'IF' C<&A 'OR' C>&Z 'THEN' 'GOTO' A2
|
||||
'ELSE' CHOUT(OUT,C);
|
||||
'GOTO' A3
|
||||
'END' 'ELSE'
|
||||
'IF' C>=&A 'AND' C<=&Z 'THEN' C:=C+32;
|
||||
CHOUT(OUT,C);
|
||||
'IF' C=&& 'THEN'
|
||||
'BEGIN' GETC; CHOUT(OUT,C);
|
||||
'IF' C=&** 'OR' C=&*^ 'THEN'
|
||||
'BEGIN' GETC; CHOUT(OUT,C);
|
||||
'END'
|
||||
'END' 'ELSE'
|
||||
'IF' C=&" 'THEN'
|
||||
'BEGIN'
|
||||
A4: GETC; CHOUT(OUT,C);
|
||||
'IF' C=&** 'THEN'
|
||||
'BEGIN' GETC; CHOUT(OUT,C);
|
||||
'END' 'ELSE'
|
||||
'IF' C=&" 'THEN' 'GOTO' LOOP;
|
||||
'GOTO' A4;
|
||||
'END' ;
|
||||
'GOTO' LOOP;
|
||||
FIN: CHOUT(OUT,&^Z); CLOSE(OUT);
|
||||
CLOSE(IN); 'GOTO' A1;
|
||||
'END'
|
||||
'FINISH'
|
||||
|
||||
|
||||
111
RHA (Minisystems) ALGOL v55/MMIND.ALG
Normal file
111
RHA (Minisystems) ALGOL v55/MMIND.ALG
Normal file
@ -0,0 +1,111 @@
|
||||
|
||||
'BEGIN''INTEGER' COLOR1,COLOR2,COLOR3,COLOR4,
|
||||
ROW,COL,OLDROW,OLDCOL,MAXCOL;
|
||||
'INTEGER''ARRAY' HYP[1:4],BOARD[1:10,1:4],WHITES,BLACKS[1:10];
|
||||
'BOOLEAN''ARRAY' OLDMAT,NEWMAT[1:4];
|
||||
|
||||
'PROCEDURE' PATERN(ROW); 'VALUE' ROW; 'INETEGR' ROW;
|
||||
'BEGIN''INTEGER' COL;
|
||||
'FOR' COL:=1,2,3,4 'DO'
|
||||
'IF' BOARD[ROW,COL]=1 'THEN' TEXT(1,"RED ")
|
||||
'ELSE''IF' BOARD[ROW,COL]=2 'THEN' TEXT(1,"BLUE ")
|
||||
'ELSE''IF' BOARD[ROW,COL]=3 'THEN' TEXT(1,"GREEN ")
|
||||
'ELSE''IF' BOARD[ROW,COL]=4 'THEN' TEXT(1,"YELLOW ")
|
||||
'ELSE''IF' BOARD[ROW,COL]=5 'THEN' TEXT(1,"BLACK ")
|
||||
'ELSE''IF' BOARD[ROW,COL]=6 'THEN' TEXT(1,"WHITE ")
|
||||
'ELSE' TEXT(1,"SPACE ");
|
||||
'END' PRINT PATTERN;
|
||||
|
||||
'PROCEDURE' PRINTROW;
|
||||
'BEGIN' TEXT(1,"*NMy guess "); WRITE(1,ROW);
|
||||
TEXT(1," is: ");
|
||||
PATERN(ROW);
|
||||
'END' PRINT THE CURRENT ROW;
|
||||
|
||||
|
||||
|
||||
START: TEXT(1,"*N*NMastermind Codebreaker*NVersion 1 or 2 ?");
|
||||
MAXCOL:=READ(7);
|
||||
'IF''NOT' (MAXCOL=1 'OR' MAXCOL=2)'THEN''GOTO' START;
|
||||
MAXCOL:=MAXCOL+5;
|
||||
ROW:=1;
|
||||
|
||||
'FOR' COLOR1:=1 'STEP' 1 'UNTIL' MAXCOL 'DO'
|
||||
'FOR' COLOR2:=2 'STEP' 1 'UNTIL' MAXCOL,1 'DO'
|
||||
'FOR' COLOR3:=3 'STEP' 1 'UNTIL' MAXCOL,1,2 'DO'
|
||||
'FOR' COLOR4:=4 'STEP' 1 'UNTIL' MAXCOL,1,2,3 'DO'
|
||||
'BEGIN'
|
||||
'INTEGER' BLACK,WHITE;
|
||||
HYP[1]:=COLOR1; HYP[2]:=COLOR2;
|
||||
HYP[3]:=COLOR3; HYP[4]:=COLOR4;
|
||||
'COMMENT' SET UP THE HYPOTHESIS ROW.
|
||||
A ROW IS CONSISTENT WITH ALL PREVIOUS ROWS IF IT
|
||||
GIVES RISE TO THE SAME NUMBER OF BLACK AND WHITE INFORMATION
|
||||
PEGS AS THOSE ROWS;
|
||||
'FOR' OLDROW:=1 'STEP' 1 'UNTIL' ROW-1 'DO'
|
||||
'BEGIN'
|
||||
BLACK:=0;
|
||||
'FOR' COL:=1,2,3,4 'DO'
|
||||
'BEGIN''BOOLEAN' TEMP;
|
||||
TEMP:=OLDMAT[COL]:=NEWMAT[COL]:= HYP[COL]=BOARD[OLDROW,COL];
|
||||
'IF' TEMP 'THEN' BLACK:=BLACK+1;
|
||||
'END';
|
||||
'IF' BLACK#BLACKS[OLDROW] 'THEN''GOTO' NOT VIABLE;
|
||||
WHITE:=0;
|
||||
'FOR' COL:=1,2,3 'DO'
|
||||
'FOR' OLDCOL:=COL+1 'STEP' 1 'UNTIL' 4 'DO'
|
||||
'BEGIN'
|
||||
'IF' HYP[COL]=BOARD[OLDROW,OLDCOL] 'THEN'
|
||||
'BEGIN''IF''NOT' (NEWMAT[COL] 'OR' OLDMAT[OLDCOL]) 'THEN'
|
||||
'BEGIN' NEWMAT[COL]:=OLDMAT[OLDCOL]:='TRUE';
|
||||
WHITE:=WHITE+1;
|
||||
'END';
|
||||
'END';
|
||||
'IF' HYP[OLDCOL]=BOARD[OLDROW,COL] 'THEN'
|
||||
'BEGIN''IF''NOT' (NEWMAT[OLDCOL] 'OR' OLDMAT[COL]) 'THEN'
|
||||
'BEGIN' NEWMAT[OLDCOL]:=OLDMAT[COL]:='TRUE';
|
||||
WHITE:=WHITE+1;
|
||||
'END';
|
||||
'END';
|
||||
'END';
|
||||
'IF' WHITE#WHITES[OLDROW] 'THEN''GOTO' NOT VIABLE;
|
||||
'END' LOOK AT EACH PREVIOUS ROW;
|
||||
'COMMENT' AT THIS POINT THE HYPOTHESIS ROW IS VIABLE;
|
||||
'FOR' COL:=1 'STEP' 1 'UNTIL' 4 'DO' BOARD[ROW,COL]:=HYP[COL];
|
||||
PRINTROW;
|
||||
JUNK: TEXT(1,"*NHow many black pegs ? ");
|
||||
BLACKS[ROW]:=READ(7);
|
||||
'IF' BLACKS[ROW]=4 'THEN'
|
||||
'BEGIN' TEXT(1,"Thanks for the game");
|
||||
'GOTO' START;
|
||||
'END' PROBLEM SOLVED
|
||||
'ELSE''IF' BLACKS[ROW]=3 'THEN' WHITES[ROW]:=0
|
||||
'ELSE'
|
||||
'BEGIN'
|
||||
'IF' BLACKS[ROW]<0 'OR' BLACKS[ROW]>4 'THEN'
|
||||
'BEGIN' TEXT(1,"TWIT !!"); 'GOTO' JUNK;
|
||||
'END';
|
||||
TEXT(1,"How many white pegs ? ");
|
||||
WHITES[ROW]:=READ(7);
|
||||
'IF' WHITES[ROW]<0 'OR'
|
||||
WHITES[ROW]+BLACKS[ROW]>4 'THEN'
|
||||
'BEGIN' TEXT(1,"TWIT !!"); 'GOTO' JUNK;
|
||||
'END';
|
||||
'END';
|
||||
ROW:=ROW+1;
|
||||
'IF' ROW=10 'THEN'
|
||||
'BEGIN'
|
||||
TEXT(1,"*NWELL DONE, YOU WIN !!");
|
||||
'GOTO' START;
|
||||
'END';
|
||||
|
||||
NOT VIABLE:
|
||||
'END' LOOK AT EACH POSSIBLE ROW;
|
||||
|
||||
TEXT(1,"*NTwit !!! you made a mistake");
|
||||
'GOTO' START;
|
||||
'END' OF MASTERMIND CODEBREAKER
|
||||
'FINISH'
|
||||
|
||||
|
||||
|
||||
BIN
RHA (Minisystems) ALGOL v55/MMIND.ASC
Normal file
BIN
RHA (Minisystems) ALGOL v55/MMIND.ASC
Normal file
Binary file not shown.
32
RHA (Minisystems) ALGOL v55/QSORT.ALG
Normal file
32
RHA (Minisystems) ALGOL v55/QSORT.ALG
Normal file
@ -0,0 +1,32 @@
|
||||
'BEGIN''ARRAY' A[1:100];
|
||||
'INTEGER' I,N,INDEV;
|
||||
|
||||
'PROCEDURE' QSORT(ARR,LOW,HIGH); 'VALUE' LOW,HIGH;
|
||||
'ARRAY' ARR; 'INTEGER'LOW,HIGH;
|
||||
'IF' LOW<HIGH 'THEN'
|
||||
'BEGIN''INTEGER' TOP,BOTTOM; 'REAL' X;
|
||||
BOTTOM:=LOW-1; TOP:=HIGH;
|
||||
LOOP1: BOTTOM:=BOTTOM+1;
|
||||
'IF' ARR[BOTTOM]<ARR[HIGH] 'THEN''GOTO' LOOP1;
|
||||
LOOP2: TOP:=TOP-1;
|
||||
'IF' ARR[TOP]>=ARR[HIGH] 'AND' TOP>BOTTOM
|
||||
'THEN''GOTO' LOOP2;
|
||||
'IF' TOP>BOTTOM 'THEN'
|
||||
'BEGIN' X:=ARR[TOP]; ARR[TOP]:=ARR[BOTTOM];
|
||||
ARR[BOTTOM]:=X; 'GOTO' LOOP1;
|
||||
'END';
|
||||
X:=ARR[HIGH]; ARR[HIGH]:=ARR[BOTTOM]; ARR[BOTTOM]:=X;
|
||||
QSORT(ARR,LOW,BOTTOM-1); QSORT(ARR,BOTTOM+1,HIGH);
|
||||
'END' QSORT;
|
||||
|
||||
START: IOC(4); INDEV:=INPUT; 'IF' INDEV<0 'THEN''GOTO' START;
|
||||
N:=READ(INDEV); 'FOR' I:=1 'STEP' 1 'UNTIL' N 'DO'
|
||||
A[I]:=READ(INDEV);
|
||||
QSORT(A,1,N);
|
||||
'FOR' I:=1 'STEP' 1 'UNTIL' N 'DO'
|
||||
'BEGIN' RWRITE(1,A[I],8,0);
|
||||
'IF' I=I%5*5 'THEN' SKIP(1);
|
||||
'END';
|
||||
CLOSE(INDEV); 'GOTO' START;
|
||||
'END''FINISH'
|
||||
|
||||
6
RHA (Minisystems) ALGOL v55/QSORT.DAT
Normal file
6
RHA (Minisystems) ALGOL v55/QSORT.DAT
Normal file
@ -0,0 +1,6 @@
|
||||
50
|
||||
12,-3,4,9,33,-3,7,2,0,10,3,45,87,45,23,
|
||||
43,-55,26,8,-56,33,66,11,-9,0,28,-65,56,62,-1,
|
||||
64,-82,387,43,-2,45,81,-93,-9,10,
|
||||
-11,-12,13,6,99,88,-99,18,19,20
|
||||
|
||||
415
RHA (Minisystems) ALGOL v55/SCALE.ALG
Normal file
415
RHA (Minisystems) ALGOL v55/SCALE.ALG
Normal file
@ -0,0 +1,415 @@
|
||||
BEGIN ARRAY scale, freq, just[0:25], fifths[1:12];
|
||||
INTEGER ARRAY major, minor[1:6], title[1:100];
|
||||
INTEGER note, base, interval, char;
|
||||
REAL ARRAY minorerror, majorerror[0:12];
|
||||
REAL ARRAY lminorerror, lmajorerror[0:12];
|
||||
REAL ARRAY tminorerror, tmajorerror[0:12];
|
||||
REAL scalecents, justcents, cfreq;
|
||||
REAL minorsum, majorsum, minorbigsum, majorbigsum;
|
||||
REAL lminorsum, lmajorsum, lminorbigsum, lmajorbigsum;
|
||||
REAL purefifth, pythag, syntonic, logmult;
|
||||
INTEGER xcount, starcount, goodcount;
|
||||
INTEGER outdev;
|
||||
|
||||
PROCEDURE format(n); VALUE n; INTEGER n; ioc(49);
|
||||
|
||||
PRODECURE circle heading;
|
||||
BEGIN text(1,
|
||||
" C-G G-D D-A A-E E-B B-F# F#-C# C#-G# G#-D# D#-A# A#-F F-C");
|
||||
skip(1);
|
||||
END circle heading;
|
||||
|
||||
PROCEDURE circle echo;
|
||||
BEGIN INTEGER f, c;
|
||||
text(outdev,
|
||||
" C-G G-D D-A A-E E-B B-F# F#-C# C#-G# G#-D# D#-A# A#-F F-C*N ");
|
||||
ioc(0); note := 0;
|
||||
FOR f := 1 STEP 1 UNTIL 12 DO
|
||||
BEGIN WHILE note <= &*S AND note # 13 DO note := chin(7);
|
||||
FOR c := 1 STEP 1 UNTIL 7 DO
|
||||
BEGIN IF note > &*S THEN
|
||||
BEGIN chout(outdev, note); note := chin(7);
|
||||
END
|
||||
ELSE chout( outdev, &*S );
|
||||
END;
|
||||
END;
|
||||
skip(outdev);
|
||||
note := 0;
|
||||
FOR f := 1 STEP 1 UNTIL 12 DO
|
||||
BEGIN scalecents := abs( 3.0*freq[note] - 2.0*freq[note+7] );
|
||||
rwrite( outdev, scalecents*60, 6, 0);
|
||||
note := note + 7; IF note > 11 THEN note := note - 12;
|
||||
END;
|
||||
skip(outdev);
|
||||
note := 0;
|
||||
FOR f := 1 STEP 1 UNTIL 12 DO
|
||||
BEGIN scalecents := abs( 3.0*freq[note] - 2.0*freq[note+7] );
|
||||
rwrite( outdev, scalecents, 6, 2);
|
||||
note := note + 7; IF note > 11 THEN note := note - 12;
|
||||
END;
|
||||
skip(outdev);
|
||||
END circle echo;
|
||||
|
||||
PROCEDURE write note( note );
|
||||
INTEGER note;
|
||||
BEGIN IF note > 11 THEN note := note - 12;
|
||||
CASE note OF
|
||||
0: text(outdev, "C " );
|
||||
1: text(outdev, "C#" );
|
||||
2: text(outdev, "D " );
|
||||
3: text(outdev, "D#" );
|
||||
4: text(outdev, "E " );
|
||||
5: text(outdev, "F " );
|
||||
6: text(outdev, "F#" );
|
||||
7: text(outdev, "G " );
|
||||
8: text(outdev, "G#" );
|
||||
9: text(outdev, "A " );
|
||||
10: text(outdev, "A#" );
|
||||
11: text(outdev, "B " )
|
||||
ELSE text(outdev, "??" );
|
||||
END write note;
|
||||
|
||||
PROCEDURE set just scale;
|
||||
BEGIN logmult := 1200.00/ln(2);
|
||||
just[0] := 0; just[12] := 1200.00; just[24] := 2400.00;
|
||||
just[1] := 111.73; just[2] := logmult*ln(1.125);
|
||||
just[3] := logmult*ln(1.2); just[4] := logmult*ln(1.25);
|
||||
just[5] := logmult*ln(4.0/3.0); just[6] := 590.22;
|
||||
just[7] := logmult*ln(1.5); just[8] := logmult*ln(1.6);
|
||||
just[9] := logmult*ln(5.0/3.0); just[10] := logmult*ln(16.0/9.0);
|
||||
just[11] := logmult*ln(1.875);
|
||||
|
||||
purefifth := just[7];
|
||||
pythag := 12.00 * purefifth - 8400.00;
|
||||
syntonic := 4.00 * purefifth - 2400.00 - just[4];
|
||||
|
||||
FOR note := 1 STEP 1 UNTIL 11 DO
|
||||
just[note+12] := just[note]+1200.00;
|
||||
|
||||
major[1] := 2; major[2] := 4; major[3] := 5;
|
||||
major[4] := 7; major[5] := 9; major[6] := 11;
|
||||
|
||||
minor[1] := 2; minor[2] := 3; minor[3] := 5;
|
||||
minor[4] := 7; minor[5] := 8; minor[6] := 11;
|
||||
END set just scale;
|
||||
|
||||
PROCEDURE ay38912( octave ); VALUE octave; REAL octave;
|
||||
BEGIN
|
||||
|
||||
text(outdev, "*N ");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
rwrite( outdev, entier(125000.00/(freq[note]*octave) + 0.5), 8, 0 );
|
||||
|
||||
text(outdev, "*N ");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
rwrite( outdev, (freq[note]*octave), 8, 2 );
|
||||
|
||||
text(outdev, "*N ");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN interval := entier(125000.00/(freq[note]*octave) + 0.5);
|
||||
rwrite( outdev, 125000.00/interval, 8, 2 );
|
||||
END;
|
||||
|
||||
text(outdev, "*N ");
|
||||
cfreq := freq[0]*octave;
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN interval := entier(125000.00/(freq[note]*octave) + 0.5);
|
||||
scalecents := 125000.00/interval;
|
||||
rwrite( outdev, logmult*ln(scalecents/cfreq) - scale[note], 8, 2 );
|
||||
END;
|
||||
END ay38912;
|
||||
|
||||
PROCEDURE write scale error( error, lerror );
|
||||
VALUE error, lerror; REAL error, lerror;
|
||||
BEGIN IF error > 90.00 THEN format( 512+&X )
|
||||
ELSE IF error > 60.00 THEN format( 512+&** )
|
||||
ELSE IF error < 40.00 THEN format( 512+&= )
|
||||
ELSE IF (error < 48.80) OR (error < 48.90 AND lerror < 33.20)
|
||||
THEN format( 512+&E );
|
||||
rwrite(outdev, error, 8, 2);
|
||||
format( 512+&*S );
|
||||
END;
|
||||
|
||||
PROCEDURE scale from fifths;
|
||||
BEGIN scale[0] := scalecents := 0; interval := 0;
|
||||
FOR note := 1 STEP 1 UNTIL 11 DO
|
||||
BEGIN interval := interval + 7;
|
||||
scalecents := scalecents + fifths[note];
|
||||
IF interval > 11 THEN
|
||||
BEGIN interval := interval - 12;
|
||||
scalecents := scalecents - 1200.00;
|
||||
END;
|
||||
scale[interval] := scalecents;
|
||||
END;
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN scale[note+12] := scale[note]+1200.00;
|
||||
scalecents := scale[note] - scale[9];
|
||||
freq[note] := 440.0 * exp(scalecents/logmult);
|
||||
freq[note+12] := 2.0 * freq[note];
|
||||
END;
|
||||
|
||||
END scale from fifths;
|
||||
|
||||
PROCEDURE readcents;
|
||||
BEGIN
|
||||
text( 1, "*NType 11 cent offsets from C*N" );
|
||||
scale[0] := 0;
|
||||
FOR note := 1 STEP 1 UNTIL 11 DO
|
||||
BEGIN scale[note] := read(7);
|
||||
END;
|
||||
FOR note := 1 STEP 1 UNTIL 12 DO
|
||||
fifths[note] := scale[note+6] - scale[note-1];
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN scale[note+12] := scale[note]+1200.00;
|
||||
scalecents := scale[note] - scale[9];
|
||||
freq[note] := 440.0 * exp(scalecents/logmult);
|
||||
freq[note+12] := 2.0 * freq[note];
|
||||
END;
|
||||
END readcents;
|
||||
|
||||
PROCEDURE readfifths;
|
||||
BEGIN text( 1, "*NCircle of 11 fifths in cents from C*N" );
|
||||
|
||||
circle heading;
|
||||
scalecents := 0;
|
||||
FOR note := 1 STEP 1 UNTIL 11 DO
|
||||
BEGIN fifths[note] := read(7);
|
||||
scalecents := scalecents + fifths[note];
|
||||
END;
|
||||
fifths[12] := 8400.00 - scalecents;
|
||||
scale from fifths;
|
||||
END readfifths;
|
||||
|
||||
PROCEDURE readcommas;
|
||||
BEGIN INTEGER sign, num, den;
|
||||
text(1, "*NCircle of 12 fifths in commas commas from C");
|
||||
text(1, "*N0= pure, or <+|-><a/b><P|S>, e.g. +1P, -1/4P, +1/2S*N");
|
||||
|
||||
circle heading;
|
||||
scalecents := 0;
|
||||
FOR note := 1 STEP 1 UNTIL 11 DO
|
||||
BEGIN
|
||||
next fifth:
|
||||
char := chin(7);
|
||||
IF char = &0 THEN sign := 0
|
||||
ELSE IF char = &- THEN sign := -1
|
||||
ELSE IF char = &+ THEN sign := 1
|
||||
ELSE GOTO next fifth;
|
||||
|
||||
IF sign = 0 THEN fifths[note] := purefifth
|
||||
ELSE
|
||||
BEGIN num := den := 0;
|
||||
char := chin(7);
|
||||
WHILE char >= &0 AND char <= &9 DO
|
||||
BEGIN num := 10*num + char - &0; char := chin(7);
|
||||
END;
|
||||
IF char = &/ THEN
|
||||
BEGIN char := chin(7);
|
||||
WHILE char >= &0 AND char <= &9 DO
|
||||
BEGIN den := 10*den + char - &0;
|
||||
char := chin(7);
|
||||
END;
|
||||
IF den = 0 THEN den := 1;
|
||||
END
|
||||
ELSE den := 1;
|
||||
|
||||
interval := char MASK 223;
|
||||
IF interval = &P THEN fifths[note] := pythag
|
||||
ELSE fifths[note] := syntonic;
|
||||
fifths[note] := purefifth+fifths[note]*sign*num/den;
|
||||
END;
|
||||
scalecents := scalecents + fifths[note];
|
||||
END;
|
||||
fifths[12] := 8400.00 - scalecents;
|
||||
scale from fifths;
|
||||
END readcommas;
|
||||
|
||||
{ Main program start }
|
||||
|
||||
set just scale;
|
||||
|
||||
outdev := 1;
|
||||
|
||||
get streams:
|
||||
ioc(0); ioc(1); ioc(15); ioc(2);
|
||||
outdev := output;
|
||||
IF outdev < 0 THEN GOTO get streams;
|
||||
|
||||
skip(outdev);
|
||||
text(1,"Title: ");
|
||||
ioc(0); ioc(1); base := 1;
|
||||
title char: char := chin(7);
|
||||
IF char >= &*S THEN BEGIN title[base] := char; base := base+1; GOTO title char END;
|
||||
title[base] := 0;
|
||||
|
||||
get input type:
|
||||
ioc(0); ioc(1);
|
||||
text(1, "*NNotes (cents), Fifths (cents) or fifths Commas N/F/C ? ");
|
||||
note := chin(7) MASK 223;
|
||||
IF note = &N THEN readcents
|
||||
ELSE IF note = &F THEN readfifths
|
||||
ELSE IF note = &C THEN readcommas
|
||||
ELSE GOTO get input type;
|
||||
|
||||
base := 1;
|
||||
WHILE title[base] # 0 DO
|
||||
BEGIN chout( outdev, title[base] ); base := base+1;
|
||||
END;
|
||||
|
||||
skip( outdev );
|
||||
circle echo;
|
||||
|
||||
text(outdev, "*NAY3 8912, True frequency, generated frequency, error in cents*N");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN text(outdev, " "); write note( note );
|
||||
END;
|
||||
ay38912( 0.25 );
|
||||
skip( outdev );
|
||||
ay38912( 0.5 );
|
||||
skip( outdev );
|
||||
ay38912( 1.0 );
|
||||
skip( outdev );
|
||||
ay38912( 2.0 );
|
||||
skip( outdev );
|
||||
ay38912( 4.0 );
|
||||
|
||||
text(outdev, "*NPure fifth "); rwrite(outdev, purefifth, 8, 3);
|
||||
text(outdev," Pythagorean comma "); rwrite(outdev, pythag, 8, 3);
|
||||
text(outdev," Syntonic comma "); rwrite(outdev, syntonic, 8, 3);
|
||||
|
||||
text(outdev,
|
||||
"*N*NKey: E equal tempered, = just, ** error greater than 10 cents, X syntonic comma error");
|
||||
text(outdev,"*N");
|
||||
text(outdev,"*NJust scale (cents), this one (cents, Hz)*N");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN text(outdev, " "); write note( note );
|
||||
END;
|
||||
|
||||
text(outdev,"*N ");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
rwrite( outdev, just[note], 8, 2 );
|
||||
text(outdev,"*N ");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
rwrite( outdev, scale[note], 8, 2 );
|
||||
text(outdev,"*N ");
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
rwrite( outdev, freq[note], 8, 2 );
|
||||
|
||||
xcount := starcount := goodcount := 0;
|
||||
|
||||
text(outdev, "*NIntervals from each note*N" );
|
||||
FOR note := 1 STEP 1 UNTIL 11 DO
|
||||
BEGIN text(outdev, " "); write note( note );
|
||||
END;
|
||||
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN skip( outdev ); write note( note );
|
||||
FOR interval := 1 STEP 1 UNTIL 11 DO
|
||||
BEGIN scalecents := scale[note+interval]-scale[note];
|
||||
justcents := just[interval];
|
||||
IF abs(scalecents-justcents) >= 21.49 THEN
|
||||
BEGIN format( 512+&X );
|
||||
xcount := xcount + 1;
|
||||
END
|
||||
ELSE IF abs(scalecents-justcents) > 10.00 THEN
|
||||
BEGIN format( 512+&** );
|
||||
starcount := starcount + 1;
|
||||
END
|
||||
ELSE IF abs(scalecents-justcents) < 1.00 THEN
|
||||
BEGIN format( 512+&= );
|
||||
goodcount := goodcount + 1;
|
||||
END
|
||||
ELSE IF abs(scalecents-100.0*interval) < 1.00 THEN
|
||||
format( 512+&E );
|
||||
rwrite( outdev, scalecents, 8, 2 );
|
||||
format( 512+&*S);
|
||||
END;
|
||||
END;
|
||||
|
||||
minorsum := majorsum := minorbigsum := majorbigsum := 0;
|
||||
lminorsum := lmajorsum := lminorbigsum := lmajorbigsum := 0;
|
||||
|
||||
text(outdev, "*N*NAccumulated errors in each major and minor scale");
|
||||
text(outdev,
|
||||
"*NKey: = very good, E better than equal temperament, ** poor, X intolerable");
|
||||
text(outdev, "*NEqual temp");
|
||||
rwrite(outdev, 48.88, 8, 2); rwrite(outdev, 48.88, 8, 2);
|
||||
text(outdev, " 3rd to 6th ");
|
||||
rwrite(outdev, 33.24, 8, 2);
|
||||
rwrite(outdev, 33.24, 8, 2);
|
||||
text(outdev, " scale+internals ");
|
||||
rwrite(outdev, 168.15, 8, 2); rwrite(outdev, 207.25, 8, 2);
|
||||
|
||||
FOR note := 0 STEP 1 UNTIL 11 DO
|
||||
BEGIN skip(outdev); write note( note );
|
||||
text(outdev, " scale ");
|
||||
minorerror[note] := majorerror[note] := 0;
|
||||
lminorerror[note] := lmajorerror[note] := 0;
|
||||
FOR interval := 1 STEP 1 UNTIL 6 DO
|
||||
BEGIN
|
||||
scalecents := scale[note+minor[interval]] - scale[note];
|
||||
justcents := just[minor[interval]];
|
||||
minorerror[note] := minorerror[note] + abs(justcents - scalecents);
|
||||
IF interval > 1 AND interval < 6 THEN
|
||||
lminorerror[note] := lminorerror[note] +
|
||||
abs(justcents - scalecents);
|
||||
scalecents := scale[note+major[interval]] - scale[note];
|
||||
justcents := just[major[interval]];
|
||||
majorerror[note] := majorerror[note] + abs(justcents - scalecents);
|
||||
IF interval > 1 AND interval < 6 THEN
|
||||
lmajorerror[note] := lmajorerror[note] +
|
||||
abs(justcents - scalecents);
|
||||
END;
|
||||
|
||||
minorsum := minorsum + minorerror[note];
|
||||
majorsum := majorsum + majorerror[note];
|
||||
write scale error( majorerror[note], lmajorerror[note] );
|
||||
write scale error( minorerror[note], lminorerror[note] );
|
||||
|
||||
text(outdev, " 3rd to 6th ");
|
||||
lminorsum := lminorsum + lminorerror[note];
|
||||
lmajorsum := lmajorsum + lmajorerror[note];
|
||||
rwrite(outdev, lmajorerror[note], 8, 2);
|
||||
rwrite(outdev, lminorerror[note], 8, 2);
|
||||
|
||||
text(outdev, " scale+internals ");
|
||||
tminorerror[note] := minorerror[note];
|
||||
tmajorerror[note] := majorerror[note];
|
||||
FOR base := 1 STEP 1 UNTIL 5 DO
|
||||
FOR interval := base+1 STEP 1 UNTIL 6 DO
|
||||
BEGIN
|
||||
scalecents := scale[note+minor[interval]] - scale[note+minor[base]];
|
||||
justcents := just[minor[interval]-minor[base]];
|
||||
tminorerror[note] := tminorerror[note] + abs(justcents - scalecents);
|
||||
scalecents := scale[note+major[interval]] - scale[note+major[base]];
|
||||
justcents := just[major[interval]-major[base]];
|
||||
tmajorerror[note] := tmajorerror[note] + abs(justcents - scalecents);
|
||||
END;
|
||||
|
||||
minorbigsum := minorbigsum + tminorerror[note];
|
||||
majorbigsum := majorbigsum + tmajorerror[note];
|
||||
|
||||
rwrite(outdev, tmajorerror[note], 8, 2);
|
||||
rwrite(outdev, tminorerror[note], 8, 2);
|
||||
END;
|
||||
|
||||
text(outdev, "*N"); write(outdev, goodcount); text(outdev,"just intervals, ");
|
||||
write(outdev, starcount); text(outdev,"errors > 10 cents, and ");
|
||||
write(outdev, xcount); text(outdev,"syntonic comma errors");
|
||||
|
||||
text(outdev, "*NTotal errors. Equal temperament ");
|
||||
rwrite(outdev, 586.58, 8, 2); rwrite(outdev, 586.54, 8, 2);
|
||||
text(outdev, " 3rd to 6th "); rwrite(outdev, 398.87, 8, 2);
|
||||
rwrite(outdev, 398.83, 8, 2);
|
||||
text(outdev, " with internal errors ");
|
||||
rwrite(outdev, 2017.78, 8, 2); rwrite(outdev, 2487.04, 8, 2);
|
||||
text(outdev, "*NTotal errors. This temperament ");
|
||||
rwrite(outdev, majorsum, 8, 2); rwrite(outdev, minorsum, 8, 2);
|
||||
text(outdev, " 3rd to 6th ");
|
||||
rwrite(outdev, lmajorsum, 8, 2); rwrite(outdev, lminorsum, 8, 2);
|
||||
text(outdev, " with internal errors ");
|
||||
rwrite(outdev, majorbigsum, 8, 2); rwrite(outdev, minorbigsum, 8, 2);
|
||||
|
||||
chout( outdev, &*P );
|
||||
|
||||
END FINISH
|
||||
BIN
RHA (Minisystems) ALGOL v55/SCALE.ASC
Normal file
BIN
RHA (Minisystems) ALGOL v55/SCALE.ASC
Normal file
Binary file not shown.
38
RHA (Minisystems) ALGOL v55/SIEVE.ALG
Normal file
38
RHA (Minisystems) ALGOL v55/SIEVE.ALG
Normal file
@ -0,0 +1,38 @@
|
||||
BEGIN
|
||||
|
||||
COMMENT
|
||||
BYTE magazine's CLASSIC SIEVE OF ERATOSTHENES;
|
||||
|
||||
INTEGER o, limit, i, k, count, prime;
|
||||
BOOLEAN ARRAY flags[0:8190];
|
||||
limit := 8190;
|
||||
|
||||
FOR o := 1 STEP 1 UNTIL 10 DO
|
||||
BEGIN
|
||||
FOR i := 0 STEP 1 UNTIL limit DO
|
||||
flags[i] := TRUE;
|
||||
|
||||
count := 0;
|
||||
FOR i := 0 STEP 1 UNTIL limit DO
|
||||
BEGIN
|
||||
IF flags[i] THEN
|
||||
BEGIN
|
||||
prime := i + i + 3;
|
||||
IF prime < limit THEN
|
||||
BEGIN
|
||||
FOR k := (i + prime) STEP prime UNTIL limit DO
|
||||
flags[k] := FALSE;
|
||||
END;
|
||||
count := count + 1;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
|
||||
text( 1, " PRIMES FOUND: ");
|
||||
write( 1, count );
|
||||
text( 1, "*N" );
|
||||
ioc(22);
|
||||
|
||||
END
|
||||
FINISH
|
||||
|
||||
17
RHA (Minisystems) ALGOL v55/TESTDEV.ALG
Normal file
17
RHA (Minisystems) ALGOL v55/TESTDEV.ALG
Normal file
@ -0,0 +1,17 @@
|
||||
BEGIN INTEGER dev, char;
|
||||
|
||||
get dev:
|
||||
text(1,"*NInput device tester, type number ");
|
||||
ioc(0); ioc(1); dev := read(1);
|
||||
|
||||
IF dev < 1 OR dev > 7 THEN GOTO get dev;
|
||||
|
||||
text(1,"Type away*N"); ioc(0); ioc(1);
|
||||
loop:
|
||||
char := chin(dev);
|
||||
IF NOT (dev = 3 AND char = 0 ) THEN
|
||||
BEGIN chout(1, char); write(1,char) END;
|
||||
IF char # 3 THEN GOTO loop;
|
||||
|
||||
END FINISH
|
||||
|
||||
BIN
RHA (Minisystems) ALGOL v55/TESTDEV.ASC
Normal file
BIN
RHA (Minisystems) ALGOL v55/TESTDEV.ASC
Normal file
Binary file not shown.
242
RHA (Minisystems) ALGOL v55/TTT.ALG
Normal file
242
RHA (Minisystems) ALGOL v55/TTT.ALG
Normal file
@ -0,0 +1,242 @@
|
||||
BEGIN
|
||||
|
||||
COMMENT scoreWin 6 ;
|
||||
COMMENT scoreTie 5 ;
|
||||
COMMENT scoreLose 4 ;
|
||||
COMMENT scoreMax 9 ;
|
||||
COMMENT scoreMin 2 ;
|
||||
COMMENT scoreInvalid 0 ;
|
||||
COMMENT pieceX 1 ;
|
||||
COMMENT pieceY 2 ;
|
||||
COMMENT pieceBlank 0 ;
|
||||
|
||||
INTEGER movecount;
|
||||
INTEGER ARRAY board[0:8];
|
||||
INTEGER ARRAY isodd[0:8];
|
||||
|
||||
INTEGER PROCEDURE winner;
|
||||
BEGIN
|
||||
INTEGER t, p;
|
||||
|
||||
p := 0;
|
||||
t := board[ 0 ];
|
||||
IF 0 # t THEN BEGIN
|
||||
IF ( ( ( t = board[1] ) AND ( t = board[2] ) ) OR
|
||||
( ( t = board[3] ) AND ( t = board[6] ) ) ) THEN
|
||||
p := t;
|
||||
END;
|
||||
|
||||
IF 0 = p THEN BEGIN
|
||||
t := board[1];
|
||||
IF ( 0 # t ) AND ( t = board[4] ) AND ( t = board[7] ) THEN
|
||||
p := t
|
||||
ELSE BEGIN
|
||||
t := board[2];
|
||||
IF ( 0 # t ) AND ( t = board[5] ) AND ( t = board[8] ) THEN
|
||||
p := t
|
||||
ELSE BEGIN
|
||||
t := board[3];
|
||||
IF ( 0 # t ) AND ( t = board[4] ) AND ( t = board[5] ) THEN
|
||||
p := t
|
||||
ELSE BEGIN
|
||||
t := board[6];
|
||||
IF ( 0 # t ) AND ( t = board[7] ) AND ( t = board[8] ) THEN
|
||||
p := t
|
||||
ELSE BEGIN
|
||||
t := board[4];
|
||||
IF ( 0 # t ) THEN BEGIN
|
||||
IF ( ( ( t = board[0] ) AND ( t = board[8] ) ) OR
|
||||
( ( t = board[2] ) AND ( t = board[6] ) ) ) THEN
|
||||
p := t;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
|
||||
winner := p;
|
||||
END winner;
|
||||
|
||||
INTEGER PROCEDURE winner2( move );
|
||||
VALUE move;
|
||||
INTEGER move;
|
||||
BEGIN
|
||||
INTEGER x;
|
||||
x := board[ move ];
|
||||
CASE move OF
|
||||
0: BEGIN
|
||||
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 x := 0;
|
||||
END;
|
||||
1: BEGIN
|
||||
IF NOT ( ( ( x = board[0] ) AND ( x = board[2] ) ) OR
|
||||
( ( x = board[4] ) AND ( x = board[7] ) ) )
|
||||
THEN x := 0;
|
||||
END;
|
||||
2: BEGIN
|
||||
x := board[ 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 := 0;
|
||||
END;
|
||||
3: BEGIN
|
||||
x := board[ 3 ];
|
||||
IF NOT ( ( ( x = board[4] ) AND ( x = board[5] ) ) OR
|
||||
( ( x = board[0] ) AND ( x = board[6] ) ) )
|
||||
THEN x := 0;
|
||||
END;
|
||||
4: BEGIN
|
||||
x := board[ 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 := 0;
|
||||
END;
|
||||
5: BEGIN
|
||||
x := board[ 5 ];
|
||||
IF NOT ( ( ( x = board[3] ) AND ( x = board[4] ) ) OR
|
||||
( ( x = board[2] ) AND ( x = board[8] ) ) )
|
||||
THEN x := 0;
|
||||
END;
|
||||
6: BEGIN
|
||||
x := board[ 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 := 0;
|
||||
END;
|
||||
7: BEGIN
|
||||
x := board[ 7 ];
|
||||
IF NOT ( ( ( x = board[6] ) AND ( x = board[8] ) ) OR
|
||||
( ( x = board[1] ) AND ( x = board[4] ) ) )
|
||||
THEN x := 0;
|
||||
END;
|
||||
8: BEGIN
|
||||
x := board[ 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 := 0;
|
||||
END
|
||||
ELSE text( 1, "unexpected move" );
|
||||
|
||||
winner2 := x;
|
||||
END winner2;
|
||||
|
||||
INTEGER PROCEDURE minmax( alpha, beta, depth, move );
|
||||
VALUE alpha, beta, depth, move;
|
||||
INTEGER alpha, beta, depth, move;
|
||||
BEGIN
|
||||
INTEGER value, p, score, pm;
|
||||
value := 0;
|
||||
movecount := movecount + 1;
|
||||
|
||||
IF depth >= 4 THEN BEGIN
|
||||
comment winner2 is faster than winner
|
||||
p := winner2( move );
|
||||
IF p # 0 THEN BEGIN
|
||||
IF p = 1 THEN value := 6
|
||||
ELSE value := 4;
|
||||
END
|
||||
ELSE BEGIN
|
||||
IF depth = 8 THEN value := 5;
|
||||
END;
|
||||
END;
|
||||
|
||||
IF value = 0 THEN BEGIN
|
||||
IF 1 = isodd[ depth ] THEN BEGIN
|
||||
value := 2;
|
||||
pm := 1;
|
||||
END
|
||||
ELSE BEGIN
|
||||
value := 9;
|
||||
pm := 2;
|
||||
END;
|
||||
|
||||
p := 0;
|
||||
WHILE p <= 8 DO BEGIN
|
||||
IF board[ p ] = 0 THEN BEGIN
|
||||
board[ p ] := pm;
|
||||
score := minmax( alpha, beta, depth + 1, p );
|
||||
board[ p ] := 0;
|
||||
|
||||
IF 1 = isodd[ depth ] THEN BEGIN
|
||||
IF score > value THEN BEGIN
|
||||
value := score;
|
||||
IF ( ( value = 6 ) OR ( value >= beta ) ) THEN
|
||||
p := 10
|
||||
ELSE BEGIN
|
||||
IF ( value > alpha ) THEN alpha := value;
|
||||
END;
|
||||
END;
|
||||
END
|
||||
ELSE BEGIN
|
||||
IF score < value THEN BEGIN
|
||||
value := score;
|
||||
IF ( value = 4 ) OR ( value <= alpha ) THEN
|
||||
p := 10
|
||||
ELSE BEGIN
|
||||
IF ( value < beta ) THEN beta := value;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
|
||||
p := p + 1;
|
||||
END;
|
||||
END;
|
||||
|
||||
minmax := value;
|
||||
END minmax;
|
||||
|
||||
PROCEDURE findsolution( move );
|
||||
VALUE move;
|
||||
INTEGER move;
|
||||
BEGIN
|
||||
INTEGER score;
|
||||
|
||||
board[ move ] := 1;
|
||||
score := minmax( 2, 9, 0, move );
|
||||
board[ move ] := 0;
|
||||
END findsolution;
|
||||
|
||||
PROCEDURE main;
|
||||
BEGIN
|
||||
INTEGER i;
|
||||
|
||||
FOR i:=0 STEP 1 UNTIL 8 DO BEGIN
|
||||
board[ i ] := 0;
|
||||
END;
|
||||
|
||||
FOR i:=0 STEP 2 UNTIL 8 DO BEGIN
|
||||
isodd[ i ] := 0;
|
||||
END;
|
||||
|
||||
FOR i:=1 STEP 2 UNTIL 7 DO BEGIN
|
||||
isodd[ i ] := 1;
|
||||
END;
|
||||
|
||||
FOR i:=0 STEP 1 UNTIL 9 DO BEGIN
|
||||
movecount := 0;
|
||||
findsolution( 0 );
|
||||
findsolution( 1 );
|
||||
findsolution( 4 );
|
||||
END;
|
||||
|
||||
text( 1, "moves: " );
|
||||
write( 1, movecount );
|
||||
text( 1, "*N" );
|
||||
|
||||
ioc(22);
|
||||
END main;
|
||||
|
||||
main;
|
||||
|
||||
END
|
||||
FINISH
|
||||
|
||||
68
RHA (Minisystems) ALGOL v55/UCASE.ALG
Normal file
68
RHA (Minisystems) ALGOL v55/UCASE.ALG
Normal file
@ -0,0 +1,68 @@
|
||||
'BEGIN' 'INTEGER' IN,OUT,C;
|
||||
|
||||
'COMMENT' THIS PROGRAM CONVERTS FROM
|
||||
THE UPPER/LOWER CASE CONVENTION TO
|
||||
THE UPPER CASE IN QUOTES CONVENTION;
|
||||
|
||||
'PROCEDURE' SETO(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(31);
|
||||
|
||||
'INTEGER' 'PROCEDURE' SWLIST;
|
||||
IOC(39);
|
||||
|
||||
'PROCEDURE' GETC;
|
||||
'BEGIN' C:=CHIN(IN);
|
||||
'IF' C<0 'OR' C=&^Z 'THEN' 'GOTO' FIN
|
||||
'END' ;
|
||||
|
||||
|
||||
'PROCEDURE' UOUT;
|
||||
'IF' C>=97 'AND' C<=122 'THEN' CHOUT(OUT,C-32)
|
||||
'ELSE' CHOUT(OUT,C);
|
||||
|
||||
|
||||
SETO(SWLIST+13);
|
||||
TEXT(10,"ALG"); {DEFAULT EXTENSION}
|
||||
A1: IOC(2); IN:=INPUT;
|
||||
'IF' IN<1 'THEN' 'GOTO' A1;
|
||||
OUT:=OUTPUT;
|
||||
'IF' OUT<1 'THEN'
|
||||
'BEGIN' CLOSE(IN); 'GOTO' A1;
|
||||
'END' ;
|
||||
|
||||
LOOP: GETC;
|
||||
'IF' C=&" 'THEN'
|
||||
'BEGIN' UOUT;
|
||||
A2: GETC; UOUT;
|
||||
'IF' C=&** 'THEN'
|
||||
'BEGIN' GETC; UOUT;
|
||||
'END' 'ELSE'
|
||||
'IF' C=&" 'THEN' 'GOTO' LOOP;
|
||||
'GOTO' A2;
|
||||
'END' 'ELSE'
|
||||
'IF' C=&*C 'THEN'
|
||||
'BEGIN' UOUT; 'GOTO' LOOP 'END' 'ELSE'
|
||||
'IF' C=&& 'THEN'
|
||||
'BEGIN' UOUT; GETC; UOUT;
|
||||
'IF' C=&** 'OR' C=&*^ 'THEN'
|
||||
'BEGIN' GETC; UOUT
|
||||
'END' ;
|
||||
'GOTO' LOOP;
|
||||
'END' 'ELSE'
|
||||
'IF' C>=&A 'AND' C<=&Z 'THEN'
|
||||
'BEGIN' CHOUT(OUT,&'); UOUT;
|
||||
A3: GETC;
|
||||
'IF' C>=&A 'AND' C<=&Z 'THEN'
|
||||
'BEGIN' UOUT; 'GOTO' A3
|
||||
'END' ;
|
||||
CHOUT(OUT,&'); UOUT;
|
||||
'GOTO' LOOP;
|
||||
'END' 'ELSE' UOUT;
|
||||
'GOTO' LOOP;
|
||||
|
||||
FIN: CHOUT(OUT,&^Z); CLOSE(OUT);
|
||||
CLOSE(IN); 'GOTO' A1
|
||||
'END'
|
||||
'FINISH'
|
||||
|
||||
|
||||
218
RHA (Minisystems) ALGOL v55/VDU.ALG
Normal file
218
RHA (Minisystems) ALGOL v55/VDU.ALG
Normal file
@ -0,0 +1,218 @@
|
||||
|
||||
'BEGIN'
|
||||
'INTEGER' D,I,J,S,L,LC;
|
||||
'BOOLEAN' WFLAG,FILL,UCASE;
|
||||
'INTEGER' 'ARRAY' LET[&A:&Z+1];
|
||||
'BYTE' 'ARRAY' W[1:40,1:10],LINE[1:150];
|
||||
|
||||
|
||||
'INTEGER' 'PROCEDURE' LOCATION(I);
|
||||
'VALUE' I; 'INTEGER' I; IOC(24);
|
||||
|
||||
|
||||
'PROCEDURE' SETI(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(30);
|
||||
|
||||
|
||||
'PROCEDURE' SETO(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(31);
|
||||
|
||||
|
||||
'INTEGER' 'PROCEDURE' PEEK(A);
|
||||
'VALUE' A; 'INTEGER' A; IOC(36);
|
||||
|
||||
|
||||
'INTEGER' 'PROCEDURE' SWLIST;
|
||||
IOC(39);
|
||||
|
||||
'INTEGER' 'PROCEDURE' SLOC(S);
|
||||
'STRING' S; IOC(55);
|
||||
|
||||
|
||||
'INTEGER' 'PROCEDURE' FINDINPUT(S);
|
||||
'STRING' S;
|
||||
'BEGIN' GETLIST(S); IOC(5);
|
||||
FINDINPUT:=INPUT; IOC(1)
|
||||
'END';
|
||||
|
||||
|
||||
'INTEGER' 'PROCEDURE' FINDOUTPUT(S);
|
||||
'STRING' S;
|
||||
'BEGIN' GETLIST(S); IOC(3);
|
||||
FINDOUTPUT:=OUTPUT; IOC(1)
|
||||
'END';
|
||||
|
||||
|
||||
'PROCEDURE' GETLIST(S);
|
||||
'STRING' S;
|
||||
'BEGIN' 'INTEGER' I;
|
||||
IOC(0); IOC(1); TEXT(7,S);
|
||||
CHOUT(7,0);
|
||||
I:=CHIN(7);
|
||||
'IF' I=&? 'THEN'
|
||||
'BEGIN' 'FOR' I:=CHIN(7) 'WHILE'
|
||||
I#0 'DO' CHOUT(1,I);
|
||||
I:=CHIN(7)
|
||||
'END';
|
||||
IOC(0);
|
||||
'END';
|
||||
|
||||
|
||||
'PROCEDURE' CLARR(A,L);
|
||||
'VALUE' A,L; 'INTEGER' A,L;
|
||||
IOC(50);
|
||||
|
||||
|
||||
|
||||
'PROCEDURE' CHAR;
|
||||
'BEGIN'
|
||||
LOOP: I:=CHIN(1);
|
||||
'IF' I=&^X 'THEN'
|
||||
'BEGIN' WFLAG:='NOT' WFLAG;
|
||||
'GOTO' LOOP;
|
||||
'END' 'ELSE'
|
||||
'IF' I=&^Z 'OR' I=&^C 'THEN'
|
||||
'BEGIN' CLOSE(D); 'GOTO' FLOOP
|
||||
'END' 'ELSE'
|
||||
'IF' I=127 'THEN'
|
||||
'BEGIN' 'IF' LC>0 'THEN'
|
||||
'BEGIN' CHOUT(1,LINE[LC]);
|
||||
LC:=LC-1;
|
||||
'END';
|
||||
FILL:='FALSE' ;
|
||||
'GOTO' LOOP
|
||||
'END' 'ELSE'
|
||||
'IF' I=&^U 'THEN'
|
||||
'BEGIN' LC:=0; TEXT(1,"*^U*N");
|
||||
FILL:=WFLAG;
|
||||
'GOTO' LOOP
|
||||
'END' 'ELSE'
|
||||
'IF' I=&^R 'THEN'
|
||||
'BEGIN' SKIP(1);
|
||||
'FOR' I:=1 'STEP' 1 'UNTIL' LC 'DO'
|
||||
CHOUT(1,LINE[I]);
|
||||
'END' 'ELSE'
|
||||
'IF' I<&A 'OR' I>&Z 'THEN' FILL:=WFLAG 'ELSE'
|
||||
'IF' I<&*T 'OR' I>&*C 'AND' I<&*S 'THEN' 'GOTO' LOOP
|
||||
'END' ;
|
||||
|
||||
|
||||
'PROCEDURE' OUTL(I); 'VALUE' I; 'INTEGER' I;
|
||||
'BEGIN' LC:=LC+1; LINE[LC]:=I
|
||||
'END' ;
|
||||
|
||||
|
||||
'PROCEDURE' OUTW(M,L);
|
||||
'VALUE' M,L; 'INTEGER' M,L;
|
||||
'BEGIN' 'INTEGER' K;
|
||||
LOOP: L:=L+1; K:=W[M,L];
|
||||
'IF' L<11 'AND' K#0 'THEN'
|
||||
'BEGIN' OUTL(K); CHOUT(1,K);
|
||||
'GOTO' LOOP
|
||||
'END' ;
|
||||
'IF' UCASE 'THEN'
|
||||
'BEGIN' OUTL(&'); CHOUT(1,&');
|
||||
'END' ;
|
||||
OUTL(&*S); CHOUT(1,&*S);
|
||||
FILL:=WFLAG;
|
||||
'END' ;
|
||||
|
||||
|
||||
'PROCEDURE' GETWORD;
|
||||
'BEGIN' 'INTEGER' L,MN,MX;
|
||||
L:=1; FILL:='FALSE';
|
||||
MN:=LET[I];
|
||||
'IF' MN<0 'THEN' 'GOTO' FIN;
|
||||
MX:=MN;
|
||||
'FOR' MX:=MX+1 'WHILE' W[MX,1]=I 'DO' ;
|
||||
MX:=MX-1;
|
||||
L1: 'IF' MX=MN 'THEN'
|
||||
'BEGIN' OUTW(MN,L); 'GOTO' FIN;
|
||||
'END';
|
||||
L:=L+1; CHAR; OUTL(I);
|
||||
L2: 'IF' I=W[MN,L] 'THEN' 'GOTO' L3;
|
||||
MN:=MN+1;
|
||||
'IF' MN>MX 'THEN' 'GOTO' FIN 'ELSE' 'GOTO' L2;
|
||||
L3: 'IF' I=W[MX,L] 'THEN' 'GOTO' L1;
|
||||
MX:=MX-1;
|
||||
'IF' MX>=MN 'THEN' 'GOTO' L3;
|
||||
FIN:
|
||||
'END' ;
|
||||
|
||||
|
||||
{SET UP KEY WORDS}
|
||||
SETI(SLOC("
|
||||
<
|
||||
AND ARRAY
|
||||
BEGIN BOOLEAN BYTE
|
||||
COMMENT
|
||||
DIFFER DO
|
||||
ELSE END EQUIVALENT
|
||||
FALSE FINISH FOR
|
||||
GOTO
|
||||
IF IMPLIES INTEGER
|
||||
LABEL LIBRARY
|
||||
MASK MOD
|
||||
NOT
|
||||
OR
|
||||
PROCEDURE
|
||||
REAL
|
||||
STEP STRING SWITCH
|
||||
THEN TRUE
|
||||
UNTIL
|
||||
VALUE
|
||||
WHILE
|
||||
> "));
|
||||
|
||||
'FOR' I:=&A 'STEP' 1 'UNTIL' &Z+1 'DO'
|
||||
LET[I]:=-1;
|
||||
CLARR(LOCATION(W[1,1]),400);
|
||||
'FOR' J:=CHIN(10) 'WHILE' J#&< 'DO' ;
|
||||
I:=0; S:=0;
|
||||
'FOR' J:=CHIN(10) 'WHILE' J#&> 'DO'
|
||||
'BEGIN' 'IF' J<=&*S 'THEN'
|
||||
'BEGIN' 'FOR' J:=CHIN(10) 'WHILE' J<=&*S 'DO' ;
|
||||
'IF' J=&> 'THEN' 'GOTO' DONE;
|
||||
I:=I+1; L:=1;
|
||||
'IF' J#S 'THEN'
|
||||
'BEGIN' S:=J; LET[J]:=I;
|
||||
'END' ;
|
||||
'END' ;
|
||||
W[I,L]:=J; L:=L+1;
|
||||
'END' ;
|
||||
|
||||
{GET OUTPUT FILE}
|
||||
|
||||
{DEFAULT EXTENSION}
|
||||
DONE: SETO(SWLIST+13); TEXT(10,"ALG");
|
||||
FLOOP: D:=FINDOUTPUT("?FILE =");
|
||||
'IF' D<1 'THEN' 'GOTO' FIN;
|
||||
UCASE:=PEEK(SWLIST)=&U; {UPPER CASE CONVENTION ?}
|
||||
WFLAG:='TRUE' ; {SWITCH ON AUTO FILL}
|
||||
FILL:=WFLAG;
|
||||
LC:=0; {# CHARS ON LINE}
|
||||
TEXT(1,"*^*N"); {PROMPT}
|
||||
|
||||
INLOOP: CHAR; {GET NEXT CHARACTER}
|
||||
'IF' I=&*C 'THEN'
|
||||
'BEGIN' 'FOR' I:=1 'STEP' 1 'UNTIL' LC 'DO' CHOUT(D,LINE[I]);
|
||||
LC:=0; SKIP(D);
|
||||
'END' 'ELSE'
|
||||
'IF' 'NOT' FILL 'THEN' OUTL(I) 'ELSE'
|
||||
'IF' UCASE 'THEN'
|
||||
'BEGIN' OUTL(I);
|
||||
'IF' I=&' 'THEN'
|
||||
'BEGIN' CHAR; OUTL(I);
|
||||
'IF' I>=&A 'AND' I<=&Z 'THEN'
|
||||
GETWORD
|
||||
'END'
|
||||
'END' 'ELSE'
|
||||
'BEGIN' OUTL(I);
|
||||
'IF' I>=&A 'AND' I<=&Z 'THEN'
|
||||
GETWORD;
|
||||
'END' ;
|
||||
'GOTO' INLOOP;
|
||||
FIN:
|
||||
'END'
|
||||
'FINISH'
|
||||
|
||||
7
RHA (Minisystems) ALGOL v55/m.bat
Normal file
7
RHA (Minisystems) ALGOL v55/m.bat
Normal file
@ -0,0 +1,7 @@
|
||||
ntvdm algol %1
|
||||
|
||||
ntvdm -c -p arun %1.OBJ
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user