Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0035/algol3.met
There are 2 other files named algol3.met in the archive. Click here to see a list.
00100	.SUBSYNTAX EXPRESSIONS
00200	
00300	.INTERNAL BOOLEX,INTEXPR,REFEXPR,STREXPR,BUILTIN
00400	.EXTERNAL ARRAYEND,ARRAYSS,SETARRAY,AC,ARGNUM,ARGCT
00500	.EXTERNAL STRSSEND,STRSTORE,SUBSTR,STRTMP,ARGGET,REFTMP
00600	.EXTERNAL BLTININT,BLTINSTR,BLTINBOOL,DEFINE,BASE,REFSTORE
00700	
00800	REFEXPR: .PEEK("NULL" .NOT(-.ID)) "NULL" .OUT("MOVEI"-"%TB,0")/
00900	 .PEEK(.ID .LOOK (.CHECK 4 SET/.CHECK 5 SET))
01000	 (.CHECK 5 SET .OUT("PUSHJ"-"%P,$"B#"."S#)/
01100	  .CHECK 6 SET %1 "(" REFEXPR ")" ^1 .LOOK .OUT("MOVE"-"%TB,$"B#"."S#"(%TB)")/
01200	  .CHECK 13 SET (.CHECK 10 SET #2"2" ARGGET /
01300	  BASE .OUT("MOVE"-"%TB,$"B#"."S#^3*)) /
01400	 .CHECK 11 SET SETARRAY "(" INTEXPR ")" #3"2" ARRAYSS ARRAYEND
01500	  .OUT("MOVE"-"%TB,(%"[*:=AC]*")") [AC:=AC-1]/
01600	 .CHECK 12 SET SETARRAY "(" INTEXPR "," #3"2" ARRAYSS INTEXPR ")"
01700	  #3"5" ARRAYSS ARRAYEND .OUT("MOVE"-"%TB,(%"[*:=AC]*")") [AC:=AC-1]);
01800	
01900	
02000	INTEXPR: TERM *("+" TERM [AC:=AC-1] .OUT("ADD"-"%"[*:=AC]*",%"[*:=AC+1]*)/
02100	 "-" TERM [AC:=AC-1] .OUT("SUB"-"%"[*:=AC]*",%"[*:=AC+1]*));
02200	
02300	TERM: PRIME *("*" PRIME [AC:=AC-1] .OUT("IMUL"-"%"[*:=AC]*",%"[*:=AC+1]*)/
02400	 "DIV" PRIME [AC:=AC-1] .OUT("IDIV"-"%"[*:=AC]*",%"[*:=AC+1]*)/
02500	 "REM" PRIME [AC:=AC-1] .OUT("IDIV"-"%"[*:=AC]*",%"[*:=AC+1]*)
02600	  .OUT("MOVE"-"%"[*:=AC]*",%"[*:=AC+1]*));
02700	
02800	PRIME: "-" PRIME .OUT("MOVN"-"%"[*:=AC]*",%"*)/ "+" PRIME / "(" INTEXPR ")"/
02900	 .PEEK("ABS" "(") INTEXPR ")" .OUT("MOVM"-"%"[*:=AC]*",%"*)/
03000	 .NUMBER %1 [AC:=AC+1] .IF(AC.LE.7)
03100	   .OUT("MOVE"-"%"[*:=AC]*",[DEC "^1*"]")/
03200	 .PEEK(.ID .LOOK .CHECK 3 SET)
03300	 (.CHECK 25 SET BLTININT/
03400	 (.CHECK 21 SET .CHECK 26 SET BASE .OUT("MOVE"-"%"[*:=AC+1]*",$"B#"."S#^3*) /
03500	 .CHECK 6 SET %1 "(" REFEXPR ")" ^1 .LOOK
03600	   .OUT("MOVE"-[*:=AC+1]"%"*",$"B#"."S#"(%TB)") .OUT("SETZ"-"%TB,")/
03700	 .CHECK 13 SET (.CHECK 10 SET
03800	  (.IF(AC.GE.0) .OUT("MOVE"-"%"[*:=AC+1]*",%0")/.EMPTY)
03900	 #2"2" ARGGET
04000	  (.IF(AC.GE.0) .OUT("EXCH"-"%"[*:=AC+1]*",%0")/.EMPTY)/
04100	 BASE .OUT("MOVE"-"%"[*:=AC+1]*",$"B#"."S#^3*) )/
04200	 .CHECK 11 SET SETARRAY %3 "(" INTEXPR ")" #3"2" ARRAYSS ARRAYEND
04300	  .OUT("MOVE"-"%"^3%3[*:=AC-*]*",(%"[*:=AC]*")") ^3[AC:=AC-1-*]/
04400	 .CHECK 12 SET SETARRAY %3 "(" INTEXPR "," #3"2" ARRAYSS INTEXPR ")"
04500	  #3"5" ARRAYSS ARRAYEND .OUT("MOVE"-"%"^3%3[*:=AC-*]*",(%"[*:=AC]*")")
04600	 ^3[AC:=AC-1-*]) [AC:=AC+1] .IF(AC.LE.7));
04700	
04800	STREXPR: STRPRIME *("CAT" STRSTORE STRPRIME STRSTORE .IF(AC.LE.3)
04900	 ^1%3^1%1 .LOOKC .OUT("HLLZ"-"%"[*:=AC+2]*",$"B#"."S#"+1(%B)") ^3%3 .LOOKC
05000	 .OUT("HLRZ"-"%"[*:=AC+4]*",%"[*:=AC+2]*) .OUT("MOVEI"-"%"[*:=AC+3]*",1")
05100	 [*:=AC+2] .OUT("ADD"-"%"*",$"B#"."S#"+1(%B)") .OUT("ANDCMI"-"%"*",777777")
05200	 [*:=AC+1] .OUT("MOVSI"-"%"*",(POINT 7,0)") .OUT("ASTRG"-"%"*) ^1 .LOOKC
05300	 .OUT("SUBST"-"%"[*:=AC+3]*",%"[*:=AC+1]*) [*:=AC+3]
05400	 .OUT("SMOVE"-"%"*",$"B#"."S#"(%B)") .OUT("HLLZS"-"%"*",$"B#"."S#"+1(%B)")
05500	 .OUT("HLRZ"-"%"*",%"*) .OUT("ADDI"-"%"*",1") ^3 .LOOKC
05600	 .OUT("HLRZ"-"%"[*:=AC+4]*",$"B#"."S#"+1(%B)")
05700	 .OUT("SUBST"-"%"[*:=AC+3]*",%"[*:=AC+1]*) .OUT("SMOVE"-"%"[*:=AC+3]*",$"B#"."S#"(%B)")
05800	 .OUT("HLLZS"-"$"B#"."S#"+1(%B)") [STRTMP:=STRTMP-2] [AC:=AC+1]);
05900	
06000	STRPRIME: .STRING [AC:=AC+1] %2 .IF(AC.LE.6)
06100	 (.IF(*L.GT.2) .OUT("MOVE"-"%"[*:=AC]*",[POINT 7,[ASCII"^2%2*"]]") /
06200	  .OUT("MOVSI"-"%"[*:=AC]*",(POINT 7,0)"))
06300	 .OUT("MOVSI"-"%"[*:=AC+1]*",^D"^2*L"-2") /
06400	 "#" -.NUMBER %1 [AC:=AC+1] .IF(AC.LE.6)
06500	  .OUT("MOVE"-"%"[*:=AC]*",[POINT 1,"*1"]")
06600	  .OUT("MOVSI"-"%"[*:=AC+1]*",^D"^1*L)
06700	  .OUT("JRST"-*2) .LABEL *1 .OUT("BITS"-*) .LABEL *2 /
06800	 .PEEK(.ID .LOOK .CHECK 1 SET) (.CHECK 25 SET BLTINSTR /
06900	  .CHECK 6 SET %1 "(" REFEXPR ")"
07000	   ("(" REFSTORE INTEXPR "," INTEXPR ")" ^1 .LOOKC [REFTMP:=REFTMP-1]
07100	    [AC:=AC-1] .OUT("MOVE"-"%,$"B#"."S#"(%B)")
07200	    .OUT("SETZM"-"$"B#"."S#"(%B)") ^1 .LOOK
07300	    .OUT("SUBST"-"%"[*:=AC]*",$"B#"."S#"(%)") /
07400	   ^1 .LOOK [AC:=AC+1] .IF(AC.LE.6)
07500	    .OUT("MOVE2"-"%"[*:=AC]*",$"B#"."S#"(%TB)")
07600	    .OUT("SETZ"-"%TB,") )/
07700	  .CHECK 13 SET ("(" %1 INTEXPR "," INTEXPR ")" [AC:=AC-1] ^1 .LOOK
07800	   (.CHECK 10 SET (.IF(AC.GE.2) .OUT("EXCH"-"%"[*:=AC]*",%0")
07900	     .OUT("EXCH"-"%"[*:=AC+1]*",%1") / .EMPTY) #2"1" ARGGET
08000	     (.IF(AC.GE.2) .OUT("EXCH"-"%"[*:=AC]*",%0")
08100	      .OUT("EXCH"-"%"[*:=AC+1]*",%1") / .EMPTY) /
08200	    BASE .OUT("SUBST"-"%"[*:=AC]*",$"B#"."S#^3*)) /
08300	   [AC:=AC+1] .IF(AC.LE.6)
08400	   (.CHECK 10 SET (.IF(AC.GE.2) .OUT("MOVE2"-"%"[*:=AC]*",%0")
08500	    /.EMPTY) #2"2" ARGGET (.IF(AC.GE.2)
08600	    .OUT("EXCH"-"%"[*:=AC]*",%0")
08700	    .OUT("EXCH"-"%"[*:=AC+1]*",%1") / .EMPTY) /
08800	    BASE .OUT("MOVE2"-"%"[*:=AC]*",$"B#"."S#^3*) ) )/
08900	  (.CHECK 11 SET %1 [AC:=AC+1] .IF(AC.LE.6) .OUT("SETZ"-"%"[*:=AC]*",")
09000	    "(" INTEXPR ")" #3"2" ARRAYSS /
09100	   .CHECK 12 SET %1 [AC:=AC+1] .IF(AC.LE.6) .OUT("SETZ"-"%"[*:=AC]*",")
09200	    "(" INTEXPR "," #3"2" ARRAYSS INTEXPR #3"5" ARRAYSS ")")
09300	  ("(" [AC:=AC+1] INTEXPR "," INTEXPR ")" [AC:=AC-3] STRSSEND
09400	   .OUT("SUBST"-"%"[*:=AC+2]*",%"[*:=AC]*)
09500	   .OUT("MOVE2"-"%"*",%"[*:=AC+2]*) / STRSSEND) );
09600	
09700	BOOLEX: BOOLTM *("OR" BOOLTM [AC:=AC-1]
09800	 .OUT("OR"-"%"[*:=AC]*",%"[*:=AC+1]*));
09900	
10000	BOOLTM: BOOLPR *("AND" BOOLPR [AC:=AC-1]
10100	 .OUT("AND"-"%"[*:=AC]*",%"[*:=AC+1]*));
10200	
10300	BOOLPR: .PEEK("NOT" .NOT(-.ID)) "NOT" BOOLPR .OUT("SETCMM"-"%"[*:=AC]*)/
10400	 .PEEK(.ID .LOOK .CHECK 35 SET) .CHECK 25 SET BLTINBOOL /
10500	 INTEXPR ("EQL" INTEXPR [AC:=AC-1]
10600	  .OUT("CAME"-"%"[*:=AC]*",%"[*:=AC+1]*)/
10700	  "NEQ" INTEXPR [AC:=AC-1] .OUT("CAMN"-"%"[*:=AC]*",%"[*:=AC+1]*)/
10800	  "LSS" INTEXPR [AC:=AC-1] .OUT("CAML"-"%"[*:=AC]*",%"[*:=AC+1]*)/
10900	  "LEQ" INTEXPR [AC:=AC-1] .OUT("CAMLE"-"%"[*:=AC]*",%"[*:=AC+1]*)/
11000	  "GTR" INTEXPR [AC:=AC-1] .OUT("CAMG"-"%"[*:=AC]*",%"[*:=AC+1]*)/
11100	  "GEQ" INTEXPR [AC:=AC-1] .OUT("CAMGE"-"%"[*:=AC]*",%"[*:=AC+1]*))
11200	  .OUT("TLZA"-"%"[*:=AC]*",777777") .OUT("TLO"-"%"*",777777")/
11300	 REFEXPR ("IS" .ID .LOOK .CHECK 5 SET [AC:=AC+1] .IF(AC.LE.7)
11400	  .OUT("IS"-"%TB,$"B#"$"S#) .OUT("TLZA"-"%"[*:=AC]*",777777")
11500	  .OUT("TLO"-"%"*",777777") .OUT("SETZ"-"%TB,")/
11600	  "EQL" REFSTORE REFEXPR ^1 .LOOKC [AC:=AC+1] .IF(AC.LE.7) [REFTMP:=REFTMP-1]
11700	  .OUT("CAME"-"%TB,$"B#"."S#"(%B)") .OUT("TLZA"-"%"[*:=AC]*",777777")
11800	  .OUT("TLO"-"%"*",777777") .OUT("SETZB"-"%TB,$"B#"."S#"(%B)")/
11900	  "NEQ" REFSTORE REFEXPR ^1 .LOOKC [AC:=AC+1] .IF(AC.LE.7) [REFTMP:=REFTMP-1]
12000	  .OUT("CAMN"-"%TB,$"B#"."S#"(%B)") .OUT("TLZA"-"%"[*:=AC]*",777777")
12100	  .OUT("TLO"-"%"*",777777") .OUT("SETZB"-"%TB,$"B#"."S#"(%B)"))/
12200	 .PEEK((.ID .LOOK .CHECK 1 SET/.STRING) .NOT(.IF(1.EQ.2)))
12300	 [*:=AC] %2 [AC:=(AC+2)/2*2-1] STREXPR STRSTORE
12400	 ("EQL" STREXPR ^1 .LOOKC .OUT("CSTER"-"%"[*:=AC]*",$"B#"."S#"(%B)")/
12500	 "NEQ" STREXPR ^1 .LOOKC .OUT("CSTNR"-"%"[*:=AC]*",$"B#"."S#"(%B)")/
12600	 "LSS" STREXPR ^1 .LOOKC .OUT("CSTLR"-"%"[*:=AC]*",$"B#"."S#"(%B)")/
12700	 "LEQ" STREXPR ^1 .LOOKC .OUT("CSTLER"-"%"[*:=AC]*",$"B#"."S#"(%B)")/
12800	 "GTR" STREXPR ^1 .LOOKC .OUT("CSTGR"-"%"[*:=AC]*",$"B#"."S#"(%B)")/
12900	 "GEQ" STREXPR ^1 .LOOKC .OUT("CSTGER"-"%"[*:=AC]*",$"B#"."S#"(%B)"))
13000	 ^2 [AC:=*+1] .OUT("TLZA"-"%"[*:=AC]*",777777") .OUT("TLO"-"%"*",777777")
13100	 .OUT("HLLZS"-"$"B#"."S#"+1(%B)") [STRTMP:=STRTMP-1];
13200	
13300	SETIN: ^1 .ENTERC .SET 25;
13400	
13500	BUILTIN: DEFINE #1"%RUN" ^1 .ENTERC
13600	 #1"ENTRY" SETIN .SET 35 .SET 26
13700	 #1"ENDFILE" SETIN .SET 35 .SET 27
13800	 #1"OPEN" SETIN .SET 35 .SET 28
13900	 #1"ERROR" SETIN .SET 9 .SET 26
14000	 #1"OUTSTRING" SETIN .SET 9 .SET 27
14100	 #1"OUTBITS" SETIN .SET 9 .SET 27
14200	 #1"OPENIN" SETIN .SET 9 .SET 28
14300	 #1"OPENOUT" SETIN .SET 9 .SET 29
14400	 #1"CLOSE" SETIN .SET 9 .SET 30
14500	 #1"SETBREAK" SETIN .SET 9 .SET 31
14600	 #1"OUTLINE" SETIN .SET 9 .SET 32
14700	 #1"SLEEP" SETIN .SET 9 .SET 33
14800	 #1"RUN" SETIN .SET 9 .SET 34
14900	 #1"LINENO" SETIN .SET 3 .SET 26
15000	 #1"LENGTH" SETIN .SET 3 .SET 27
15100	 #1"STRINT" SETIN .SET 3 .SET 28
15200	 #1"STATUS" SETIN .SET 3 .SET 29
15300	 #1"BITINT" SETIN .SET 3 .SET 30
15400	 #1"DATE" SETIN .SET 3 .SET 31
15500	 #1"MSTIME" SETIN .SET 3 .SET 32
15600	 #1"RUNTIME" SETIN .SET 3 .SET 33
15700	 #1"JOBNO" SETIN .SET 3 .SET 34
15800	 #1"PROJPROG" SETIN .SET 3
15900	 #1"BREAK" SETIN .SET 1 .SET 2 .SET 26
16000	 #1"BITSTR" SETIN .SET 1 .SET 2 .SET 27
16100	 #1"STRBIT" SETIN .SET 1 .SET 2 .SET 24 .SET 28
16200	 #1"INTBIT" SETIN .SET 1 .SET 2 .SET 24 .SET 29
16300	 #1"INSTRING" SETIN .SET 1 .SET 2 .SET 30
16400	 #1"INTSTR" SETIN .SET 1 .SET 2 .SET 31
16500	 #1"INBITS" SETIN .SET 1 .SET 2 .SET 24 .SET 32
16600	 #1"BLANKS" SETIN .SET 1 .SET 2 .SET 33
16700	 #1"ZEROES" SETIN .SET 1 .SET 2 .SET 24 .SET 34
16800	 #1"COPYSTRING" SETIN .SET 1 .SET 2
16900	 #1"COPYBITS" SETIN .SET 1 .SET 2 .SET 24;
17000	
17100	.END