From 9596d2c6968c9cac1ec33cdec9f2cd5d577c90c3 Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Mon, 2 Sep 2024 18:36:55 +0000 Subject: [PATCH 1/8] Add language support for Simula --- .gitmodules | 3 + grammars.yml | 2 + lib/linguist/languages.yml | 12 ++ samples/Simula/BottlesOfBeer.sim | 17 +++ samples/Simula/TicTacToe.sim | 108 ++++++++++++++++++ vendor/grammars/vscode-simula | 1 + .../git_submodule/vscode-simula.dep.yml | 17 +++ 7 files changed, 160 insertions(+) create mode 100644 samples/Simula/BottlesOfBeer.sim create mode 100644 samples/Simula/TicTacToe.sim create mode 160000 vendor/grammars/vscode-simula create mode 100644 vendor/licenses/git_submodule/vscode-simula.dep.yml diff --git a/.gitmodules b/.gitmodules index 7e22d7ba2e..6e4d6ae382 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1371,6 +1371,9 @@ [submodule "vendor/grammars/vscode-scala-syntax"] path = vendor/grammars/vscode-scala-syntax url = https://github.com/scala/vscode-scala-syntax +[submodule "vendor/grammars/vscode-simula"] + path = vendor/grammars/vscode-simula + url = https://github.com/eirslett/vscode-simula.git [submodule "vendor/grammars/vscode-singularity"] path = vendor/grammars/vscode-singularity url = https://github.com/onnovalkering/vscode-singularity diff --git a/grammars.yml b/grammars.yml index 4a05ec7ead..fbddfefb74 100644 --- a/grammars.yml +++ b/grammars.yml @@ -1234,6 +1234,8 @@ vendor/grammars/vscode-ron: - source.ron vendor/grammars/vscode-scala-syntax: - source.scala +vendor/grammars/vscode-simula: +- source.sim vendor/grammars/vscode-singularity: - source.singularity vendor/grammars/vscode-slice: diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 9bde77235a..2b359d4b02 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -6821,6 +6821,18 @@ Simple File Verification: codemirror_mode: properties codemirror_mime_type: text/x-properties language_id: 735623761 +Simula: + type: programming + color: "#B22F2F" + extensions: + - ".sim" + aliases: + - sim + tm_scope: source.simula + ace_mode: simula + codemirror_mode: simula + codemirror_mime_type: text/x-simula + language_id: 582204041 Singularity: type: programming color: "#64E6AD" diff --git a/samples/Simula/BottlesOfBeer.sim b/samples/Simula/BottlesOfBeer.sim new file mode 100644 index 0000000000..13d15325f2 --- /dev/null +++ b/samples/Simula/BottlesOfBeer.sim @@ -0,0 +1,17 @@ +! License: MIT; +begin + integer i; + for i := 99 step -1 until 1 do + begin + outint(i, 2); + outtext(" bottles of beer on the wall, "); + outint(i, 2); + outtext(" bottles of beer."); + outimage; + outtext("Take one down and pass it around, "); + outint(i - 1, 2); + outtext(" bottles of beer on the wall."); + outimage; + end; + outtext("No more bottles of beer on the wall, no more bottles of beer."); +end-let's-drink; diff --git a/samples/Simula/TicTacToe.sim b/samples/Simula/TicTacToe.sim new file mode 100644 index 0000000000..6de5d0b671 --- /dev/null +++ b/samples/Simula/TicTacToe.sim @@ -0,0 +1,108 @@ +! A simple Tic-Tac-Toe game. License: MIT; +begin + ref(TicTacToe) game; + character player; + + class TicTacToe; + begin + character array board(1:9); + + procedure placeMark(mark, position); + value mark, position; + character mark; integer position; + begin + board(position) := mark; + end-of-place-mark; + + boolean procedure checkWinner(player); + value player; + character player; + begin + integer position; + comment + There are 8 possible ways to win: 3 rows, 3 columns, and 2 diagonals. + For reasons of laziness, we just AI-generate them: + ; + if board(1) = player and board(2) = player and board(3) = player then + checkWinner := true + else if board(4) = player and board(5) = player and board(6) = player then + checkWinner := true + else if board(7) = player and board(8) = player and board(9) = player then + checkWinner := true + else if board(1) = player and board(4) = player and board(7) = player then + checkWinner := true + else if board(2) = player and board(5) = player and board(8) = player then + checkWinner := true + else if board(3) = player and board(6) = player and board(9) = player then + checkWinner := true + else if board(1) = player and board(5) = player and board(9) = player then + checkWinner := true + else if board(3) = player and board(5) = player and board(7) = player then + checkWinner := true + else + checkWinner := false; + end-of-checkWinner; + + character procedure winner; + begin + if checkWinner('X') then winner := 'X' + else if checkWinner('O') then winner := 'O' + else winner := ' '; + end-of-winner; + + procedure DrawTopBottom; begin + OutText("+---+---+---+"); + OutImage; + end; + + procedure draw; + begin + integer row; + OutImage; + DrawTopBottom; + for row := 0 step 1 until 2 do begin + OutText("| " ); + OutChar(board(row * 3 + 1)); + OutText(" | " ); + OutChar(board(row * 3 + 2)); + OutText(" | " ); + OutChar(board(row * 3 + 3)); + OutText(" |"); + OutImage; + DrawTopBottom; + end + end-of-draw; + + !populate the board with number placeholders; + board(1) := '1'; + board(2) := '2'; + board(3) := '3'; + board(4) := '4'; + board(5) := '5'; + board(6) := '6'; + board(7) := '7'; + board(8) := '8'; + board(9) := '9'; + end-of-TicTacToe; + + + game :- new TicTacToe; + player := 'X'; + + while game.winner <> 'X' and game.winner <> 'O' do + begin + game.draw; + OutText("Player "); + OutChar(player); + OutText(" enter position: "); + OutImage; + game.placeMark(player, InInt); + if player = 'X' then player := 'O' else player := 'X'; + end; + + game.draw; + + OutText("The winner is: player "); + OutChar(game.winner); + OutImage; +end-of-program diff --git a/vendor/grammars/vscode-simula b/vendor/grammars/vscode-simula new file mode 160000 index 0000000000..3e5aa76da7 --- /dev/null +++ b/vendor/grammars/vscode-simula @@ -0,0 +1 @@ +Subproject commit 3e5aa76da7f6c4145b665fa7497249b2353ea087 diff --git a/vendor/licenses/git_submodule/vscode-simula.dep.yml b/vendor/licenses/git_submodule/vscode-simula.dep.yml new file mode 100644 index 0000000000..47342717cd --- /dev/null +++ b/vendor/licenses/git_submodule/vscode-simula.dep.yml @@ -0,0 +1,17 @@ +--- +name: vscode-simula +version: 3e5aa76da7f6c4145b665fa7497249b2353ea087 +type: git_submodule +homepage: https://github.com/eirslett/vscode-simula.git +license: mit +licenses: +- sources: LICENSE.md + text: | + Copyright 2024 Project contributors + + Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +notices: [] From c72b594007bf35ad1c412df27aad8ac4ef49e62f Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Wed, 4 Sep 2024 20:10:17 +0000 Subject: [PATCH 2/8] Makefile.sim should be considered a Makefile --- lib/linguist/languages.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 2b359d4b02..8f3bbb74ad 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -4204,6 +4204,7 @@ Makefile: - Makefile.frag - Makefile.in - Makefile.inc + - Makefile.sim - Makefile.wat - makefile - makefile.sco From 886696359b654f0fc968d4de3cc35a3b75788c32 Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Wed, 4 Sep 2024 20:10:38 +0000 Subject: [PATCH 3/8] Dockerfile.sim should be considered a Dockerfile --- lib/linguist/languages.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 8f3bbb74ad..3835226985 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -1635,6 +1635,7 @@ Dockerfile: filenames: - Containerfile - Dockerfile + - Dockerfile.sim ace_mode: dockerfile codemirror_mode: dockerfile codemirror_mime_type: text/x-dockerfile From 9ad6c22034395fcff767915bf7790a92b47e087a Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Wed, 4 Sep 2024 20:38:14 +0000 Subject: [PATCH 4/8] All .sim files starting with [ or { are considered some form of JSON or YAML --- lib/linguist/heuristics.yml | 6 ++++++ lib/linguist/languages.yml | 1 + 2 files changed, 7 insertions(+) diff --git a/lib/linguist/heuristics.yml b/lib/linguist/heuristics.yml index 67891bd2ab..e95cde29d2 100644 --- a/lib/linguist/heuristics.yml +++ b/lib/linguist/heuristics.yml @@ -697,6 +697,12 @@ disambiguations: - language: Markdown # Markdown syntax for scdoc pattern: '^#+\s+(NAME|SYNOPSIS|DESCRIPTION)' +- extensions: ['.sim'] + rules: + - language: Simula + pattern: '(?i)\bbegin\b.*?\bend\b' + - language: YAML + pattern: '^[\{\[]' - extensions: ['.sol'] rules: - language: Solidity diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 3835226985..484b31ea21 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -8259,6 +8259,7 @@ YAML: - ".mir" - ".reek" - ".rviz" + - ".sim" - ".sublime-syntax" - ".syntax" - ".yaml" From 2f3e19213703eb98d27bb672340bf0238dc208a6 Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Mon, 25 Nov 2024 22:52:07 +0100 Subject: [PATCH 5/8] Add more Simula code samples --- samples/Simula/deasm.sim | 642 +++++++++ samples/Simula/demos.sim | 2628 +++++++++++++++++++++++++++++++++++++ samples/Simula/klant1.sim | 29 + samples/Simula/klant4.sim | 67 + samples/Simula/powers.sim | 91 ++ 5 files changed, 3457 insertions(+) create mode 100644 samples/Simula/deasm.sim create mode 100644 samples/Simula/demos.sim create mode 100644 samples/Simula/klant1.sim create mode 100644 samples/Simula/klant4.sim create mode 100644 samples/Simula/powers.sim diff --git a/samples/Simula/deasm.sim b/samples/Simula/deasm.sim new file mode 100644 index 0000000000..2d6e23f6e1 --- /dev/null +++ b/samples/Simula/deasm.sim @@ -0,0 +1,642 @@ +comment License: program borrowed from S-PORT https://github.com/portablesimula/S-PORT; +begin Boolean Listing; ! Output Listing Indicator ; + Ref(InByteFile) Inpt; ! NRF-Input File ; + Ref(OutFile) Oupt; ! Created Output File ; + + Text array Names(1:100); ! Global Name Table ; + Integer nnam; ! Table length ; + + Ref(SEGDEF) array Seg(1:100); ! Global Segment Table ; + Integer nseg; ! Table length ; + + Ref(GRPDEF) array Grp(1:100); ! Global Group Table ; + Integer ngrp; ! Table length ; + + Ref(EXTDEF) array Ext(1:100); ! Global External Table ; + Integer next; ! Table length ; + + Ref(Thread) array ImpTarget(0:3); ! Implicit Target Table ; + Ref(Thread) array ImpFrame(0:3); ! Implicit Frame Table ; + + Integer CurSeg; ! Current Segment Index ; + Integer CurOfst; ! Current Segment Offset ; + + Integer Sequ; ! Input byte number ; + Integer Lng; ! Length of current record ; + Integer ChkSum; ! Check-sum of current record ; + Integer Start; ! Start byte number ; + Integer Count; ! Count byte number ; + Integer Code; ! Current Record Code ; + + Class Thread(Code,Val); integer Code,Val; + begin end; + +%page + Text Procedure Prompt(ms,meny); value ms,meny; text ms,meny; + begin text R; L: OutText(Cat(ms,": ")); BreakOutImage; inimage; + R:-SysIn.image.strip; R.SetPos(R.length); + if if R==notext then true else R.GetChar='?' then + begin OutText("Input Format: "); OutText(meny); + OutImage; goto L; + end; Prompt:-copy(R); SysIn.SetPos(SysIn.length+1); + OutText(R); OutImage; + end *** Prompt ***; + + Procedure InputFile; + begin text F; S: F:-Prompt("Input File","Standard NORD File Format"); + F:-Cat(F,":OBJ"); Inpt:-new InByteFile(F); + if not Inpt.Open then + begin OutImage; OutText("The File """); OutText(F); + OutText(""" does not exist or is not accessible"); + OutImage; OutImage; goto S; + end; + end; + + Procedure OutputFile; + begin text F; S: F:-Prompt("Output File","Standard NORD File Format"); + if F="TERM" then Oupt:-SysOut else + begin F:-Cat(F,":SYMB"); Oupt:-new OutFile(F); + if not Oupt.Open(Blanks(100)) then + begin OutImage; OutText("The File """); OutText(F); + OutText(""" does not exist or is not accessible"); + OutImage; OutImage; goto S; + end; + end; + end; + + Procedure ERROR(msg); value msg; text msg; + begin OutImage; OutText("Byte"); OutInt(Sequ,6); + OutText(": ***ERROR*** "); OutText(msg); OutImage; + end; + + Text Procedure Cat(t1,t2); value t1,t2; text t1,t2; + begin text t; Cat:-t:-Blanks(t1.length+t2.length); + t:=t1; t.Sub(t1.length+1,t2.length):=t2; + end *** Cat ***; + +%page + + Integer Procedure InByte; + begin integer n; InByte:=n:=Inpt.InByte; + Lng:=Lng-1; Sequ:=Sequ+1; + ChkSum:=mod(ChkSum+n,256); + end; + + Procedure OutByte(n); integer n; inspect Oupt do + begin integer a,b,c; a:=n//64; + b:=mod(n,64)//8; c:=mod(n,8); + OutChar(' '); OutInt(a,1); OutInt(b,1); OutInt(c,1); + end; + + Procedure PrtInt(n); integer n; + begin if n<10 then Oupt.OutInt(n,1) + else if n<100 then Oupt.OutInt(n,2) + else if n<1000 then Oupt.OutInt(n,3) + else if n<10000 then Oupt.OutInt(n,4) + else if n<100000 then Oupt.OutInt(n,5) + else Oupt.OutInt(n,12) + end; + + Procedure PrtNam(n); integer n; + begin if n>0 and n<=nnam then Oupt.OutText(Names(n)) + else Oupt.OutText("????"); + end; + + Procedure PrtSeg(n); integer n; + begin Oupt.OutText("Seg"); PrtInt(n); Oupt.OutChar(':'); + if n>0 and n<=nseg then PrtNam(Seg(n).SegmentNameIndex) + else Oupt.OutText("????"); + end; + + Procedure PrtGrp(n); integer n; + begin Oupt.OutText("Grp"); PrtInt(n); Oupt.OutChar(':'); + if n>0 and n<=ngrp then PrtNam(Grp(n).GroupNameIndex) + else Oupt.OutText("????"); + end; + + Procedure PrtExt(n); integer n; + begin Oupt.OutText("Ext"); PrtInt(n); Oupt.OutChar(':'); + if n>0 and n<=next then Oupt.OutText(Ext(n).ExternalName) + else Oupt.OutText("????"); + end; + + Procedure PrtIdent(Code,Val); integer Code,Val; + begin if Code=0 then PrtSeg(Val) + else if Code=1 then PrtGrp(Val) + else if Code=2 then PrtExt(Val) + else if Code=3 then begin Oupt.OutText("Abs:"); PrtInt(Val) end + else begin Oupt.OutText("????:"); PrtInt(Code); + Oupt.OutChar(':'); PrtInt(Val); + end; + end; + +%page + + Integer Procedure ScanByte(id); text id; + begin integer n; n:=InByte; + Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); + OutByte(n); ScanByte:=n; + end; + + Procedure ScanBytes(id,n); text id; integer n; + begin Oupt.OutImage; Oupt.SetPos(19); Oupt.OutText(id); + for n:=n-1 while n >= 0 do + begin if Oupt.Pos > 63 then + begin Oupt.OutImage; Oupt.SetPos(24) end; + OutByte(InByte); + end; + end; + + Integer Procedure ScanIndex(id); text id; + begin integer n; n:=InByte; + Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); + if n>127 then n:=(n-128)*256+InByte; + OutByte(n); ScanIndex:=n; + end; + + Text Procedure ScanName(id); text id; + begin integer n; text t; character c; n:=InByte; + Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); + ScanName:-t:-blanks(n); + for n:=n-1 while n>=0 do + begin c:=Char(InByte); OutChar(c); t.PutChar(c) end; + end; + + Integer Procedure ScanWord(id); text id; + begin integer n; n:=InByte; n:=InByte*256+n; + Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); + PrtInt(n); ScanWord:=n; + end; + + Procedure ScanChk; + begin if Lng > 1 then ScanBytes("Tail:",Lng-1); InByte; + if ChkSum <> 0 then ERROR("Check-Sum Error"); + ChkSum:=0; + end; +%title *** L o g i c a l A d d r e s s *** + + Class LogicalAddr; + begin integer n,F,FRAME,T,P,TARGT,FDAT,TDAT,TDIS; + if Lng<2 then begin ERROR("LogicalAddr-1"); goto E end; + Oupt.OutImage; Oupt.SetPos(18); + n:=InByte; TARGT:=mod(n,4); n:=n//4; + P:=mod(n,2); n:=n//2; T:=mod(n,2); n:=n//2; + FRAME:=mod(n,8); F:=n//8; + Oupt.OutText(" ADDRESS'); + end; + + Procedure PrtAddr(x); ref(LogicalAddr) x; inspect x do + begin ref(Thread) ThT,ThF; + if T=0 then PrtIdent(TARGT,TDAT) + else begin ThT:-ImpTarget(TARGT); PrtIdent(ThT.Code,ThT.Val) end; + if P=0 then begin Oupt.OutChar('+'); PrtInt(TDIS) end; + Oupt.OutText("(in "); + if F=1 then + begin ThF:-ImpFrame(FRAME); PrtIdent(ThF.Code,ThF.Val) end + else begin if FRAME<4 then PrtIdent(FRAME,FDAT) + else if FRAME=4 then PrtIdent(0,CurSeg) + else if FRAME=5 then + begin if T=1 then PrtIdent(ThT.Code,ThT.Val) + else PrtIdent(TARGT,TDAT); + end + else if FRAME=6 then Oupt.OutText("none") + else Oupt.OutText("????"); + end; + Oupt.OutChar(')'); + end; +%title *************************** + + Procedure THEADR; + begin Lng:=ScanWord("THEADR=80H Lng"); + ScanName("ModuleName"); + end; + + Procedure MODEND; + begin integer n,Mattr,L; ref(LogicalAddr) adr; + Lng:=ScanWord("MODEND=8AH Lng"); + n:=InByte; Mattr:=n//64; L:=mod(n,2); + OutText(" ModuleType:"); PrtInt(Mattr); + OutText(" L:"); PrtInt(L); + if Mattr=1 or Mattr=3 then + begin !*** Start Address ***; + if L=1 then + begin adr:-new LogicalAddr; + Oupt.OutImage; Oupt.SetPos(18); + Oupt.OutText("Start Address: "); PrtAddr(adr); + end + else begin if Lng<5 then begin ERROR("MODEND"); goto E end; + ScanWord("FrameNumber"); + ScanWord("Offset"); + end; + end; + E:end; + + Procedure LNAMES; + begin Lng:=ScanWord("LNAMES=96H Lng"); + while Lng > 1 do + begin if Oupt.Pos > 60 then + begin Oupt.OutImage; Oupt.SetPos(18) end; + nnam:=nnam+1; Names(nnam):-ScanName("Name"); + end; + end; +%page + + Class SEGDEF; + begin integer n,A,C,B,P; + integer FrameNumber,Offset,LTL,MaxLng,SegLng; + integer SegmentNameIndex,ClassNameIndex,OverlayNameIndex; + Lng:=ScanWord("SEGDEF=98H Lng"); + n:=InByte; P:=mod(n,2); n:=n//2; + B:=mod(n,2); n:=n//2; c:=mod(n,8); A:=n//8; + OutText(" A:"); Prtint(A); OutText(" C:"); Prtint(C); + OutText(" B:"); Prtint(B); OutText(" P:"); Prtint(P); + if A=0 or A=5 then + begin Oupt.OutImage; Oupt.SetPos(18); + FrameNumber:=ScanWord("FrameNumber"); + Offset:=ScanByte("Offset"); + end + else if A=6 then + begin Oupt.OutImage; Oupt.SetPos(18); + LTL:=ScanByte("LTL"); + MaxLng:=ScanWord("MaxSegmentLength"); + Offset:=ScanWord("GroupOffset"); + end; + SegLng:=ScanWord("SegmentLength"); + if Lng>1 then + begin Oupt.OutImage; Oupt.SetPos(18); + SegmentNameIndex:=ScanIndex("SegmentNameIndex"); + if Lng>1 then ClassNameIndex:=ScanIndex("ClassNameIndex"); + if Lng>1 then OverlayNameIndex:=ScanIndex("OverlayNameIndex"); + end; + nseg:=nseg+1; Seg(nseg):-this SEGDEF; + end; + + Class GRPDEF; + begin integer GroupNameIndex; + Lng:=ScanWord("GRPDEF=9AH Lng"); + GroupNameIndex:=ScanIndex("GroupNameIndex"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + ngrp:=ngrp+1; Grp(ngrp):-this GRPDEF; + end; + + Class EXTDEF; + begin text ExternalName; integer TypeIndex; + Lng:=ScanWord("EXTDEF=8CH Lng"); + while Lng > 2 do + begin ExternalName:-ScanName("ExternalName"); + TypeIndex:=ScanIndex("TypeIndex"); + end; + next:=next+1; Ext(next):-this EXTDEF; + end; + + Procedure PUBDEF; + begin integer grp,seg; Lng:=ScanWord("PUBDEF=90H Lng"); + grp:=ScanIndex("GroupIndex"); + seg:=ScanIndex("SegmentIndex"); + if seg=0 then ScanWord("FrameNumber"); + while Lng > 2 do + begin Oupt.OutImage; Oupt.SetPos(18); + ScanName("PublicName"); + ScanWord("PublicOffset"); + ScanIndex("TypeIndex"); + end; + end; +%page + + Procedure LIDATA; + begin + Procedure ScanBlock; + begin integer rep,blk,n; + Oupt.OutImage; Oupt.SetPos(18); + rep:=ScanWord("RepeatCount"); + blk:=ScanWord("BlockCount"); + if blk = 0 then + begin if Lng < 2 then + begin ERROR("ScanBlock-1"); goto F end; + n:=InByte; + if n >= Lng then + begin ERROR("ScanBlock-2"); n:=Lng-1 end; + ScanBytes("Data:",n); + end + else for blk:=blk-1 while blk >= 0 do ScanBlock; + end; + + Lng:=ScanWord("LIDATA=A2H Lng"); + CurSeg:=ScanIndex("SegmentIndex"); + CurOfst:=ScanWord("IteratedDataOffset"); + while Lng > 2 do ScanBlock; + F:end; + + Procedure LEDATA; + begin Lng:=ScanWord("LEDATA=A0H Lng"); + CurSeg:=ScanIndex("SegmentIndex"); + CurOfst:=ScanWord("DataOffset"); + ScanBytes("Data:",Lng-1); + end; +%title *** F I X U P P *** + Procedure FIXUPP; + begin integer n; Lng:=ScanWord("FIXUPP=9CH Lng"); + while Lng > 1 do + begin n:=inbyte; Oupt.OutImage; Oupt.SetPos(18); + if n < 128 then + begin integer D,Z,METHOD,THRED,Val; !*** THREAD ***; + THRED:=mod(n,4); n:=n//4; + METHOD:=mod(n,8); n:=n//8; + Z:=mod(n,2); D:=n//2; + Oupt.OutText(" THREAD D:"); PrtInt(D); + Oupt.OutText(" Z:"); PrtInt(Z); + Oupt.OutText(" METHOD:"); PrtInt(METHOD); + Oupt.OutText(" THRED:"); PrtInt(THRED); + if D*METHOD < 4 then + begin if Lng < 2 then + begin ERROR("THREAD-1"); goto E end; + if METHOD=0 then Val:=ScanIndex("SegmentIndex") + else if METHOD=1 then Val:=ScanIndex("GroupIndex") + else if METHOD=2 then Val:=ScanIndex("ExternalIndex") + else begin if Lng < 3 then + begin ERROR("THREAD-2"); goto E end; + Val:=ScanWord("FrameNumber"); + end; + end; + if D=1 then ImpFrame(THRED):-new Thread(METHOD,Val) + else ImpTarget(THRED):-new Thread(METHOD,Val); + end + else begin integer M,S,LOC,OFST; !*** FIXUPP ***; + ref(LogicalAddr) adr; + if Lng<2 then begin ERROR("FIXUPP"); goto E end; + OFST:=mod(n,4)*256 + InByte; n:=n//4; + LOC:=mod(n,8); n:=n//8; + S:=mod(n,2); n:=n//2; M:=mod(n,2); + Oupt.OutText(" FIXUPP M:"); PrtInt(M); + Oupt.OutText(" S:"); PrtInt(S); + Oupt.OutText(" LOC:"); PrtInt(LOC); + Oupt.OutText(" OFFSET:"); PrtInt(OFST); + adr:-new LogicalAddr; + Oupt.OutImage; Oupt.SetPos(18); + if LOC=0 then Oupt.OutText("LowByte(") + else if LOC=1 then Oupt.OutText("Offset(") + else if LOC=2 then Oupt.OutText("Base(") + else if LOC=3 then Oupt.OutText("Pointer(") + else if LOC=4 then Oupt.OutText("HighByte(") + else Oupt.OutText("????("); + PrtSeg(CurSeg); Oupt.OutChar('+'); + PrtInt(CurOfst+OFST); Oupt.OutText(") <= "); + if M=0 then Oupt.OutText("Self") + else Oupt.OutText("Segm"); + Oupt.OutText("Rel <= "); PrtAddr(adr); + end; + end; + E:end; +%title + + Procedure COMENT; + begin integer n,NP,NL,ZZ,CLS; + Lng:=ScanWord("COMENT=88H Lng"); + n:=InByte; ZZ:=mod(n,64); n:=n//64; + NL:=mod(n,2); NP:=n//2; CLS:=InByte; + OutText(" NP:"); PrtInt(NP); + OutText(" NL:"); PrtInt(NL); + OutText(" ZZ:"); PrtInt(ZZ); + OutText(" CLASS:"); PrtInt(CLS); + end; + + Procedure TYPDEF; + begin Lng:=ScanWord("TYPDEF=8EH Lng"); + ScanName("Link86Name"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure RHEADR; + begin Lng:=ScanWord("RHEADR=6EH Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure REGINT; + begin Lng:=ScanWord("REGINT=70H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure REDATA; + begin Lng:=ScanWord("REDATA=72H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure RIDATA; + begin Lng:=ScanWord("RIDATA=74H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure OVLDEF; + begin Lng:=ScanWord("OVLDEF=76H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure ENDREC; + begin Lng:=ScanWord("ENDREC=78H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure BLKDEF; + begin Lng:=ScanWord("BLKDEF=7AH Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure BLKEND; + begin Lng:=ScanWord("BLKEND=7CH Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure DEBSYM; + begin Lng:=ScanWord("DEBSYM=7EH Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure LHEADR; + begin Lng:=ScanWord("LHEADR=82H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure PEDATA; + begin Lng:=ScanWord("PEDATA=84H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure PIDATA; + begin Lng:=ScanWord("PIDATA=86H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure LOCSYM; + begin Lng:=ScanWord("LOCSYM=92H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure LINNUM; + begin Lng:=ScanWord("LINNUM=94H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure LIBHED; + begin Lng:=ScanWord("LIBHED=A4H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure LIBNAM; + begin Lng:=ScanWord("LIBNAM=A6H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure LIBLOC; + begin Lng:=ScanWord("LIBLOC=A8H Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; + + Procedure LIBDIC; + begin Lng:=ScanWord("LIBDIC=AAH Lng"); + + ! ... MERE SENERE ... ; + ! ... MERE SENERE ... ; + + end; +%title *** M O N I T O R *** + + OutText("OBJECT CODE ANALYZER - 8086/80286"); + OutImage; OutImage; InputFile; OutputFile; + Start:=Prompt("Start Byte","0,1, ...").GetInt; + Count:=Prompt("Item Count","1,2, ...").GetInt; + +NESTE: + if Listing then Oupt.OutImage else + begin Oupt.SetPos(1); Oupt.image:=notext end; + + Code:=InByte; if Inpt.EndFile then goto FERDIG; + if Listing then + begin Count:=Count-1; + if Count < 1 then + begin Count:=Prompt("Item Count","0,1,2, ...").GetInt; + if Count <= 0 then goto FERDIG; + end; + end else Listing := Sequ >= Start; + Oupt.OutInt(Sequ,4); Oupt.OutText(": "); + + if Code=110 then RHEADR + else if Code=112 then REGINT + else if Code=114 then REDATA + else if Code=116 then RIDATA + else if Code=118 then OVLDEF + else if Code=120 then ENDREC + else if Code=122 then BLKDEF + else if Code=124 then BLKEND + else if Code=126 then DEBSYM + else if Code=128 then THEADR + else if Code=130 then LHEADR + else if Code=132 then PEDATA + else if Code=134 then PIDATA + else if Code=136 then COMENT + else if Code=138 then MODEND + else if Code=140 then new EXTDEF + else if Code=142 then TYPDEF + else if Code=144 then PUBDEF + else if Code=146 then LOCSYM + else if Code=148 then LINNUM + else if Code=150 then LNAMES + else if Code=152 then new SEGDEF + else if Code=154 then new GRPDEF + else if Code=156 then FIXUPP + + else if Code=160 then LEDATA + else if Code=162 then LIDATA + else if Code=164 then LIBHED + else if Code=166 then LIBNAM + else if Code=168 then LIBLOC + else if Code=170 then LIBDIC + else begin OutText("**RecType: "); PrtInt(Code); + Lng:=ScanWord("Lng"); + end; + ScanChk; goto NESTE; + +FERDIG: + + if Oupt =/= SysOut then Oupt.Close; + Inpt.Close; + OutImage; OutImage; + OutText("END -- Input Bytes"); OutInt(Sequ-1,6); + OutImage; OutImage; +end; diff --git a/samples/Simula/demos.sim b/samples/Simula/demos.sim new file mode 100644 index 0000000000..a0f547a942 --- /dev/null +++ b/samples/Simula/demos.sim @@ -0,0 +1,2628 @@ +comment License: program borrowed from S-PORT https://github.com/portablesimula/S-PORT; + CLASS DEMOS; + BEGIN + COMMENT----D A T A C O L L E C T I O N D E V I C E S---- + * + * THIS LEVEL CONTAINS THE DATA COLLECTING MECHANISMS + * AND THEIR PRINTING ROUTINES. THE DEFINITIONS ARE: + * + * ACCUMULATE COUNT HISTOGRAM TALLY + * + * ACCUMULATE COLLECTS TIME DEPENDENT DATA + * + * COUNT IS USED TO COUNT INCIDENCES ONLY + * + * HISTOGRAM COLLECTS DATA IN HISTOGRAM FORM AND + * PRINTS THE END RESULT AS A PICTURE + * + * TALLY COLLECTS TIME INDEPENDENT DATA + * + * ATTRIBUTES SHARED BY THESE DEFINITIONS : + * RESET NOTE TIME AND RESET STATUS + * TO ZERO + * UPDATE(V) RECORD NEW ENTRY V + * REPORT PRINT CURRENT STATUS + * + * THESE CLASSES ARE PREFIXED BY 'TAB' WHICH CONTAINS + * COMMON VARIABLES AND THE PARAMETER 'TITLE' WHICH NAMES + * THE PARTICULAR OBJECT. + * EVERY OBJECT OF A CLASS INNER TO TAB IS PUT INTO A + * 'REPORTQ' BEHIND THE SCENES. + * THESE REPORTQS ARE SYSTEM DEFINED AND ARE CALLED + * + * ACCUMQ COUNTQ DIST(+EMP)Q HISTOQ TALLYQ + * + * ON A CALL 'REPORT', THE CURRENT STATUSES OF ALL THESE + * REPORTQS ARE WRITTEN OUT. + * + * THE SET OF PREDEFINED DATA COLLECTION FACILITIES + * IS PREFIXED BY TAB. + * + * TAB DEFINES THE COMMON CORE + * + * VARIABLES: + * TITLE USER SUPPLIED DESCRIPTIVE TEXT + * OBS NO. OF ENTRIES SINCE RESETAT + * RESETAT TIME WHEN INITIATED, OR LAST RESET + * NEXT REF TO NEXT TAB IN REPORTQ + * + * PROCEDURES: + * + * JOIN ENTERS THIS TAB INTO A NAMED + * REPORTQ AT THE END + * + * RESET (VIRTUAL) NOTES THE TIME IN + * RESETAT AND SETS OBS TO ZERO + * + * WRITETRN PRINTS ON ONE (PART)LINE + * TITLE/RESET TIME/OBSERVATIONS + *; + + + COMMENT------------------ T A B ----------------------------; + + CLASS TAB(TITLE); VALUE TITLE; TEXT TITLE; + VIRTUAL : PROCEDURE RESET, REPORT; + BEGIN INTEGER OBS; REAL RESETAT; + REF(TAB)NEXT; + + PROCEDURE JOIN(R); REF(REPORTQ)R; + BEGIN + IF R == NONE THEN ERROR(18, NONE, THIS TAB, 0, + "T.JOIN(R); REF(TAB)T; REF(REPORTQ)R;") ELSE + IF R.FIRST == NONE + THEN R.FIRST :- R.LAST :- THIS TAB + ELSE R.LAST :- R.LAST.NEXT :- THIS TAB; + END***JOIN***; + + PROCEDURE REPORT; + BEGIN + WRITETRN; + OUTF.OUTIMAGE; + END***REPORT***; + + PROCEDURE RESET; + BEGIN + OBS := 0; + RESETAT := TIME; + END***RESET***; + + PROCEDURE WRITETRN; + BEGIN + OUTF.OUTTEXT(TITLE); + OUTF.SETPOS(OUTF.POS+(13-TITLE.LENGTH)); + PRINTREAL(RESETAT); + OUTF.OUTINT(OBS, 7); + END***REPORT TITLE, RESETAT AND READINGS***; + + IF TITLE.LENGTH > 12 THEN TITLE :- TITLE.SUB(1, 12); + RESET; + END***TAB***; + + COMMENT-------------------- T A L L Y -----------------------; + + TAB CLASS TALLY; + BEGIN COMMENT + * + * VARIABLES: + * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER) + * .OBS NUMBER OF INCIDENCES + * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION + * .NEXT REF TO .NEXT TAB IN REPORTQ + * SUM SUM OF SAMPLE VALUES + * SUMSQ SUM OF SQUARES OF SAMPLE VALUES + * (VARIANCE)(OBS*SUMSQ - SUM*SUM)/(OBS*(OBS-1)) + * (SIGMA) SQRT(VARIANCE) + * MIN LEAST SAMPLE VALUE + * MAX LARGEST SAMPLE VALUE + * + * PROCEDURES : + * RESET RESETS OBS, SUM, SUMSQ, MIN, MAX TO ZERO + * COPIES TIME INTO RESETAT + * + * UPDATE(V) ADDS 1 TO OBS + * ADDS V TO SUM + * ADDS V*V TO SUMSQ + * MAX BECOMES MAXIMUM (MAX,V) + * MIN BECOMES MINIMUM (MIN,V) + * + * REPORT PRINTS ON ONE LINE: + * TITLE/RESET/OBS/AV/EST.ST.DEV/MIN/MAX + *; + + REAL SUM, SUMSQ, MIN, MAX; + + PROCEDURE REPORT; + BEGIN WRITETRN; + IF OBS = 0 THEN OUTF.OUTTEXT(MINUSES.SUB(1, 40)) ELSE + BEGIN PRINTREAL(SUM/OBS); + IF OBS = 1 THEN OUTF.OUTTEXT(MINUSES.SUB(1, 10)) ELSE + PRINTREAL(SQRT(ABS(OBS*SUMSQ-SUM**2)/(OBS*(OBS-1)))); + PRINTREAL(MIN); + PRINTREAL(MAX); + END; + OUTF.OUTIMAGE; + END***REPORT***; + + PROCEDURE RESET; + BEGIN OBS := 0; + SUM := SUMSQ := MIN := MAX := 0.0; + RESETAT := TIME; + END***RESET***; + + PROCEDURE UPDATE(V); REAL V; + BEGIN OBS := OBS + 1; + SUM := SUM + V; + SUMSQ := SUMSQ + V**2; + IF OBS = 1 THEN MIN := MAX := V ELSE + IF V < MIN THEN MIN := V ELSE + IF V > MAX THEN MAX := V; + END*** UPDATE ***; + + IF NOT(THIS TALLY IS NOTALLY) THEN JOIN(TALLYQ); + END*** TALLY ***; + + + COMMENT NOTALLY IS USED IN HISTOGRAM. NOTALLY OBJECTS ARE + NOT ENTERED INTO TALLYQ; + + TALLY CLASS NOTALLY;; + + COMMENT------------------ C O U N T -------------------------; + + TAB CLASS COUNT; + BEGIN COMMENT + * + * VARIABLES : + * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER) + * .OBS NUMBER OF INCIDENCES + * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION + * .NEXT REF TO NEXT TAB IN REPORTQ + * + * PROCEDURES : + * .RESET RESETS OBS TO ZERO + * COPIES TIME INTO RESETAT + + * UPDATE(V) ADDS V TO OBS + * + * REPORT PRINTS ON ONE LINE: + * TITLE/RESET/OBSERVATIONS + *; + + PROCEDURE REPORT; + BEGIN + OUTF.SETPOS(21); + WRITETRN; + OUTF.OUTIMAGE; + END***REPORT***; + + PROCEDURE UPDATE(V); INTEGER V; + BEGIN + OBS := OBS + V; + END***UPDATE***; + + JOIN(COUNTQ); + END***COUNT***; + + COMMENT-------------------- A C C U M U L A T E -------------; + + TAB CLASS ACCUMULATE; + BEGIN COMMENT + * + * VARIABLES : **** TIME WEIGHTED **** + * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAM.) + * .OBS NUMBER OF INCIDENCES + * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION + * .NEXT REF TO NEXT TAB IN REPORTQ + * SUMT TIME WEIGHTED SUM + * SUMSQT TIME WEIGHTED SUM OF SQUARES + * (MEAN) SUM/TIMESPAN = (LAST UPDATE TIME-RESETAT) + * (SIGMA) SQRT( SUMSQT / TIMESPAN - MEAN**2) + * MIN LEAST SAMPLE VALUE + * MAX LARGEST SAMPLE VALUE + * LASTTIME TIME OF LAST UPDATE + * LASTV LAST UPDATE VALUE + * + * PROCEDURES : + * RESET RESETS OBS, SUM, SUMSQT, MIN, MAX TO ZERO + * COPIES TIME INTO RESETAT, LASTTIME + * + * UPDATE(V) ADDS 1 TO OBS + * ADDS V*SPAN TO SUMT + * ADDS V*V*SPAN TO SUMSQT + * MIN BECOMES MINIMUM(MIN, V) + * MAX BECOMES MAXIMUM(MAX, V) + * COPIES TIME INTO LASTTIME + * + * REPORT PRINTS ON ONE LINE: + * TITLE/RESET/OBS/MEAN/EST.ST.DEV./MIN/MAX + *; + + REAL SUMT, SUMSQT, MIN, MAX, LASTTIME, LASTV; + + PROCEDURE REPORT; + BEGIN REAL SPAN, AVG, T; + WRITETRN; + IF OBS = 0 THEN OUTF.OUTTEXT(MINUSES.SUB(1, 40)) ELSE + BEGIN T := TIME; + SPAN := T - RESETAT; T := T - LASTTIME; + IF SPAN MAX THEN MAX := V; + END*** UPDATE ***; + + JOIN(ACCUMQ); + END***ACCUMULATE***; + + COMMENT-------------------- H I S T O G R A M ---------------; + + TAB CLASS HISTOGRAM(LOWER, UPPER, NCELLS); REAL LOWER, UPPER; + INTEGER NCELLS; + BEGIN COMMENT + * + * VARIABLES: + * + * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAM.) + * .N NUMBER OF INCIDENCES + * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION + * .NEXT REF TO NEXT TAB IN REPORTQ + * LOWER LOWER LIMIT OF THE VARIABLE RANGE + * UPPER UPPER LIMIT OF THE VARIABLE RANGE + * NCELLS NUMBER OF CELLS IN THIS RANGE + * WIDTH CELL WIDTH (= (UPPER - LOWER)/NCELLS) + * TABLE ARRAY TO HOLD THE INCIDENCES. VALUES IN + * RANGE GO IN CELLS 1, 2, .... , N. + * UNDERFLOW VALUES GO IN CELL 0. + * OVERFLOW VALUES IN CELL LIMIT=NCELLS+1 + * LIMIT NCELLS + 1. + * MYT TO ACCUMULATE SUM , SUMSQ OF READINGS + * + * PROCEDURES: + * RESET SETS OBS TO ZERO + * COPIES TIME INTO RESETAT + * RESETS MYT + * + * UPDATE(V) ADDS 1 TO OBS + * ADDS 1 TO THE APPROPRIATE TABLE CELL + * CALLS MYT.UPDATE(V) + * + * REPORT DRAWS A PICTURE OF THE HISTOGRAM. + * CALLS MYT.REPORT + *; + + INTEGER ARRAY TABLE(0 : NCELLS + 1); + REF(NOTALLY)MYT; + INTEGER LIMIT; + REAL WIDTH; + + PROCEDURE REPORT; + BEGIN TEXT T; + INTEGER I, NEXT, A, OCC; + REAL R, F, SCALE, SUM, FREQ; + + INTEGER PROCEDURE MAXIMUMELEMENT; + BEGIN INTEGER K, J; + IF OBS > 0 THEN + BEGIN K := TABLE(0); + FOR J := 1 STEP 1 UNTIL LIMIT DO + IF TABLE(J) > K THEN K := TABLE(J); + MAXIMUMELEMENT := K; + END; + END*** MAXIMUM ELEMENT ***; + + A := 40; + OUTF.SETPOS(29); + OUTF.OUTTEXT("S U M M A R Y"); + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + OUTF.OUTTEXT(HEADINGRTN); + OUTF.OUTTEXT(TALLYHEADING); + OUTF.OUTIMAGE; + MYT.REPORT; + OUTF.OUTIMAGE; + IF OBS = 0 THEN + BEGIN + OUTF.SETPOS(21); + OUTF.OUTTEXT("***NO ENTRIES RECORDED***"); + END ELSE + BEGIN SCALE := 30 / MAXIMUMELEMENT; + OUTF.OUTTEXT("CELL/LOWER LIM/ N/ FREQ/ CUM %"); + OUTF.OUTIMAGE; + OUTF.SETPOS(A); OUTF.OUTCHAR('I'); + OUTF.OUTTEXT(MINUSES.SUB(1, 30)); OUTF.OUTIMAGE; + F := 1/OBS; + R := LOWER - WIDTH; + FOR I := 0 STEP 1 UNTIL LIMIT DO + BEGIN OUTF.OUTINT(I, 4); + IF I = 0 THEN OUTF.OUTTEXT(" -INFINITY") + ELSE PRINTREAL(R); + NEXT := TABLE(I); OUTF.OUTINT(NEXT, 6); + FREQ := NEXT*F; OUTF.OUTFIX(FREQ, 2, 8); + SUM := SUM + FREQ*100.0; OUTF.OUTFIX(SUM , 2, 8); + OUTF.SETPOS(A); OUTF.OUTCHAR('I'); + IF NEXT > 0 THEN + BEGIN T :- STARS.SUB(1, SCALE*NEXT); + IF T == NOTEXT THEN OUTF.OUTCHAR('.') + ELSE OUTF.OUTTEXT(T); + END; + OUTF.OUTIMAGE; + ANYMORETOPRINT: + OCC := OCC+NEXT; + IF OCC = OBS AND I+3 < LIMIT THEN + BEGIN + OUTF.OUTIMAGE; + OUTF.SETPOS(A+6); + OUTF.OUTTEXT("**REST OF TABLE EMPTY**"); + OUTF.OUTIMAGE; + OUTF.OUTIMAGE; + GOTO FINISH; + END; + R := R + WIDTH; + END; + FINISH: + OUTF.SETPOS(A); OUTF.OUTCHAR('I'); + OUTF.OUTTEXT(MINUSES.SUB(1, 30)); OUTF.OUTIMAGE; + END; + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + END***REPORT***; + + PROCEDURE RESET; + BEGIN INTEGER K; + OBS := 0; + FOR K := 0 STEP 1 UNTIL LIMIT DO + TABLE(K) := 0; + RESETAT := TIME; + IF MYT =/= NONE THEN MYT.RESET; + END***RESET***; + + PROCEDURE UPDATE(V); REAL V; + BEGIN INTEGER CELL; + OBS := OBS + 1; + MYT.UPDATE(V); + V := V - LOWER; + IF V < 0.0 THEN CELL := 0 ELSE + BEGIN CELL := ENTIER(V/WIDTH) + 1; + IF CELL > LIMIT THEN CELL := LIMIT; + END; + TABLE(CELL) := TABLE(CELL) + 1; + END*** UPDATE ***; + + IF UPPER <= LOWER OR NCELLS < 1 THEN + BEGIN + ERROR(19, NONE, THIS TAB, 0, "NEW HISTOGRAM(T,L,U,N);"); + IF NCELLS < 1 THEN NCELLS := 10; + IF LOWER >= UPPER THEN + BEGIN + LOWER := 0.0; + UPPER := 100.0; + END; + END; + WIDTH := (UPPER - LOWER)/NCELLS ; + LIMIT := NCELLS + 1; + MYT :- NEW NOTALLY(TITLE); + JOIN(HISTOQ); + END***HISTOGRAM***; + + COMMENT----------R E G R E S S I O N S-------------; + + TAB CLASS REGRESSION(TITLE2); VALUE TITLE2; TEXT TITLE2; + BEGIN + REAL X, Y, XX, XY, YY; + + PROCEDURE UPDATE(VX, VY); REAL VX, VY; + BEGIN + OBS := OBS + 1; + X := X + VX; + Y := Y + VY; + XX := VX**2 + XX; + XY := VX*VY + XY; + YY := VY**2 + YY; + END***UPDATE***; + + PROCEDURE RESET; + BEGIN + OBS := 0; + RESETAT := TIME; + X := Y := XX := XY := YY := 0.0; + END***RESETAT***; + + PROCEDURE REPORT; + BEGIN + REAL DX, DY, A0, A1, SD, R2; + + OUTF.SETPOS((52-TITLE.LENGTH-TITLE2.LENGTH)//2); + OUTF.OUTTEXT("REGRESSION OF '"); + OUTF.OUTTEXT(TITLE2); + OUTF.OUTTEXT("' UPON '"); + OUTF.OUTTEXT(TITLE); + OUTF.OUTCHAR('''); + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + OUTF.SETPOS(17); + OUTF.OUTTEXT(" (RE)SET/ OBS/ XBAR/ YBAR"); + OUTF.OUTIMAGE; + OUTF.SETPOS(17); + PRINTREAL(RESETAT); + OUTF.OUTINT(OBS, 8); + IF OBS > 0 THEN + BEGIN + PRINTREAL(X/OBS); + PRINTREAL(Y/OBS); + END; + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + IF OBS <= 5 THEN + BEGIN + OUTF.SETPOS(24); + OUTF.OUTTEXT("*** INSUFFICIENT DATA ***"); + END ELSE + BEGIN + DX := ABS(OBS*XX - X**2); + DY := ABS(OBS*YY - Y**2); + IF DX < 0.00001 OR DY < 0.00001 THEN + BEGIN + OUTF.SETPOS(27); + OUTF.OUTTEXT("***DEGENERATE DATA***"); + OUTF.OUTIMAGE; + IF DX < 0.00001 THEN + BEGIN + OUTF.SETPOS(25); + OUTF.OUTTEXT("X = CONSTANT = "); + PRINTREAL(X/OBS); + OUTF.OUTIMAGE; + END; + IF DY < 0.00001 THEN + BEGIN + OUTF.SETPOS(25); + OUTF.OUTTEXT("Y = CONSTANT = "); + PRINTREAL(Y/OBS); + OUTF.OUTIMAGE; + END; + END***DEGENERATE CASE***ELSE + BEGIN + A1 := (OBS*XY - X*Y)/DX; + A0 := (Y*XX - X*XY)/DX; + SD := SQRT((YY - A0*Y - A1*XY)/(OBS-2)); + R2 := (OBS*XY - X*Y)**2/(DX*DY); + OUTF.OUTTEXT(" RES.ST.DEV/ EST.REG.COEFF/ INTERCEPT/"); + OUTF.OUTTEXT(" ST.DEV.REG.COEFF/ CORR.COEFF"); + OUTF.OUTIMAGE; + OUTF.SETPOS( 3); PRINTREAL(SD); + OUTF.SETPOS(18); PRINTREAL(A1); + OUTF.SETPOS(29); PRINTREAL(A0); + OUTF.SETPOS(47); PRINTREAL(OBS*SD/SQRT((OBS-2)*DX)); + OUTF.SETPOS(59); PRINTREAL(SQRT(R2)); + OUTF.OUTIMAGE; + END; + END; + OUTF.OUTIMAGE; + OUTF.OUTIMAGE; + END***REPORT***; + + IF TITLE2.LENGTH > 12 THEN TITLE2 :- TITLE2.SUB(1, 12); + END***REGRESSION***; + + COMMENT--------------------SEED GENERATOR-------------------- + * + * THE BASIC RNG IS + * + * U(K+1) <- U(K) * 2**13 MODULO 67099547 + * + * (SEE !NEXT PAGE: ZYQSAMPLE IN DIST) + * THIS RNG WAS DEVELOPED AND TESTED BY DOWNHAM AND ROBERTS + * BY NOTING THAT + * + * U(K+120633) <- U(K) * 36855 MODULO 67099547 + * + * WE GET OUR ROUTINE FOR GENERATING WELL SEPARATED SEEDS + * + * U(0) <- 907, U(1) <- 33427485, U(2) <- 22276755, ... + * + * YOU MAY CHANGE THE DEFAULTS BY ASSIGNING A FRESH VALUE + * TO ZYQSEED. + *; + + INTEGER PROCEDURE ZYQNEXTSEED; + BEGIN INTEGER K; + FOR K := 7, 13, 15, 27 DO + BEGIN ZYQSEED := ZYQSEED*K; + IF ZYQSEED >= ZYQMODULO THEN + ZYQSEED := ZYQSEED - ZYQSEED//ZYQMODULO*ZYQMODULO; + END; + ZYQNEXTSEED := ZYQSEED; + END***ZYQNEXTSEED***; + + PROCEDURE SETSEED(N); INTEGER N; + BEGIN + IF N < 0 THEN N := -N; + IF N >= ZYQMODULO THEN N := N-N//ZYQMODULO*ZYQMODULO; + IF N = 0 THEN N := ZYQMODULO//2; + ZYQSEED := N; + END***SETSEED***; + + COMMENT-------------D I S T R I B U T I O N S---------------- + * + * THIS SECTION HAS THE DEFINITIONS OF THE SAMPLING MECHANISMS + * DEFINED IN DEMOS. THESE DEFINITIONS ARE: + * + * DIST + * + * RDIST IDIST BDIST + * + * RDIST = + * CONSTANT ERLANG EMPIRICAL NEGEXP NORMAL UNIFORM + * + * IDIST = + * RANDINT POISSON + * + * BDIST = + * DRAW + * CONSTANT EVERY SAMPLE RETURNS THE SAME VALUE. + * + * EMPIRICAL DEFINES A CUMULATIVE PROBABILITY FUNCTION + * SUPPLIED AS A PAIR OF TABLES BY THE USER. + * + * AND THE REST FOLLOW SIMULA'S DRAWING PROCEDURES IN THE + * OBVIOUS WAY. BY BUILDING AN OBJECT, WE MAKE A DRAWING BY A + * CALL 'OBJ'.SAMPLE AND NEED NOT PASS OVER ANY PARAMETERS. + * AND THE OBJECT NAME CAN BE RELEVANT, E.G. ARRIVALS.SAMPLE. + *; + + TAB CLASS DIST; + BEGIN INTEGER U, USTART, TYPE; + BOOLEAN ANTITHETIC; + + REAL PROCEDURE ZYQSAMPLE; + BEGIN INTEGER K; + FOR K := 32, 32, 8 DO + BEGIN U := K*U; + IF U >= ZYQMODULO THEN U := U - U//ZYQMODULO*ZYQMODULO; + END; + ZYQSAMPLE := IF ANTITHETIC THEN 1.0 - U/ZYQMODULO + ELSE U/ZYQMODULO; + OBS := OBS+1; + END***ZYQSAMPLE***; + + PROCEDURE SETSEED(N); INTEGER N; + BEGIN + IF N < 0 THEN N := -N; + IF N >= ZYQMODULO THEN N := N-N//ZYQMODULO*ZYQMODULO; + IF N = 0 THEN N := ZYQMODULO//2; + U := N; + END***SETSEED***; + + PROCEDURE ZYQFAIL(T1,T2,X,Y);VALUE T1,T2;TEXT T1,T2;REAL X,Y; + BEGIN + SWITCH CASE:=NORMALL, UNIFORML, ERLANGL, + RANDINTL, NEGEXPL, POISSONL; + OUTTEXT("**ERROR IN CREATION OF "); + OUTTEXT(DISTTYPE(TYPE)); + OUTTEXT("DIST '"); + OUTTEXT(TITLE); + OUTCHAR('''); OUTCHAR('.'); + OUTIMAGE; + OUTTEXT(ZYQREASON); OUTTEXT(T1); OUTIMAGE; + OUTTEXT(ZYQRECVRY); OUTTEXT(T2); + GOTO CASE(TYPE); + GOTO JOIN; + NORMALL: + ERLANGL: + NEGEXPL: + POISSONL: OUTREAL(X, 5, 12); + GOTO JOIN; + UNIFORML: OUTREAL(X, 5, 12); + OUTTEXT(", B ="); + OUTREAL(Y, 5, 12); + GOTO JOIN; + RANDINTL: OUTINT(THIS DIST QUA RANDINT.A, 10); + OUTTEXT(", B ="); + OUTINT(THIS DIST QUA RANDINT.B, 10); + JOIN: OUTCHAR('.'); OUTIMAGE; OUTIMAGE; + END***ZYQFAIL***; + + PROCEDURE REPORT; + BEGIN SWITCH CASE := NORMALL, UNIFORML, ERLANGL, RANDINTL, + NEGEXPL, POISSONL, DRAWL, CONSTANTL; + WRITETRN; + OUTF.OUTCHAR(' '); + OUTF.OUTTEXT(DISTTYPE(TYPE)); + OUTF.SETPOS(41); + GOTO CASE(TYPE); + GOTO SKIPALL; + NORMALL: PRINTREAL(THIS DIST QUA NORMAL.A); + PRINTREAL(THIS DIST QUA NORMAL.B); + GOTO EXIT; + UNIFORML: PRINTREAL(THIS DIST QUA UNIFORM.A); + PRINTREAL(THIS DIST QUA UNIFORM.B); + GOTO EXIT; + ERLANGL: PRINTREAL(THIS DIST QUA ERLANG.A); + OUTF.OUTINT(THIS DIST QUA ERLANG.B, 10); + GOTO EXIT; + RANDINTL: OUTF.OUTINT(THIS DIST QUA RANDINT.A, 10); + OUTF.OUTINT(THIS DIST QUA RANDINT.B, 10); + GOTO EXIT; + NEGEXPL: PRINTREAL(THIS DIST QUA NEGEXP.A); + GOTO SKIP; + POISSONL: PRINTREAL(THIS DIST QUA POISSON.A); + GOTO SKIP; + DRAWL: PRINTREAL(THIS DIST QUA DRAW.A); + GOTO SKIP; + CONSTANTL: PRINTREAL(THIS DIST QUA CONSTANT.A); + GOTO SKIPALL; + SKIP: OUTF.SETPOS(61); + EXIT: OUTF.OUTINT(USTART, 10); + SKIPALL: OUTF.OUTIMAGE; + END***REPORT***; + + U := USTART := ZYQNEXTSEED; + IF THIS DIST IN EMPIRICAL THEN JOIN(EMPQ) + ELSE JOIN(DISTQ); + END***DIST***; + + COMMENT--------------------R D I S T S--------------------; + + + DIST CLASS RDIST; VIRTUAL: REAL PROCEDURE SAMPLE;; + + RDIST CLASS CONSTANT(A); REAL A; + BEGIN + REAL PROCEDURE SAMPLE; + BEGIN OBS := OBS + 1; + SAMPLE := A; + END***SAMPLE***; + + TYPE := 8; + END***CONSTANT***; + + + RDIST CLASS NORMAL(A, B); REAL A, B; + BEGIN REAL ZYQU, ZYQV; BOOLEAN ZYQEVEN; + + REAL PROCEDURE SAMPLE; + BEGIN REAL Z; + IF ZYQEVEN THEN + BEGIN ZYQEVEN := FALSE; + Z := ZYQU*COS(ZYQV); + OBS := OBS + 1; + END ELSE + BEGIN ZYQEVEN := TRUE; + ZYQU := SQRT(-2.0*LN(ZYQSAMPLE)); + ZYQV := 6.28318530717959*ZYQSAMPLE; + Z := ZYQU*SIN(ZYQV); + OBS := OBS - 1; + END; + SAMPLE := Z*B+A; + END***SAMPLE***; + + TYPE := 1; + IF B < 0.0 THEN + BEGIN B := -B; + ZYQFAIL("ST. DEV. 'B' < 0.0.", + "ABSOLUTE VALUE ~B~ TAKEN. B IS NOW", B, 0.0); + END; + END***NORMAL***; + + + RDIST CLASS NEGEXP(A); REAL A; + BEGIN + REAL PROCEDURE SAMPLE; + BEGIN + SAMPLE := -LN(ZYQSAMPLE)/A; + END***SAMPLE***; + + TYPE := 5; + IF A <= 0.0 THEN + BEGIN A := IF A < 0.0 THEN -A ELSE 0.001; + ZYQFAIL("NON-POSITIVE VALUE FOR 'A' (=ARRIVAL RATE).", + "A RESET TO", A, 0.0); + END; + END***NEGEXP***; + + + RDIST CLASS UNIFORM(A, B); REAL A, B; + BEGIN REAL ZYQSPAN; + REAL PROCEDURE SAMPLE; + BEGIN + SAMPLE := ZYQSPAN*ZYQSAMPLE + A; + END***SAMPLE***; + + TYPE := 2; + IF A > B THEN + BEGIN REAL Q; + Q := A; A := B; B := Q; + ZYQFAIL("LOWER BOUND 'A' > UPPER BOUND 'B'.", + "BOUNDS SWAPPED. NOW, A =", A, B); + END; + ZYQSPAN := B-A; + END***UNIFORM***; + + + RDIST CLASS ERLANG(A, B); REAL A; INTEGER B; + BEGIN REAL ZYQAB; + REAL PROCEDURE SAMPLE; + BEGIN INTEGER K, M; REAL PROD; + M := OBS; + PROD := ZYQSAMPLE; + FOR K := 2 STEP 1 UNTIL B DO + PROD := PROD * ZYQSAMPLE; + OBS := M+1; + SAMPLE := -LN(PROD)*ZYQAB; + END***SAMPLE***; + + TYPE := 3; + IF A <= 0.0 THEN + BEGIN A := IF A < 0.0 THEN -A ELSE 0.01; + ZYQFAIL("'A' (=1/MEAN) <= 0.0.", + "A RESET TO", A, 0.0); + END; + IF B < 0.0 THEN + BEGIN B := IF B < 0 THEN -B ELSE 1; + ZYQFAIL("'B' (ERLANG ST. DEV.) <= 0.0.", + "B RESET TO", B, 0.0); + END; + ZYQAB := A/B; + END***ERLANG***; + + RDIST CLASS EMPIRICAL(SIZE); INTEGER SIZE; + BEGIN REAL ARRAY X, P(1 : SIZE); + + REAL PROCEDURE SAMPLE; + BEGIN REAL Q; INTEGER K; + Q := ZYQSAMPLE; + K := 2; + WHILE P(K) < Q DO + K := K + 1; + SAMPLE := X(K-1) + (X(K)-X(K-1))*(Q-P(K-1))/(P(K)-P(K-1)); + END***SAMPLE***; + + PROCEDURE REPORT; + BEGIN INTEGER K; + OUTF.SETPOS(16); + OUTF.OUTTEXT(HEADINGRTN); OUTF.OUTTEXT("/ SEED"); + OUTF.OUTIMAGE; + OUTF.SETPOS(16); + WRITETRN; + OUTF.OUTINT(USTART, 10); + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + OUTF.SETPOS(16); + OUTF.OUTTEXT(" K/ DIST. X(K)/ PROB. P(K)"); + OUTF.OUTIMAGE; + FOR K := 1 STEP 1 UNTIL SIZE DO + BEGIN + OUTF.SETPOS(16); + OUTF.OUTINT(K, 8); + OUTF.OUTFIX(X(K), 5, 13); + OUTF.OUTFIX(P(K), 5, 13); + OUTF.OUTIMAGE; + END; + OUTF.OUTIMAGE; + END***REPORT***; + + PROCEDURE READ; + BEGIN BOOLEAN GOOD, FIRST; INTEGER K, L; + REAL A, B; + + PROCEDURE Z(W, R, F, C); VALUE W, C; TEXT W, C; + REAL R; BOOLEAN F; + BEGIN + IF GOOD THEN + BEGIN GOOD := FALSE; + SYSOUT.SETPOS(11); + OUTTEXT("**READ FAULT(S) IN EMPIRICAL '"); + OUTTEXT(TITLE); + OUTCHAR('''); OUTCHAR('.'); + OUTIMAGE; + END; + IF FIRST THEN + BEGIN FIRST := FALSE; + OUTIMAGE; + OUTTEXT("**INPUTS : K ="); OUTINT(K, 4); + OUTTEXT(", DIST(K) ="); OUTFIX(A, 3, 10); + OUTTEXT(", PROB(K) ="); OUTFIX(B, 3, 10); + OUTIMAGE; + OUTTEXT(ZYQRECVRY); + END; + SYSOUT.SETPOS(14); + OUTTEXT(W); + IF F THEN OUTFIX(R, 6, 10) ELSE OUTFIX(R, 3, 10); + OUTTEXT(C); OUTCHAR('.'); + OUTIMAGE; + END***Z - THE WARNING ROUTINE***; + + K := 1; + GOOD := FIRST := TRUE; + X(1) := A := INF.INREAL; B := INF.INREAL; + IF ABS(B) > EPSILON THEN + Z("P(1) IS NOT ZERO. P(1) =>",0.0,TRUE," (FIRST PROB)"); + FOR K := 2 STEP 1 UNTIL SIZE DO + BEGIN FIRST := TRUE; + X(K) := A := INF.INREAL; P(K) := B := INF.INREAL; + IF A < X(K-1) THEN + BEGIN X(K) := X(K-1); + Z("X(K) < X(K-1). X(K) =>",X(K),FALSE," (=X(K-1))"); + END; + IF B < 0.0 OR B < P(K-1) OR B > 1.0 THEN + BEGIN P(K) := P(K-1)+0.001; + IF P(K) > 1.0 THEN P(K) := 1.0; + Z("ILLEGAL PROB. P(K) =>",P(K),TRUE," (=P(K-1)+)"); + END; + END; + IF ABS(P(SIZE)-1.0) > EPSILON THEN + Z("P(SIZE) NE 1.0. P(SIZE) =>", 1.0, TRUE, " (LAST PROB.)"); + P(SIZE) := 1.0; + IF NOT GOOD THEN + BEGIN OUTTEXT(MINUSES.SUB(1, 62)); + OUTIMAGE; OUTIMAGE; + END; + END***READ***; + + TYPE := 9; + IF SIZE = 1 THEN ERROR(20, NONE, THIS EMPIRICAL, 0, + "NEW EMPIRICAL(T, SIZE); TEXT T; INTEGER SIZE;"); + READ; + END***EMPIRICAL***; + + COMMENT--------------------I D I S T S--------------------; + + DIST CLASS IDIST; VIRTUAL: INTEGER PROCEDURE SAMPLE;; + + IDIST CLASS RANDINT(A, B); INTEGER A, B; + BEGIN REAL ZYQSPAN; + INTEGER PROCEDURE SAMPLE; + BEGIN + SAMPLE := ENTIER(ZYQSPAN*ZYQSAMPLE) + A; + END***SAMPLE***; + + TYPE := 4; + IF A > B THEN + BEGIN INTEGER Q; + Q := A; A := B; B := Q; + ZYQFAIL("LOWER BOUND 'A' > UPPER BOUND 'B'.", + "BOUNDS SWAPPED. NOW A =", A, B); + END; + ZYQSPAN := B-A+1; + END***RANDINT***; + + IDIST CLASS POISSON(A); REAL A; + BEGIN + INTEGER PROCEDURE SAMPLE; + BEGIN INTEGER M; REAL P, Q; + P := EXP(-A); + Q := 1.0; + L: Q := Q*ZYQSAMPLE; + IF Q >= P THEN + BEGIN + M := M + 1; + GOTO L; + END; + SAMPLE := M; + OBS := OBS - M; + END***SAMPLE***; + + TYPE := 6; + IF A <= 0.0 THEN + BEGIN A := IF A < 0.0 THEN -A ELSE 0.001; + ZYQFAIL("NON-POSITIVE VALUE FOR 'A' (=MEAN).", + "A RESET TO", A, 0.0); + END; + END***POISSON***; + + COMMENT--------------------B D I S T S--------------------; + + DIST CLASS BDIST; VIRTUAL: BOOLEAN PROCEDURE SAMPLE;; + + BDIST CLASS DRAW(A); REAL A; + BEGIN + BOOLEAN PROCEDURE SAMPLE; + BEGIN + SAMPLE := A > ZYQSAMPLE; + END***SAMPLE***; + + TYPE := 7; + END***DRAW***; + + COMMENT-------------READDIST-----------------------------------; + + PROCEDURE READDIST(D, TITLE); NAME D; VALUE TITLE; + REF(DIST)D; TEXT TITLE; + BEGIN TEXT F, REST; + INTEGER P, IMLENGTH1, L, K, T; + + PROCEDURE FAIL(D, EOF); BOOLEAN D, EOF; + BEGIN OUTTEXT("**ERROR IN READING DIST WITH TITLE = '"); + OUTTEXT(TITLE); + OUTCHAR('''); OUTCHAR('.'); + OUTIMAGE; + OUTTEXT("**NO MATCH FOUND WHEN SCANNING INPUT FILE FOR "); + IF D THEN OUTTEXT(" DIST TYPE") ELSE OUTTEXT("TITLE"); + OUTCHAR('.'); + OUTIMAGE; + OUTTEXT(ZYQREASON); + IF EOF THEN OUTTEXT("END OF INPUT FILE MARKER HIT.") ELSE + BEGIN OUTTEXT("REST OF CURRENT INPUT IMAGE READS:"); + OUTIMAGE; + OUTTEXT(REST); + END; + ABORT(TRUE); + END***FAIL***; + + COMMENT***CHECKTITLE***; + IMLENGTH1 := INF.IMAGE.LENGTH + 1; + IF INF.LASTITEM THEN FAIL(FALSE, TRUE); + L := TITLE.LENGTH; + P := INF.IMAGE.POS; + REST :- INF.IMAGE.SUB(P, IMLENGTH1 - P); + IF REST.LENGTH >= L THEN F :- REST.SUB(1, L); + IF F NE TITLE THEN FAIL(FALSE,FALSE); + INF.SETPOS(P + L); + + COMMENT***GET DIST TYPE***; + IF INF.LASTITEM THEN FAIL(TRUE, TRUE); + P := INF.IMAGE.POS; + REST :- INF.IMAGE.SUB(P, IMLENGTH1 - P); + L := REST.LENGTH; + FOR K := 6, 7, 6, 7, 6, 7, 4, 8, 9 DO + BEGIN T := T + 1; + IF K <= L THEN + BEGIN + IF DISTTYPE(T) = REST.SUB(1, K) THEN GOTO FOUND; + END; + END; + FAIL(TRUE, FALSE); + FOUND: INF.SETPOS(P + K); + IF T=1 THEN D:-NEW NORMAL(TITLE,INF.INREAL,INF.INREAL) ELSE + IF T=2 THEN D:-NEW UNIFORM(TITLE,INF.INREAL,INF.INREAL)ELSE + IF T=3 THEN D:-NEW ERLANG(TITLE,INF.INREAL,INF.ININT) ELSE + IF T=4 THEN D:-NEW RANDINT(TITLE,INF.ININT,INF.ININT) ELSE + IF T=5 THEN D:-NEW NEGEXP(TITLE,INF.INREAL) ELSE + IF T=6 THEN D:-NEW POISSON(TITLE,INF.INREAL) ELSE + IF T=7 THEN D:-NEW DRAW(TITLE,INF.INREAL) ELSE + IF T=8 THEN D:-NEW CONSTANT(TITLE,INF.INREAL) ELSE + IF T=9 THEN D:-NEW EMPIRICAL(TITLE, INF.ININT); + END***READDIST***; + + COMMENT-------------------- REPORTQ -------------------------; + + CLASS REPORTQ(H, L1, L2); VALUE H; TEXT H, L1, L2; + BEGIN COMMENT + * + * EVERY CREATED TAB IS PUT INTO A REPORTQ IN THE ORDER + * OF ITS CREATIONS. FROM THERE THEY CAN ALL BE REPORTED + * TOGETHER ON A CALL 'REPORT' , OR ALL RESET TO THE NULL + * STATE BY A CALL 'RESET'. + * + * VARIABLES : + * FIRST REF TO FIRST TAB IN REPORTQ + * LAST REF TO LAST TAB IN REPORTQ + * + * PROCEDURES: + * RESET RESETS EACH AND EVERY REPRESENTED TAB + * + * REPORT REPORTS EACH AND EVERY TAB AS ABOVE + *; + + REF(TAB)FIRST, LAST; + + PROCEDURE REPORT; + BEGIN REF(TAB)T; + INTEGER P, L; + L := H.LENGTH; P := (72-L)//2; + OUTF.SETPOS(P); OUTF.OUTTEXT(H); + OUTF.OUTIMAGE; + OUTF.SETPOS(P); OUTF.OUTTEXT(STARS.SUB(1, L)); + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + IF L1 =/= NOTEXT THEN + BEGIN + OUTF.OUTTEXT(L1); + IF L2 =/= NOTEXT THEN OUTF.OUTTEXT(L2); + OUTF.OUTIMAGE; + END; + T :- FIRST; + WHILE T =/= NONE DO + BEGIN T.REPORT; + T :- T.NEXT; + END; + END***REPORT***; + + PROCEDURE RESET; + BEGIN REF(TAB)T; + T :- FIRST; + WHILE T =/= NONE DO + BEGIN T.RESET; + T :- T.NEXT; + END; + END***RESET***; + + END***REPORTQ***; + + COMMENT-------------------- REPORTING AIDS -----------------; + + PROCEDURE CLOCKTIME; + BEGIN OUTF.SETPOS(24); + OUTF.OUTTEXT("CLOCK TIME = "); + PRINTREAL(TIME); + OUTF.OUTIMAGE; + END***CLOCK TIME***; + + + PROCEDURE BOX(T); VALUE T; TEXT T; + BEGIN + OUTF.OUTTEXT(STARS); OUTF.OUTIMAGE; + OUTF.OUTCHAR('*'); OUTF.SETPOS(70); + OUTF.OUTCHAR('*'); OUTF.OUTIMAGE; + OUTF.OUTCHAR('*'); + OUTF.SETPOS((72 - T.LENGTH)//2); + OUTF.OUTTEXT(T); + OUTF.SETPOS(70); + OUTF.OUTCHAR('*'); + OUTF.OUTIMAGE; + OUTF.OUTCHAR('*'); OUTF.SETPOS(70); + OUTF.OUTCHAR('*'); OUTF.OUTIMAGE; + OUTF.OUTTEXT(STARS); OUTF.OUTIMAGE; + OUTF.OUTIMAGE; + END***BOX***; + + + TEXT PROCEDURE EDIT(T, K); VALUE T; TEXT T; INTEGER K; + BEGIN TEXT S; + T :- T.STRIP; + IF T.LENGTH > 10 THEN T :- T.SUB(1, 10); + EDIT :- S :- BLANKS(T.LENGTH + 2); + S := T; + IF K < 0 THEN K := -K; + IF K > 99 THEN K := K - K//100*100; + S.SUB(S.LENGTH-1, 2).PUTINT(K); + END***EDIT***; + + + PROCEDURE PRINTREAL(X); REAL X; + BEGIN + IF X > 0.0 THEN + BEGIN + IF X > 99999.999 OR X < 0.1 THEN OUTF.OUTREAL(X, 4, 10) + ELSE OUTF.OUTFIX (X, 3, 10); + END ELSE + IF X = 0.0 THEN OUTF.OUTFIX(X, 3, 10) ELSE + BEGIN + IF X < -9999.999 OR X > -0.1 THEN OUTF.OUTREAL(X, 3, 10) + ELSE OUTF.OUTFIX (X, 3, 10); + END; + END***PRINTREAL***; + + COMMENT----------E N T I T Y-------------------------; + + CLASS ENTITY(TITLE); VALUE TITLE; TEXT TITLE; + VIRTUAL: LABEL LOOP; + BEGIN REAL TIMEIN, EVTIME; + INTEGER PRIORITY, CYCLE, WANTS, INTERRUPTED; + REF(QUEUE)CURRENTQ; + REF(ENTITY)OWNER; + BOOLEAN TERMINATED; + REF(ENTITY)LL, BL, RL; + REF(ENTITY)SUC, PRED; + + BOOLEAN PROCEDURE AVAIL; + AVAIL := OWNER == NONE; + + BOOLEAN PROCEDURE IDLE; + IDLE := EVTIME < 0.0; + + PROCEDURE COOPT; + BEGIN + IF OWNER =/= NONE THEN ERROR(1, THIS ENTITY, NONE, 0, + "E.COOPT; REF(ENTITY)E;"); + OWNER :- CURRENT; + IF ZYQTRACE > 0 THEN + NOTE(1,"COOPTS",THIS ENTITY,CURRENTQ,0.0,0); + IF CURRENTQ =/= NONE THEN OUT; + END***COOPT***; + + PROCEDURE INTERRUPT(N); INTEGER N; + BEGIN + INTERRUPTED := N; + IF ZYQTRACE > 0 THEN + NOTE(24,"INTERRUPTS",THIS ENTITY,NONE,0.0,N); + IF CURRENT =/= THIS ENTITY THEN + BEGIN + IF CURRENTQ =/= NONE THEN OUT; + IF EVTIME >= 0.0 THEN CANCEL; + INSERTDELAY0; + END; + END***INTERRUPT***; + + PROCEDURE REPEAT; + BEGIN CYCLE := CYCLE+1; + GOTO LOOP; + END***REPEAT***; + + PROCEDURE INTO(Q); REF(QUEUE)Q; + BEGIN REF(ENTITY)E; + IF CURRENTQ =/= NONE THEN + BEGIN + ERROR(3, THIS ENTITY, CURRENTQ, 0, "E.INTO(Q); REF(QUEUE)Q;"); + OUT; + END; + CURRENTQ :- Q; + TIMEIN := TIME; + INSPECT CURRENTQ DO + BEGIN QINT := QINT + (TIMEIN-LASTQTIME)*LENGTH; + LASTQTIME := TIMEIN; + LENGTH := LENGTH+1; + IF LENGTH > MAXLENGTH THEN MAXLENGTH := LENGTH; + E :- LAST; + IF E == NONE THEN FIRST :- LAST :- THIS ENTITY ELSE + IF E.PRIORITY >= PRIORITY THEN + BEGIN + PRED :- LAST; + LAST :- LAST.SUC :- THIS ENTITY; + END ELSE + BEGIN + E :- FIRST; + WHILE E.PRIORITY >= PRIORITY DO + E :- E.SUC; + SUC :- E; + PRED :- E.PRED; + IF PRED == NONE THEN FIRST :- THIS ENTITY + ELSE PRED.SUC :- THIS ENTITY; + SUC.PRED :- THIS ENTITY; + END; + END OTHERWISE ERROR(2, THIS ENTITY, NONE, 0, + "E.INTO(Q); REF(QUEUE)Q;"); + END***INTO***; + + PROCEDURE OUT; + BEGIN REAL T; + T := TIME; + INSPECT CURRENTQ DO + BEGIN QINT := QINT + (T-LASTQTIME)*LENGTH; + LENGTH := LENGTH-1; + LASTQTIME := T; + OBS := OBS+1; + T := LASTQTIME-TIMEIN; + IF T < EPSILON THEN ZEROS := ZEROS+1; + CUM := CUM+T; + IF SUC == NONE THEN LAST :- PRED ELSE SUC.PRED :- PRED; + IF PRED == NONE THEN FIRST :- SUC ELSE PRED.SUC :- SUC; + SUC :- PRED :- NONE; + END; + CURRENTQ :- NONE; + END***OUT***; + + PROCEDURE GETSERIALNO; + BEGIN REF(ZYQENTTITLE)Z; + Z :- ZYQENTNAMES; + WHILE (IF Z == NONE THEN FALSE ELSE TITLE NE Z.T) DO + Z :- Z.NEXTTITLE; + IF Z == NONE THEN Z :- NEW ZYQENTTITLE(TITLE); + TITLE :- BLANKS(Z.L+2); + TITLE := Z.T; + TITLE.SUB(Z.L+1, 2).PUTINT(Z.N); + Z.N := Z.N+1; + IF Z.N = 100 THEN Z.N := 0; + END***GET SERIALNO***; + + REF(ENTITY)PROCEDURE NEXTEV; + BEGIN + REF(ENTITY)P; + P :- BL; + IF P =/= NONE THEN + BEGIN + P :- P.RL; + IF P =/= NONE THEN + BEGIN + WHILE P.LL =/= NONE DO + P :- P.LL; + END; + NEXTEV :- P; + END; + END***NEXTEV***; + + PROCEDURE LIST; + BEGIN + REF(ENTITY)R; + INTEGER N; + OUTF.SETPOS(6); + PRINTREAL(EVTIME); + OUTF.OUTCHAR(' '); + OUTF.OUTTEXT(TITLE); + N := 30; + FOR R :- LL, BL, RL DO + BEGIN + OUTF.SETPOS(N); + IF R =/= NONE THEN OUTF.OUTTEXT(R.TITLE); + N := N + 13; + END; + OUTF.OUTIMAGE; + END***LIST***; + + PROCEDURE INSERT; + BEGIN + COMMENT + * ASSUME: + * LL == BL == RL == NONE + * EVTIME HAS BEEN SET BY HOLD OR SCHEDULE + * + * THIS ROUTINE IS CALLED BY SCHEDULE AND HOLD + * AND INSERTS O(LOG N) FROM THE TOP. + * + *; + + REF(ENTITY)W, X; + + NEWROOT: + IF EVTIME >= ROOT.EVTIME THEN + BEGIN + LL :- ROOT; + ROOT :- ROOT.BL :- THIS ENTITY; + END ELSE + + INSERTBELOWW: + BEGIN + W :- ROOT; + DESCEND: + X :- W.LL; + IF X == NONE THEN + BEGIN + INSERTASLLOFW: + W.LL :- THIS ENTITY; + BL :- W; + IF W == CURRENT THEN + BEGIN + ERROR(15, THIS ENTITY, NONE, 0, + "E.INSERT; REF(ENTITY)E;"); + CURRENT :- THIS ENTITY; + RESUME(CURRENT); + END; + END ELSE + IF EVTIME < X.EVTIME THEN + INSERT1BELOWX: + BEGIN + W :- X; + GOTO DESCEND; + END ELSE + IF EVTIME = X.EVTIME THEN + INSERTBETWEENXANDW: + BEGIN + W.LL :- X.BL :- THIS ENTITY; + BL :- W; + LL :- X; + END ELSE + INSERTINRIGHTSUBTREEOFW: + BEGIN + X :- W.RL; + IF X == NONE THEN + INSERTASNEWRLOFW: + BEGIN + W.RL :- THIS ENTITY; + BL :- W; + END ELSE + INSERT2BELOWX: + IF EVTIME < X.EVTIME THEN + BEGIN + W :- X; + GOTO DESCEND; + END ELSE + INSERT3BETWEENWANDX: + BEGIN + W.RL :- X.BL :- THIS ENTITY; + BL :- W; + LL :- X; + END; + END; + END; + END***INSERT***; + + PROCEDURE INSERTAFTERCURRENT; + BEGIN + COMMENT + * ASSUME: + * LL == BL == RL == NONE + * THIS ROUTINE IS CALLED BY ACQUIRE, RELEASE, ETC + * AND INSERTS O(1) FROM THE BOTTOM. + *; + + IF EVTIME < 0.0 THEN + BEGIN + LL :- CURRENT; + EVTIME := CURRENT.EVTIME; + IF CURRENT==ROOT THEN CURRENT.BL:-ROOT:-THIS ENTITY ELSE + BEGIN + BL :- CURRENT.BL; + CURRENT.BL :- BL.LL :- THIS ENTITY; + END; + END; + END***INSERTAFTERCURRENT***; + + PROCEDURE INSERTDELAY0; + BEGIN + COMMENT + * ASSUME: + * LL == BL == RL == NONE + * THIS ROUTINE IS CALLED BY ACQUIRE, RELEASE, ETC + * AND INSERTS O(1) FROM THE BOTTOM. + * + *; + + REF(ENTITY)P; + IF EVTIME < 0.0 THEN + BEGIN + EVTIME := CURRENT.EVTIME; + IF EVTIME >= ROOT.EVTIME THEN + BEGIN + LL :- ROOT; + ROOT :- ROOT.BL :- THIS ENTITY; + END ELSE + BEGIN + P :- CURRENT.BL; + WHILE EVTIME >= P.EVTIME DO + P :- P.BL; + LL :- P.LL; + BL :- P; + LL.BL :- BL.LL :- THIS ENTITY; + END; + END; + END***INSERTDELAY0***; + + PROCEDURE SCHEDULE(T); REAL T; + BEGIN + COMMENT + * + * A CALL E.SCHEDULE(T) DOES NOTHING IF E + * IS ALREADY IN THE EVENT LIST(E.EVTIME >= 0.0). + * OTHERWISE, IT INSERTS E INTO THE EVENT LIST + * 'DELAY' T. THERE ARE THREE SEPARATE CASES: + * T < 0.0, E PREEMPTS CURRENT (0(1) INSERT) + * T = 0.0, E FOLLOWS CURRENT (O(1) INSERT) + * T > 0.0, INSERT E FROM THE TOP + *; + + REF(ENTITY)E; + + IF TERMINATED THEN ERROR(14, THIS ENTITY, NONE, 0, + "E.SCHEDULE(T); REF(ENTITY)T; REAL T;"); + IF EVTIME < 0.0 THEN + BEGIN + IF ZYQTRACE > 0 THEN + NOTE(2,"SCHEDULES",THIS ENTITY, NONE,T,0); + OWNER :- NONE; + IF CURRENTQ =/= NONE THEN OUT; + PREEMPTCURRENT: + IF T <= NOW THEN + BEGIN + EVTIME := CURRENT.EVTIME; + BL :- CURRENT; + CURRENT :- CURRENT.LL :- THIS ENTITY; + RESUME(CURRENT); + END ELSE + INSERTBEHINDCURRENT: + IF T <= 0.0 THEN INSERTDELAY0 ELSE + INSERTFROMTHETOP: + BEGIN + EVTIME := CURRENT.EVTIME + T; + INSERT; + END; + END ELSE ERROR(16, THIS ENTITY, NONE, 0, + "E.SCHEDULE(T); REF(ENTITY)E; REAL T;"); + END***SCHEDULE***; + + PROCEDURE CANCEL; + BEGIN + COMMENT + * A CALL E.CANCEL DELETES E FROM THE EVENT LIST. + * IT HAS NO EFFECT IF E IS PASSIVE (E.EVTIME < 0) + *; + REF(ENTITY)P; + IF EVTIME >= 0.0 THEN + BEGIN + IF ZYQTRACE > 0 AND NOT TERMINATED THEN + NOTE(23,"CANCELS",THIS ENTITY,NONE,0.0,0); + EVTIME := -1.0; + IF LL == NONE THEN + BEGIN + IF THIS ENTITY == ROOT THEN + ERROR(13,THIS ENTITY,NONE,0,"E.CANCEL; REF(ENTITY)E;"); + IF THIS ENTITY == CURRENT THEN + BEGIN + IF BL.RL == NONE THEN + BLISNEWCURRENT: + BEGIN + CURRENT :- BL; + CURRENT.LL :- NONE; + END ELSE + LEFTMOSTOFSUBTREEOFBLISNEWCURRENT: + BEGIN + P :- BL.RL; + WHILE P.LL =/= NONE DO + P :- P.LL; + SWINGRSUBTREETOTHELEFT: + BL.LL :- BL.RL; + BL.RL :- NONE; + CURRENT :- P; + END; + BL:- NONE; + RESUME(CURRENT); + END ELSE + LEAFBUTNOTCURRENT: + BEGIN + IF BL.LL == THIS ENTITY THEN BL.LL :- RL; + BL.RL :- NONE; + BL :- NONE; + END; + END ELSE + IF RL == NONE THEN COMMENT BUT LL =/= NONE; + BEGIN + IF THIS ENTITY == ROOT THEN ROOT :- LL ELSE + IF THIS ENTITY == BL.LL THEN BL.LL :- LL + ELSE BL.RL :- LL; + LL.BL :- BL; + BL :- LL :- NONE; + END ELSE + BEGIN COMMENT NEITHER LL NOR RL == NONE; + P :- RL; + P.BL :- BL; + IF THIS ENTITY == ROOT THEN ROOT :- P ELSE + BEGIN + IF BL.LL == THIS ENTITY THEN BL.LL :- RL + ELSE BL.RL :- RL; + BL :- NONE; + END; + WHILE P.LL =/= NONE DO + P :- P.LL; + P.LL :- LL; + LL.BL :- P; + RL :- LL :- NONE; + END; + END ELSE ERROR(17, THIS ENTITY, NONE, 0, + "E.CANCEL; REF(ENTITY)E;"); + END***CANCEL***; + + IF TITLE.LENGTH > 10 THEN TITLE :- TITLE.SUB(1, 10); + GETSERIALNO; + EVTIME := -1.0; + DETACH; + LOOP:; + INNER; + TERMINATED := TRUE; + IF ZYQTRACE>0 THEN NOTE(3,"***TERMINATES",NONE,NONE,0.0,0); + IF EVTIME >= 0.0 THEN ZYQPASSIVATE; + END***ENTITY***; + + COMMENT------------H O L D AND P A S S I V A T E----------; + + REAL PROCEDURE TIME; + TIME := CURRENT.EVTIME; + + + PROCEDURE ZYQPASSIVATE; + BEGIN + REF(ENTITY)P; + IF CURRENT == ROOT THEN ERROR(15, CURRENT, NONE, 0, + "PASSIVATE;"); + P :- CURRENT.BL; + CURRENT.BL :- NONE; + CURRENT.EVTIME := -1.0; + LOCATENEWCURRENT: + IF P.RL =/= NONE THEN + BEGIN + P.LL :- P.RL; + P.RL :- NONE; + WHILE P.LL =/= NONE DO + P :- P.LL; + END ELSE P.LL :- NONE; + CURRENT :- P; + RESUME(CURRENT); + END***ZYQPASSIVATE***; + + + PROCEDURE PASSIVATE; + BEGIN + IF ZYQTRACE>0 THEN NOTE(22,"PASSIVATES",NONE,NONE,0.0,0); + ZYQPASSIVATE; + END***PASSIVATE***; + + + PROCEDURE HOLD(T); REAL T; + BEGIN + COMMENT + * + * DELAYS CURRENT BY T (T >= 0.0). + * IF T < 0.0, THEN T := 0.0 + *; + + REF(ENTITY)P; + + IF T < 0.0 THEN T := 0.0; + IF ZYQTRACE>0 THEN NOTE(21,"HOLDS FOR",NONE,NONE,T,0); + INSPECT CURRENT DO + BEGIN + EVTIME := EVTIME+T; + IF ROOT =/= CURRENT THEN + MOREWORKTODO: + BEGIN + LOCATENEXTEV: + IF BL.RL == NONE THEN P :- BL ELSE + BEGIN + P :- BL.RL; + WHILE P.LL =/= NONE DO + P :- P.LL; + END; + SKIPIFSTILLCURRENT: + IF EVTIME >= P.EVTIME THEN + BEGIN + BL.LL :- BL.RL; + BL.RL :- NONE; + BL :- NONE; + CURRENT :- P; + INSERT; + RESUME(CURRENT); + END; + END; + END; + END***HOLD***; + + COMMENT----------- Q U E U E ------------------; + + TAB CLASS QUEUE; + BEGIN + COMMENT + * + * QUEUE OBJECTS MAY BE USED BY ANYONE AS THEY + * STAND TO 'SAVE' ENTITIES, BUT THE PRIME USE + * OF THIS CLASS IS TO SERVE AS PREFIX TO + * + * RES BIN WAITQ CONDQ + * + * VARIABLES: + * .TITLE USER SUPPLIED DESCRIPTIVE TEXT + * .OBS NO. OF COMPLETED WAITS IN THIS Q + * .RESETAT TIME OF CREATION, OR LAST RESET + * .NEXT REF TO NEXT TAB IN REPORTQ + * LENGTH CURRENT NO. OF ENTITIES WAITING + * ZEROS NO. OF ZERO ( 0 THEN PRINTREAL(CUM/OBS) + ELSE OUTF.OUTTEXT(MINUSES.SUB(1,10)); + OUTF.OUTIMAGE; + IF THIS QUEUE IS WAITQ THEN OUTF.OUTIMAGE; + END***REPORT***; + + PROCEDURE RESET; + BEGIN + ZEROS := OBS := 0; + QINT := CUM := 0.0; + MAXLENGTH := LENGTH; + LASTQTIME := RESETAT:= TIME; + END***RESET***; + + IF THIS QUEUE IS QUEUE THEN JOIN(QUEUEQ); + END***QUEUE***; + + + QUEUE CLASS NOQUEUE;; + + COMMENT------------R E S O U R C E-------------; + + QUEUE CLASS RESOURCE(AVAIL); INTEGER AVAIL; + BEGIN + COMMENT + * DEFINES THE COMMON CORE TO RES AND BIN + * + * VARIABLES: + * .AS CLASS QUEUE + * AVAIL AMOUNT OF RESOURCE CURRENTLY FREE + * SINT TO MAINTAIN USAGE*TIME INTEGRAL + * EXTREME MIN VALUE OF AVAIL IF RES + * MAX VALUE OF AVAIL IF BIN + * INITIAL INITIAL VALUE OF THE RESOURCE + * LASTRTIME TIME OF LAST ACQUIRE/RETURN OF RES + * OR LAST TAKE/GET OF BIN + * + * PROCEDURES: + * REPORT PRINTS ON ONE LINE + * RES =TITLE/RESET/OBS/LIMIT/MIN/NOW/%USAGE/AV.WAIT/QMAX + * BIN =TITLE/RESET/OBS/INIT/MAX/NOW/AV.FREE/WAIT/QMAX + * + * RESET SETS OBS, ZEROS, USERS TO ZERO + * SINT, QINT, CUM TO ZERO + * LASTQTIME, RESETAT TO TIME + * MAXLENGTH TO LENGTH + * EXTREME TO AVAIL + *; + INTEGER EXTREME, INITIAL, USERS; + REAL SINT, LASTRTIME; + + PROCEDURE REPORT; + BEGIN REAL T, SPAN, X; + T := TIME; + SPAN := T- RESETAT; + WRITETRN; + FUDGE: OUTF.IMAGE.SUB(24, 7).PUTINT(USERS); + OUTF.OUTINT(INITIAL, 5); + OUTF.OUTINT(EXTREME, 5); + OUTF.OUTINT(AVAIL, 5); + X := SINT + (T-LASTRTIME)*AVAIL; + IF SPAN < EPSILON THEN OUTF.OUTTEXT(MINUSES.SUB(1, 10)) ELSE + IF THIS RESOURCE IS BIN THEN PRINTREAL(X/SPAN) ELSE + PRINTREAL((1.0-X/(INITIAL*SPAN))*100.0); + IF OBS = 0 THEN OUTF.OUTTEXT(MINUSES.SUB(1,10)) + ELSE PRINTREAL(CUM/OBS); + OUTF.OUTINT(MAXLENGTH,5); + OUTF.OUTIMAGE; + END***REPORT***; + + PROCEDURE RESET; + BEGIN + OBS := ZEROS := USERS := 0; + MAXLENGTH := LENGTH; + LASTRTIME := LASTQTIME := RESETAT := TIME; + QINT := SINT := CUM := 0.0; + EXTREME := AVAIL; + END***RESET***; + + INITIAL := AVAIL; + END***RESOURCE***; + + COMMENT------------R E S-----------------------; + + RESOURCE CLASS RES; + BEGIN + COMMENT + * A RES OBJECT MAKES MUTUAL EXCLISION AVAILABLE IN DEMOS. + * AN OBJECT WITH LIMIT = N > 0 CAN BE 'USED' BY UP TO + * N ENTITIES AT A TIME, BUT NO MORE. IT CAN BE SEIZED + * IN INTEGER CHUNKS (0 < CHUNK <= LIMIT), AND RETURNED + * ALL AT ONCE OR IN PART CHUNKS. IF THE AMOUNT + * REQUESTED IS NOT FREE, THE REQUESTER IS DELAYED. + * WHEN AN ENTITY RETURNS UNITS TO THE RES, THE + * QUEUE OF BLOCKED ENTITIES IS TESTED FROM THE + * FRONT. + * + * VARIABLES: + * .TITLE USER SUPPLIED DESCRIPTIVE TEXT + * .OBS NO. OF COMPLETED USAGES (CALLS ON RETURN) + * .RESETAT TIME OF CREATION, OR LAST RESET. + * .NEXT REF TO NEXT TAB IN REPORTQ + * .AVAIL AMOUNT CURRENTLY FREE + * .SINT MAINTAINS TIME WEIGHTED AVERAGE OF + * RESOURCE USAGE + * .EXTREME MINIMUM LEVEL REACHED + * INITIAL MAXIMUM LEVEL + * + * PROCEDURES: + * ACQUIRE(N) SUCCESS IF N <= AVAIL AND + * CURRENT.PRIORITY > FIRST.PRIORITY + * AND THEN AVAIL := AVAIL - N. + * ELSE CURRENT IS BLOCKED IN THIS QUEUE + * *ERRORS: N < 0 + * N > LIMIT + * + * RETURN(N) AVAIL := AVAIL + N + * ACTIVATE FIRST DELAY 0.0 + * (FIRST WILL HIMSELF SEE IF HE CAN GO) + * *ERRORS: N < 0 + * N > LIMIT + * + * .REPORT SEE RESOURCE + * + * .RESET SEE RESOURCE + * + *; + + PROCEDURE ACQUIRE(M); INTEGER M; + BEGIN + REAL T; + IF M < 1 OR M > INITIAL THEN + ERROR(IF M < 1 THEN 4 ELSE 5, NONE, THIS RES, M, + "R.AQUIRE(N); REF(RES)R; INTEGER N;"); + CURRENT.INTO(THIS QUEUE); + CURRENT.WANTS := M; + IF M > AVAIL OR CURRENT =/= FIRST THEN + BEGIN + IF ZYQTRACE>0 THEN NOTE(4,"AWAITS",NONE,THIS RES,0.0,M); + ZYQPASSIVATE; + WHILE M > AVAIL OR CURRENT =/= FIRST DO + ZYQPASSIVATE; + END; + IF ZYQTRACE>0 THEN NOTE(5,"SEIZES",NONE,THIS RES,0.0,M); + T := TIME; + SINT := SINT + (T-LASTRTIME)*AVAIL; + LASTRTIME := T; + AVAIL := AVAIL - M; + IF AVAIL < EXTREME THEN EXTREME := AVAIL; + CURRENT.OUT; + CURRENT.WANTS := 0; + IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) + THEN FIRST.INSERTAFTERCURRENT; + END***ACQUIRE***; + + PROCEDURE RELEASE(M); INTEGER M; + BEGIN + REAL T; + IF M < 1 OR (AVAIL+M) > INITIAL THEN + ERROR(IF M < 1 THEN 7 ELSE 8, NONE, THIS RES, M, + "R.RELEASE(N); REF(RES)R; INTEGER N;"); + IF ZYQTRACE>0 THEN NOTE(6,"RELEASES",NONE,THIS RES,0,M); + T := TIME; + SINT := SINT + (T-LASTRTIME)*AVAIL; + LASTRTIME := T; + AVAIL := AVAIL + M; + USERS := USERS + 1; + IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) + THEN FIRST.INSERTDELAY0; + END***RELEASE***; + + IF AVAIL < 1 THEN + ERROR(10, NONE, THIS RES, AVAIL, + "NEW RES(TITLE, LIM); TEXT TITLE; INTEGER LIM;"); + JOIN(RESQ); + END***RES***; + + COMMENT------------B I N-----------------------; + + RESOURCE CLASS BIN; + BEGIN + COMMENT + * CLASS BIN CATERS FOR FOR THE PRODUCER/CONSUMER + * COOPERATION : THE PRODUCER GIVES, THE CONSUMER + * TAKES. + * + * VARIABLES: + * .TITLE USER SUPPLIED DESCRIPTIVE TEXT + * .RESETAT TIME OF CREATION, OR LAST RESET + * .OBS NO. OF COMPLETED USAGES(CALLS ON GIVE) + * .NEXT REF TO NEXT TAB IN BINQ + * .AVAIL AMOUNT CURRENTLY FRCE + * .SINT KEEPS TIME-WEIGHTED AVERAGE OF BIN USAGE + * .EXTREME MAXIMUM LEVEL ATTAINED + * INITIAL INITIAL VALUE OF AVAIL + * + * PROCEDURES: + * GIVE(M) INCREMENTS AVAIL BY M + * ACTIVATES FIRST + * *ERRORS : M <= 0 + * + * TAKE(M) BLOCKS CURRENT IF CAN'T PROCEED + * (FIRST IN 0 AND AVAIL > = M) + * WHEN CAN PROCEED, LEAVES Q + * DECREMENTS AVAIL AND ACTIVATES + * FIRST + * *ERROR : M <= 0. + * + * .RESET SEE RESOURCE + * + * .REPORT SEE RESOURCE + *; + + PROCEDURE TAKE(M); INTEGER M; + BEGIN + REAL T; + IF M < 1 THEN + ERROR(6, NONE, THIS BIN, 0, + "B.TAKE(M); REF(BIN)B; INTEGER M;"); + CURRENT.INTO(THIS QUEUE); + CURRENT.WANTS := M; + IF CURRENT =/= FIRST OR M > AVAIL THEN + BEGIN + IF ZYQTRACE>0 THEN NOTE(7,"AWAITS",NONE,THIS BIN,0.0,M); + ZYQPASSIVATE; + WHILE CURRENT =/= FIRST OR M > AVAIL DO + ZYQPASSIVATE; + END; + CURRENT.OUT; + CURRENT.WANTS := 0; + IF ZYQTRACE>0 THEN NOTE(8,"SEIZES",NONE,THIS BIN,0.0,M); + T := TIME; + SINT := SINT + (T-LASTRTIME)*AVAIL; + LASTRTIME := T; + AVAIL := AVAIL - M; + IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) + THEN FIRST.INSERTAFTERCURRENT; + END***TAKE***; + + PROCEDURE GIVE(M); INTEGER M; + BEGIN + REAL T; + IF M < 1 THEN ERROR(9, NONE, THIS BIN, M, + "B.GIVE(N); REF(BIN)B; INTEGER N;"); + IF ZYQTRACE>0 THEN NOTE(9,"GIVES",NONE,THIS BIN,0.0,M); + T := TIME; + SINT := SINT + (T-LASTRTIME)*AVAIL; + LASTRTIME := T; + AVAIL := AVAIL + M; + USERS := USERS + 1; + IF AVAIL > EXTREME THEN EXTREME := AVAIL; + IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) + THEN FIRST.INSERTDELAY0; + END***GIVE***; + + IF AVAIL < 0 THEN ERROR(11, NONE, THIS BIN, AVAIL, + "NEW BIN(TITLE, INIT); TEXT TITLE; INTEGER INIT;"); + JOIN(BINQ); + END***BIN***; + + COMMENT----------------W A I T Q--------------------; + + QUEUE CLASS WAITQ; + BEGIN + REF(QUEUE)MASTERQ; + + PROCEDURE WAIT; + BEGIN + CURRENT.INTO(THIS QUEUE); + IF ZYQTRACE>0 THEN NOTE(14,"WAITS",NONE,THIS QUEUE,0.0,0); + IF MASTERQ.FIRST =/= NONE THEN MASTERQ.FIRST.INSERTDELAY0; + ZYQPASSIVATE; + END***WAIT***; + + REF(ENTITY)PROCEDURE COOPT; + BEGIN + REF(ENTITY)P; + CURRENT.INTO(MASTERQ); + IF LENGTH = 0 OR CURRENT =/= MASTERQ.FIRST THEN + BEGIN + IF ZYQTRACE>0 THEN NOTE(17,"WAITS",NONE,MASTERQ,0.0,0); + ZYQPASSIVATE; + WHILE LENGTH = 0 DO + ZYQPASSIVATE; + P :- CURRENT.SUC; + IF P =/= NONE AND LENGTH > 1 THEN P.INSERTAFTERCURRENT; + END; + CURRENT.OUT; + P :- COOPT :- FIRST; + P.COOPT; + END***COOPT***; + + BOOLEAN PROCEDURE AVAIL(E, C); NAME E, C; + REF(ENTITY)E; BOOLEAN C; + BEGIN + REF(ENTITY)P; + E :- P :- FIRST; + WHILE (IF P == NONE THEN FALSE ELSE NOT C) DO + P :- E :- P.SUC; + AVAIL := P =/= NONE; + END***AVAIL***; + + PROCEDURE FIND(E, C); NAME E, C; + REF(ENTITY)E; BOOLEAN C; + BEGIN + REF(ENTITY)P; + CURRENT.INTO(MASTERQ); + IF NOT AVAIL(E, C) THEN + BEGIN + IF ZYQTRACE > 0 THEN + NOTE(15,"IS BLOCKED",NONE,THIS WAITQ,0.0,0); + ZYQPASSIVATE; + WHILE NOT AVAIL(E, C) DO + BEGIN + IF CURRENT.SUC =/= NONE AND LENGTH > 0 THEN + CURRENT.SUC.INSERTAFTERCURRENT; + ZYQPASSIVATE; + END; + END; + P :- CURRENT.SUC; + CURRENT.OUT; + E.COOPT; + IF ZYQTRACE>0 THEN NOTE(16,"FINDS",E,THIS WAITQ,0.0,0); + IF P =/= NONE AND LENGTH > 0 THEN P.INSERTAFTERCURRENT; + END***FIND***; + + MASTERQ :- NEW NOQUEUE(TITLE); + MASTERQ.JOIN(WAITQQ); + JOIN(WAITQQ); + END***WAITQ***; + + COMMENT---------------C O N D Q-------------------; + + QUEUE CLASS CONDQ; + BEGIN + COMMENT + * CONDQ SUPPLIES THE WAITUNTIL CAPABILITY TO DEMOS. + * AN ENTITY WAITING UNTIL TESTS THE CONDITION AT + * ONCE: IF TRUE, IT PROCEEDS WITHOUT DELAY. + * OTHERWISE IT IS DELAYED UNTIL SIGNALLED TO GO ON. + * IF ALL IS SET, SIGNAL CHECKS EACH AND EVERY ENTITY + * WAITING UNTIL. ELSE ONLY THOSE AT THE HEAD OF THE + * QUEUE ARE TESTED. + * + * VARIABLES: + * .AS QUEUE + * ALL SIGNAL TESTS ALL WAITING ENTITIES IF SET + * + * PROCEDURES: + * WAITUNTIL KEEPS AN ENTITY IN THIS CONDQ + * UNTIL THE CONDITION IS FULFILLED + * + * SIGNAL ISSUED BY AN ENTITY ON FREEING SYSTEM + * RESOURCES. TESTS DORMANT ENTITIES + *; + + BOOLEAN ALL; + + PROCEDURE WAITUNTIL(C); NAME C; BOOLEAN C; + BEGIN + CURRENT.INTO(THIS CONDQ); + IF NOT C THEN + BEGIN + IF ZYQTRACE > 0 THEN + NOTE(19,"W'UNTIL IN", NONE,THIS CONDQ,0.0,0); + ZYQPASSIVATE; + WHILE NOT C DO + BEGIN + IF ALL AND CURRENT.SUC =/= NONE THEN + CURRENT.SUC.INSERTAFTERCURRENT; + ZYQPASSIVATE; + END; + IF ZYQTRACE>0 THEN NOTE(20,"LEAVES",NONE,THIS CONDQ,0.0,0); + END; + IF CURRENT.SUC=/=NONE THEN CURRENT.SUC.INSERTAFTERCURRENT; + CURRENT.OUT; + END***WAITUNTIL***; + + PROCEDURE SIGNAL; + BEGIN + IF ZYQTRACE > 0 THEN + NOTE(25, "SIGNALS", NONE, THIS CONDQ, 0.0, 0); + IF LENGTH > 0 THEN FIRST.INSERTDELAY0; + END***SIGNAL***; + + JOIN(CONDQQ); + END***CONDQ***; + + COMMENT----------T R A C I N G R O U T I N E S-------------; + + REAL ZYQNOTELASTT; REF(ENTITY)ZYQNOTELASTE; INTEGER ZYQTRACE; + + PROCEDURE TRACE; + IF ZYQTRACE > 0 THEN ZYQTRACE := ZYQTRACE+1 ELSE + BEGIN OUTF.OUTIMAGE; OUTF.OUTIMAGE; + CLOCKTIME; + BOX("T R A C I N G C O M M E N C E S"); + OUTF.OUTTEXT(" TIME/ CURRENT AND ITS ACTION(S)"); + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + ZYQTRACE := 1; + END***TRACE***; + + PROCEDURE NOTRACE; + IF ZYQTRACE > 1 THEN ZYQTRACE := ZYQTRACE-1 ELSE + BEGIN OUTF.OUTIMAGE; OUTF.OUTIMAGE; + CLOCKTIME; + BOX("T R A C I N G S W I T C H E D O F F"); + ZYQTRACE := 0; + ZYQNOTELASTT := -15.0; + ZYQNOTELASTE :- NONE; + END***NOTRACE***; + + PROCEDURE NOTE(INDEX,ACTION,E,L,T1,N);VALUE ACTION;TEXT ACTION; + INTEGER INDEX, N; REAL T1; REF(ENTITY)E; REF(TAB)L; + BEGIN REAL T; REF(ENTITY)C; + + PROCEDURE INTOUT(N); INTEGER N; + BEGIN INTEGER P; + IF N < 0 THEN + BEGIN + N := -N; + OUTF.OUTCHAR('-'); + END; + P := IF N < 10 THEN 1 ELSE + IF N < 100 THEN 2 ELSE + IF N < 1000 THEN 3 ELSE + IF N < 10000 THEN 4 ELSE + IF N < 100000 THEN 5 ELSE 10; + OUTF.OUTINT(N, P); + END***INTOUT***; + + PROCEDURE REALOUT(X); REAL X; + BEGIN INTEGER P; + IF X < 0 THEN + BEGIN + X := -X; + OUTF.OUTCHAR('-'); + END; + P := IF X < 10.0 THEN 5 ELSE + IF X < 100.0 THEN 6 ELSE + IF X < 1000.0 THEN 7 ELSE + IF X < 10000.0 THEN 8 ELSE + IF X < 100000.0 THEN 9 ELSE 0; + IF P = 0 THEN OUTF.OUTREAL(X, 5, 10) ELSE OUTF.OUTFIX(X, 3, P); + END***REALOUT***; + + SWITCH MESSAGE := M1, M2, M3, M4, M5, M6, M7, M8, M9, + M10,M11,M12,M13,M14,M15,M16,M17,M18, + M19,M20,M21,M22,M23,M24,M25; + T := TIME; + C :- CURRENT; + IF (ABS(T)-ZYQNOTELASTT) > 0.0005 THEN + BEGIN ZYQNOTELASTT := T; + PRINTREAL(T); + END; + IF ZYQNOTELASTE =/= C THEN + BEGIN OUTF.SETPOS(12); + ZYQNOTELASTE :- C; + OUTF.OUTTEXT(C.TITLE); + END; + + OUTF.SETPOS(25); + OUTF.OUTTEXT(ACTION); + OUTF.OUTCHAR(' '); + GOTO MESSAGE(INDEX); + + M1: COMMENT E.COOPT; + M18: COMMENT Q.COOPT - COOPTS; + M23: COMMENT CANCEL(E); + IF E == NONE THEN OUTF.OUTTEXT("NONE~") ELSE + IF E == CURRENT THEN OUTF.OUTTEXT("ITSELF") + ELSE OUTF.OUTTEXT(E.TITLE); + IF L =/= NONE THEN + BEGIN OUTF.OUTTEXT(" FROM "); + OUTF.OUTTEXT(L.TITLE); + END; + GOTO EXIT; + + M2: COMMENT E.SCHEDULE(T); + OUTF.OUTTEXT(E.TITLE); + IF T1 <= 0.0 THEN OUTF.OUTTEXT(" NOW") ELSE + BEGIN OUTF.OUTTEXT(" AT "); + REALOUT(T+T1); + END; + GOTO EXIT; + + M3: COMMENT TERMINATES; + GOTO EXIT; + + M4: COMMENT RES.ACQUIRE - BLOCKED; + M5: COMMENT RES.ACQUIRE - SEIZES; + M6: COMMENT RES.RELEASE - RELEASES; + M7: COMMENT BIN.TAKE - BLOCKED; + M8: COMMENT BIN.TAKE - SEIZES; + M9: COMMENT BIN.GIVE - RELEASES; + INTOUT(N); + IF INDEX=6 OR INDEX=9 THEN OUTF.OUTTEXT(" TO ") + ELSE OUTF.OUTTEXT(" OF "); + OUTF.OUTTEXT(L.TITLE); + GOTO EXIT; + + M16: COMMENT Q.FIND - FINDS; + OUTF.OUTTEXT(E.TITLE); + OUTF.OUTCHAR(' '); + + M14: COMMENT Q.WAIT; + M15: COMMENT Q.FIND - BLOCKED; + M17: COMMENT Q.COOPT - BLOCKED; + OUTF.OUTTEXT("IN "); + + M19: COMMENT Q.WAITUNTIL - WAITS; + M20: COMMENT Q.WAITUNTIL - LEAVES; + M25: COMMENT Q.SIGNAL; + OUTF.OUTTEXT(L.TITLE); + GOTO EXIT; + + M21: COMMENT HOLDS; + REALOUT(T1); + OUTF.OUTTEXT(", UNTIL "); + REALOUT(T+T1); + GOTO EXIT; + + M22: COMMENT ZYQPASSIVATE; + GOTO EXIT; + + M24: COMMENT E.INTERRUPT(N); + OUTF.OUTTEXT(E.TITLE); + OUTF.OUTTEXT(", WITH N = "); + INTOUT(N); + GOTO EXIT; + + M10:M11:M12:M13: + EXIT: OUTF.OUTIMAGE; + END***NOTE***; + + PROCEDURE ERROR(NO, E, Q, N, CALL); + VALUE CALL; INTEGER NO, N; + TEXT CALL; REF(ENTITY)E; REF(TAB)Q; + BEGIN + + PROCEDURE NEXTLINE; + BEGIN + OUTCHAR('.'); + OUTIMAGE; + SYSOUT.SETPOS(9); + END***NEXTLINE***; + + PROCEDURE INTOUT(N); INTEGER N; + BEGIN INTEGER P; + OUTCHAR(' '); + IF N < 0 THEN + BEGIN + N := -N; + OUTCHAR('-'); + END; + P := IF N < 10 THEN 1 ELSE + IF N < 100 THEN 2 ELSE + IF N < 1000 THEN 3 ELSE + IF N < 10000 THEN 4 ELSE + IF N < 100000 THEN 5 ELSE 10; + OUTINT(N, P); + END***INTOUT***; + + PROCEDURE PRINTREAL(X); REAL X; + BEGIN INTEGER P; + OUTCHAR(' '); + IF X < 0 THEN + BEGIN + X := -X; + OUTCHAR('-'); + END; + P := IF X < 10.0 THEN 5 ELSE + IF X < 100.0 THEN 6 ELSE + IF X < 1000.0 THEN 7 ELSE + IF X < 10000.0 THEN 8 ELSE + IF X < 100000.0 THEN 9 ELSE 0; + IF P = 0 THEN OUTREAL(X, 5, 10) ELSE OUTFIX(X, 3, P); + END***PRINTREAL***; + + REF(ENTITY)C; + SWITCH CASE := E1, E2, E3, E4, E5, E6, E7, E8, E9, E10, + E11,E12,E13,E14,E15,E16,E17,E18,E19,E20; + + SYSOUT.SETPOS(23); + OUTTEXT("CLOCK TIME = "); + IF TIME > 99999.0 THEN OUTREAL(TIME, 5, 12) + ELSE OUTFIX(TIME, 3, 10); + OUTIMAGE; + ABORT(FALSE); + + OUTTEXT("**CAUSE : CALL ON '"); + OUTTEXT(CALL); + OUTCHAR('''); + NEXTLINE; + + OUTTEXT("CURRENT == "); + OUTTEXT(CURRENT.TITLE); + NEXTLINE; + GOTO CASE(NO); + + E1: COMMENT E.COOPT; + OUTTEXT("ATTEMPT BY CURRENT TO COOPT '"); + OUTTEXT(E.TITLE); + OUTCHAR('''); + NEXTLINE; + OUTTEXT(E.TITLE); + OUTTEXT(" IS ALREADY COOPTED BY "); + OUTTEXT(E.OWNER.TITLE); + GOTO BLOWUP; + + E2: COMMENT E.INTO(Q); + OUTTEXT("Q == NONE"); + NEXTLINE; + OUTTEXT("ATTEMPT BY CURRENT TO PLACE "); + IF E == CURRENT THEN OUTTEXT("ITSELF") + ELSE OUTTEXT(E.TITLE); + OUTTEXT(" INTO A NULL QUEUE"); + NEXTLINE; + OUTTEXT("STATEMENT IGNORED."); + GOTO CONTINUE; + + E3: COMMENT E.INTO(Q); + OUTTEXT("CURRENT TRIES TO PLACE "); + IF E == CURRENT THEN OUTTEXT("ITSELF") + ELSE OUTTEXT(E.TITLE); + OUTTEXT(" INTO QUEUE '"); + OUTTEXT(Q.TITLE); OUTCHAR('''); + NEXTLINE; + OUTTEXT(E.TITLE); + OUTTEXT(" IS ALREADY IN "); + OUTTEXT(E.CURRENTQ.TITLE); + NEXTLINE; + OUTTEXT(E.TITLE); + OUTTEXT(" LEAVES "); + OUTTEXT(E.CURRENTQ.TITLE); + OUTTEXT(" AND ENTERS "); + IF Q == NONE THEN OUTTEXT("A NULL QUEUE~") + ELSE OUTTEXT(Q.TITLE); + GOTO CONTINUE; + + E4: COMMENT R.ACQUIRE(N) : N < 0; + E5: COMMENT R.ACQUIRE(N) : N > R.LIMIT; + E6: COMMENT B.TAKE(N) : N < 0; + E7: COMMENT R.RELEASE(N) : N < 0; + E8: COMMENT R.RELEASE(N) : N > R.LIMIT; + E9: COMMENT B.GIVE(N) : N < 0; + OUTTEXT("N ="); + INTOUT(N); + NEXTLINE; + IF NO <= 6 THEN OUTTEXT("REQUEST FOR ") + ELSE OUTTEXT("ATTEMPT TO RETURN "); + IF N < 1 THEN OUTTEXT("NON-POSITIVE") + ELSE OUTTEXT("TOO MANY"); + OUTTEXT(" UNITS "); + IF NO <= 6 THEN OUTTEXT("FROM ") ELSE OUTTEXT("TO "); + IF Q IN RES THEN OUTTEXT("RES") ELSE OUTTEXT("BIN"); + OUTCHAR(' '); OUTCHAR('''); + OUTTEXT(Q.TITLE); OUTCHAR('''); + NEXTLINE; + IF Q IN BIN THEN OUTTEXT("SET N > 0") ELSE + BEGIN + OUTTEXT("SET 0 < N <= R.LIMIT (="); + INTOUT(Q QUA RESOURCE.INITIAL); + OUTCHAR(')'); + END; + GOTO BLOWUP; + + E10: COMMENT NEW RES(TITLE, LIMIT); + E11: COMMENT NEW BIN(TITLE, INITIAL SIZE); + IF NO = 10 THEN OUTTEXT("LIMIT OF RES '") + ELSE OUTTEXT("INITIAL SIZE OF BIN '"); + OUTTEXT(Q.TITLE); + OUTTEXT("' ="); + INTOUT(N); + NEXTLINE; + OUTTEXT("IT SHOULD BE "); + IF NO=10 THEN OUTTEXT("POSITIVE") + ELSE OUTTEXT("NON-NEGATIVE"); + OUTCHAR('.'); OUTCHAR(' '); + IF NO=10 THEN OUTTEXT("SET LIMIT > 0") + ELSE OUTTEXT("SET INITIAL SIZE >= 0"); + GOTO BLOWUP; + + E12: COMMENT X.CANCEL : X IDLE; + OUTTEXT("ENTITY '"); + OUTTEXT(E.TITLE); + OUTTEXT("' IS NOT IN THE EVENT LIST."); + OUTIMAGE; + GOTO CONTINUE; + + E13: COMMENT X.CANCEL : X SOLE ENTITY IN EVENT LIST; + OUTTEXT("ATTEMPT TO CANCEL LAST ENTITY IN EVENT LIST"); + GOTO BLOWUP; + + E14: COMMENT E.SCHEDULE(T) : E TERMINATED; + OUTTEXT("E == '"); + OUTTEXT(E.TITLE); + OUTTEXT("' IS TERMINATED AND CANNOT BE SCHEDULED"); + GOTO BLOWUP; + + E15: COMMENT IMPLEMENTATION ERROR; + OUTTEXT("SYSTEM ERROR: PLEASE CONTACT THE "); + OUTTEXT("IMPLEMENTOR, GRAHAM BIRTWISTLE."); + GOTO BLOWUP; + + E16: COMMENT E.SCHEDULE(T): REF(ENTITY)T: REAL T; + OUTTEXT("E == '"); + OUTTEXT(E.TITLE); + OUTTEXT("' IS ALREADY SCHEDULED."); + GOTO JOIN; + + E17: COMMENT E.CANCEL: REF(ENTITY)E; + OUTTEXT("ATTEMPT TO CANCEL NON-SCHEDULED ENTITY E == '"); + OUTTEXT(E.TITLE); OUTCHAR('''); + JOIN: NEXTLINE; + OUTTEXT("STATEMENT IGNORED."); + GOTO CONTINUE; + + E18: COMMENT T.JOIN(R): REF(TAB)T: REF(REPORTQ)R; + OUTTEXT("TAB '"); + OUTTEXT(Q.TITLE); + OUTTEXT("' TRIES TO JOIN A NULL REPORTQ"); + NEXTLINE; + OUTTEXT("T WILL NOT BE REPORTED UNLESS YOU "); + OUTTEXT(" CALL 'T.REPORT'."); + GOTO CONTINUE; + + E19: COMMENT NEW HISTOGRAM(T, L, U, N); + OUTTEXT("ATTEMPT TO CREATE ILLEGAL HISTOGRAM '"); + OUTTEXT(Q.TITLE); + OUTCHAR('''); + NEXTLINE; + OUTTEXT("LOWER BOUND = "); + PRINTREAL(Q QUA HISTOGRAM.LOWER); + NEXTLINE; + OUTTEXT("UPPER BOUND = "); + PRINTREAL(Q QUA HISTOGRAM.UPPER); + NEXTLINE; + OUTTEXT("UPPER MUST BE GREATER THAN LOWER"); + NEXTLINE; + OUTTEXT("ACTION: LOWER <- 0.0, AND UPPER <- 100.0."); + GOTO CONTINUE; + + E20: COMMENT NEW EMPIRICAL(T, 1); + OUTTEXT("ATTEMPT TO CREATE EMPIRICAL OBJECT '"); + OUTTEXT(Q.TITLE); OUTCHAR('''); + NEXTLINE; + OUTTEXT("SIZE = 1. SET SIZE > 1"); + GOTO BLOWUP; + + BLOWUP: OUTCHAR('.'); OUTIMAGE; + ABORT(TRUE); + CONTINUE: OUTIMAGE; OUTIMAGE; + END***ERROR***; + + PROCEDURE ABORT(B); BOOLEAN B; + BEGIN + INTEGER L; + IF B THEN L := 27 ELSE L := 28; + OUTTEXT(MINUSES); OUTIMAGE; + OUTTEXT(MINUSES.SUB(1, L)); + IF B THEN OUTTEXT("PROGRAM ABORTED") + ELSE OUTTEXT("SERIOUS ERROR"); + OUTTEXT(MINUSES.SUB(1, L)); OUTIMAGE; + OUTTEXT(MINUSES); OUTIMAGE; + IF B THEN + BEGIN + IF INF =/= SYSIN AND INF.IMAGE =/= NOTEXT THEN INF.CLOSE; + IF OUTF =/= SYSOUT AND OUTF.IMAGE =/= NOTEXT THEN OUTF.CLOSE; + L := 0; + L := 1/L; + END; + END***ABORT***; + + COMMENT---------S N A P P I N G R O U T I N E S------------; + + PROCEDURE REPORT; + BEGIN REF(REPORTQ)R; + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + CLOCKTIME; + BOX("R E P O R T"); + FOR R:-DISTQ,EMPQ,ACCUMQ,COUNTQ,TALLYQ,HISTOQ,REGRESSQ, + RESQ,BINQ,QUEUEQ,WAITQQ,CONDQQ DO + IF R.FIRST =/= NONE THEN + BEGIN + OUTF.OUTIMAGE; + OUTF.OUTIMAGE; + R.REPORT; + END; + END***REPORT***; + + PROCEDURE NOREPORT; + ZYQREPORT := FALSE; + + PROCEDURE RESET; + BEGIN REF(REPORTQ)R; + FOR R:-DISTQ,EMPQ,ACCUMQ,COUNTQ,TALLYQ,HISTOQ,REGRESSQ, + RESQ,BINQ,QUEUEQ,WAITQQ,CONDQQ DO + IF R.FIRST =/= NONE THEN R.RESET; + END***RESET***; + + PROCEDURE SNAPQUEUES; + BEGIN REF(TAB)Q; INTEGER K; REF(ENTITY)E; + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + CLOCKTIME; + BOX("L I S T O F P A S S I V E O B J E C T S"); + FOR Q :- QUEUEQ.FIRST, CONDQQ.FIRST, WAITQQ.FIRST DO + BEGIN + WHILE Q =/= NONE DO + BEGIN + Q QUA QUEUE.LIST; + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + Q :- Q.NEXT; + END; + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + END; + END***SNAPQUEUES***; + + PROCEDURE SNAPSQS; + BEGIN INTEGER K; + PROCEDURE TRAVERSE(R); REF(ENTITY)R; + BEGIN + IF R.LL =/= NONE THEN TRAVERSE(R.LL); + IF R.RL =/= NONE THEN TRAVERSE(R.RL); + K := K+1; OUTF.OUTINT(K, 5); R.LIST; + END***TRAVERSE***; + + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + CLOCKTIME; + BOX("E V E N T L I S T"); + OUTF.OUTTEXT(" N/ EV. TIME/OBJ. TITLE / "); + OUTF.OUTTEXT("LL BL RL"); + OUTF.OUTIMAGE; + TRAVERSE(ROOT); + OUTF.OUTIMAGE; OUTF.OUTIMAGE; + END***SNAPSQS***; + + ENTITY CLASS MAINPROGRAM; + BEGIN + LOOP: + DETACH; + GOTO LOOP; + END***MAINPROGRAM***; + + CLASS ZYQENTTITLE(T); TEXT T; + BEGIN INTEGER N, L; + REF(ZYQENTTITLE)NEXTTITLE; + NEXTTITLE :- ZYQENTNAMES; + ZYQENTNAMES :- THIS ZYQENTTITLE; + L := T.LENGTH; + N := 1; + END***ZYQENTTITLE***; + + COMMENT--------LOCAL VARIABLES AND THEIR INITIALISATIONS ----; + + REF(REPORTQ)EMPQ, TALLYQ, ACCUMQ, HISTOQ, COUNTQ, DISTQ; + REF(REPORTQ)RESQ, BINQ, QUEUEQ, CONDQQ, WAITQQ, REGRESSQ; + TEXT TALLYHEADING, ACCUMHEADING, DISTHEADING; + TEXT HEADINGRTN, STARS, MINUSES, ZYQREASON, ZYQRECVRY; + TEXT RESHEADING, BINHEADING, QHEADING; + TEXT ARRAY DISTTYPE(0:9); + INTEGER ZYQSEED, ZYQMODULO; + REF(INFILE)INF; + REF(OUTFILE)OUTF; + REF(ZYQENTTITLE)ZYQENTNAMES; + REF(MAINPROGRAM)DEMOS; + REF(ENTITY)ROOT, CURRENT; + REAL NOW, SIMPERIOD, EPSILON; + BOOLEAN ZYQREPORT; + + ZYQREPORT := TRUE; + + EPSILON := 0.00001; + + HEADINGRTN :-COPY("TITLE / (RE)SET/ OBS"); + ACCUMHEADING:-COPY("/ AVERAGE/EST.ST.DV/ MINIMUM/ MAXIMUM"); + DISTHEADING :-COPY("/TYPE / A/ B/ SEED"); + TALLYHEADING:-ACCUMHEADING; + RESHEADING :-COPY("/ LIM/ MIN/ NOW/ % USAGE/ AV. WAIT/QMAX"); + BINHEADING :-COPY("/INIT/ MAX/ NOW/ AV. FREE/ AV. WAIT/QMAX"); + QHEADING :-COPY("/ QMAX/ QNOW/ Q AVERAGE/ZEROS/ AV. WAIT"); + + DISTTYPE(0) :-COPY("UNDEFINED"); + DISTTYPE(1) :-COPY("NORMAL"); DISTTYPE(2) :-COPY("UNIFORM"); + DISTTYPE(3) :-COPY("ERLANG"); DISTTYPE(4) :-COPY("RANDINT"); + DISTTYPE(5) :-COPY("NEGEXP"); DISTTYPE(6) :-COPY("POISSON"); + DISTTYPE(7) :-COPY("DRAW"); DISTTYPE(8) :-COPY("CONSTANT"); + DISTTYPE(9) :-COPY("EMPIRICAL"); + + ACCUMQ :- NEW REPORTQ("A C C U M U L A T E S", + HEADINGRTN, ACCUMHEADING); + COUNTQ :- NEW REPORTQ("C O U N T S", BLANKS(20), HEADINGRTN); + DISTQ :- NEW REPORTQ("D I S T R I B U T I O N S", + HEADINGRTN, DISTHEADING ); + EMPQ :- NEW REPORTQ("E M P I R I C A L S", NOTEXT, NOTEXT); + REGRESSQ:-NEW REPORTQ("R E G R E S S I O N S",NOTEXT,NOTEXT); + HISTOQ :- NEW REPORTQ("H I S T O G R A M S", NOTEXT, NOTEXT); + TALLYQ :- NEW REPORTQ("T A L L I E S",HEADINGRTN,TALLYHEADING); + RESQ :- NEW REPORTQ("R E S O U R C E S",HEADINGRTN, + RESHEADING); + BINQ :- NEW REPORTQ("B I N S",HEADINGRTN,BINHEADING); + QUEUEQ :- NEW REPORTQ("Q U E U E S",HEADINGRTN,QHEADING); + CONDQQ :- NEW REPORTQ("C O N D I T I O N Q U E U E S", + HEADINGRTN, QHEADING); + WAITQQ :- NEW REPORTQ("W A I T Q U E U E S", + HEADINGRTN, QHEADING); + + STARS :- BLANKS(70); + WHILE STARS.MORE DO + STARS.PUTCHAR('*'); + + MINUSES :- BLANKS(70); + WHILE MINUSES.MORE DO + MINUSES.PUTCHAR('-'); + + INF :- SYSIN; + OUTF :- SYSOUT; + ZYQREASON :- COPY("**REASON : "); + ZYQRECVRY :- COPY("**RECOVERY : "); + ZYQMODULO := 67099547; ZYQSEED := 907; + NOW := -10&20; + ZYQNOTELASTT := -15.0; + CURRENT :- ROOT :- DEMOS :- NEW MAINPROGRAM("DEMOS"); + DEMOS.EVTIME := 0.0; + DEMOS.TITLE :- DEMOS.TITLE.SUB(1, 5); + INNER; + WHILE (IF DEMOS==ROOT THEN FALSE ELSE + DEMOS.BL.EVTIME<=DEMOS.EVTIME) DO + BEGIN + HOLD(0.0); + END; + IF ZYQREPORT THEN REPORT; + IF INF =/= SYSIN AND INF.IMAGE =/= NOTEXT THEN INF.CLOSE; + IF OUTF =/= SYSOUT AND OUTF.IMAGE =/= NOTEXT THEN OUTF.CLOSE; + END***DEMOS***; \ No newline at end of file diff --git a/samples/Simula/klant1.sim b/samples/Simula/klant1.sim new file mode 100644 index 0000000000..029519bfc1 --- /dev/null +++ b/samples/Simula/klant1.sim @@ -0,0 +1,29 @@ +comment License: program borrowed from S-PORT https://github.com/portablesimula/S-PORT; +begin +! klant 1 +beschrijving van een winkel +copyright H.G.Sol; + +external class Demos; + +Demos begin + Entity class Klant; + begin + Bediendes.Acquire(1); + Hold(5); + Bediendes.Release(1); + Kassieres.Acquire(1); + Hold(2); + Kassieres.Release(1); + end; + ref(Res) Bediendes,Kassieres; + Bediendes:- new Res("bediendes",2); + Kassieres:- new Res("kassieres",1); + Trace; + new Klant("klant").Schedule(1); + new Klant("klant").Schedule(2); + new Klant("klant").Schedule(5); + new Klant("klant").Schedule(6); + Hold(40); +end; +end; \ No newline at end of file diff --git a/samples/Simula/klant4.sim b/samples/Simula/klant4.sim new file mode 100644 index 0000000000..a2a31acdb4 --- /dev/null +++ b/samples/Simula/klant4.sim @@ -0,0 +1,67 @@ +comment License: program borrowed from S-PORT https://github.com/portablesimula/S-PORT; +begin +external class demos; +! klant 4 +zelfbediening en artikelvoorraad +copyright H.G.Sol; +Demos begin + Entity class Klant; + begin + Karren.Acquire(1); + Bier.Take(Hoevelheid.Sample); + Hold(Paktijd.Sample); + if Vragen.Sample then + begin + Bediendes.Acquire(1); + Hold(Helptijd.Sample); + Bediendes.Release(1); + end; + Kassieres.Acquire(1); + Hold(Betaaltijd.Sample); + Kassieres.Release(1); + Karren.Release(1); + end; + + Entity class Bierleverantie(Frequentie); + real Frequentie; + begin + if Bier.Avail < 100 then + Bier.Give(300); + Hold(1/Frequentie); + Repeat; + end; + + Entity class Klantengenerator(Tussentijd); + ref(Rdist)Tussentijd; + begin + new Klant("klant").Schedule(0); + Hold(Tussentijd.Sample); + Repeat; + end; + + ref(Res) Karren,Bediendes,Kassieres; + ref(Bin) Bier; + ref(Rdist) Paktijd,Helptijd, Betaaltijd, Tussentijd; + ref(Idist) Hoevelheid; + ref(Bdist) Vragen; + + trace; + + Karren:- new Res("karren",10); + Bediendes:- new Res("bediendes",2); + Kassieres:- new Res("kassieres",2); + Bier:- new Bin("bier",150); + Tussentijd:- new Negexp("tt",.5); + Paktijd:- new Normal("pt",5,.5); + Helptijd:- new Normal("ht",2,.5); + Betaaltijd:- new Negexp("bt",.5); + Hoevelheid:- new Randint("hv",1,12); + Vragen:- new Draw("vr",.3); + + Hold(9*60); + Reset; + new Bierleverantie("bl",1/40).Schedule(30); + new Klantengenerator("kg",Tussentijd).Schedule(0); + Hold(18*60 - 9*60); +end; +end; diff --git a/samples/Simula/powers.sim b/samples/Simula/powers.sim new file mode 100644 index 0000000000..bcbc95ee79 --- /dev/null +++ b/samples/Simula/powers.sim @@ -0,0 +1,91 @@ +comment License: program borrowed from S-PORT https://github.com/portablesimula/S-PORT; +begin +comment this program computes the "best" powers of ten re U1100; +integer lower, upper, minlim, ee, pp; + +procedure outpower(exp_param,power_param); name exp_param; +integer exp_param,power_param; +begin + integer exp, power; + integer array digits(lower:upper); + integer max,min,digit; + +procedure divide(exp); integer exp; +begin integer i, rem; +while exp>0 do begin + exp := exp-1; rem := 0; + i := max+1; + while i>min do begin + i := i-1; + digit := digits(i)//2; + if digits(i)-2*digit>0 then digits(i-1):=digits(i-1)+10; + digits(i):=digit; + end; + if digits(min-1)>0 then begin + min := min-1; digits(min) := 5; + end; + if digits(max)=0 then max:=max-1; +end while; +if max<>0 then begin exp_param:=exp_param+1; goto RETRY end; +end divide; + +procedure output; +begin integer i, j, first, last, carry, borrow; +! the number to be output is in digits(min:max); + last := min; + first := max+1; + while first>min do begin + first := first-1; + carry:=borrow:=0; + i := last-1; + while i10 then begin carry:=1; digit:=digit-10 end + else carry:=0; + digit:=digits(i-1)-digit-borrow; + if digit<0 then begin borrow:=1; digit:=digit+10 end + else borrow:=0; + digits(i-1):=digit; + end; + digits(first) := digits(first)-borrow-carry; + if digits(last)<>0 then last:=last-1; + end first; + if digits(0)<4 then begin exp_param:=exp_param-1; goto RETRY end; + if digits(-20)=7 + then begin + outint(exp_param,4); outint(power_param,4); outchar(':'); + for i:= -20 step -1 until -22 do outchar(char(rank('0')+digits(i))); + outimage; + end + else if digits(-20)=0 + then begin + outint(exp_param,4); outint(power_param,4); outchar(':'); + for i:= -20 step -1 until -22 do outchar(char(rank('0')+digits(i))); + outimage; + end if; +end output; + +RETRY: ! here when the exponent has been corrected; + exp := exp_param; power := power_param; + max:= power+1; !one sign. digit only; + min:= max; !one sign. digit only; + digits(max):=1; + divide(exp); + output; +end outpower; + +!outtext("51634306575354226427"); ! outimage; +!outpower(665,200); +!outpower(608,183); ! 75 - denne er best; +!outtext("44446551131230337166"); ! outimage; +!outpower(326,098); ! 74 - denne er best; +!outtext("42154166127714446321"); outimage; +!outpower(167,050); ! 76 - denne er best; + +ee := 1026; pp := 308; +while pp>0 do +begin upper := pp; lower := -3.4*upper; + ee := ee-3; pp := pp-1; outpower(ee,pp) end; + +end; \ No newline at end of file From 86957926b094883a5f1038b288b578a3bc99502e Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Mon, 25 Nov 2024 22:58:00 +0100 Subject: [PATCH 6/8] Add sample of a .sim file that would make sense to highlight with the YAML highlighter (JSON is also valid YAML) --- samples/YAML/filenames/something.sim | 218 +++++++++++++++++++++++++++ 1 file changed, 218 insertions(+) create mode 100644 samples/YAML/filenames/something.sim diff --git a/samples/YAML/filenames/something.sim b/samples/YAML/filenames/something.sim new file mode 100644 index 0000000000..484709f20b --- /dev/null +++ b/samples/YAML/filenames/something.sim @@ -0,0 +1,218 @@ +{ + "version": "1.8.1", + "globalBitSize": 1, + "clockSpeed": 1, + "circuits": [ + { + "name": "xor", + "components": [ + { + "name": "com.ra4king.circuitsim.gui.peers.gates.NotGatePeer", + "x": 23, + "y": 9, + "properties": { + "Label location": "NORTH", + "Negate 0": "No", + "Label": "", + "Direction": "EAST", + "Bitsize": "1" + } + }, + { + "name": "com.ra4king.circuitsim.gui.peers.gates.NotGatePeer", + "x": 23, + "y": 18, + "properties": { + "Label location": "NORTH", + "Negate 0": "No", + "Label": "", + "Direction": "EAST", + "Bitsize": "1" + } + }, + { + "name": "com.ra4king.circuitsim.gui.peers.gates.AndGatePeer", + "x": 26, + "y": 9, + "properties": { + "Negate 1": "No", + "Label location": "NORTH", + "Negate 0": "No", + "Number of Inputs": "2", + "Label": "", + "Direction": "EAST", + "Bitsize": "1" + } + }, + { + "name": "com.ra4king.circuitsim.gui.peers.gates.AndGatePeer", + "x": 26, + "y": 16, + "properties": { + "Negate 1": "No", + "Label location": "NORTH", + "Negate 0": "No", + "Number of Inputs": "2", + "Label": "", + "Direction": "EAST", + "Bitsize": "1" + } + }, + { + "name": "com.ra4king.circuitsim.gui.peers.gates.OrGatePeer", + "x": 34, + "y": 12, + "properties": { + "Negate 1": "No", + "Label location": "NORTH", + "Negate 0": "No", + "Number of Inputs": "2", + "Label": "", + "Direction": "EAST", + "Bitsize": "1" + } + }, + { + "name": "com.ra4king.circuitsim.gui.peers.wiring.PinPeer", + "x": 13, + "y": 10, + "properties": { + "Label location": "WEST", + "Label": "a", + "Is input?": "Yes", + "Direction": "EAST", + "Bitsize": "1" + } + }, + { + "name": "com.ra4king.circuitsim.gui.peers.wiring.PinPeer", + "x": 13, + "y": 17, + "properties": { + "Label location": "WEST", + "Label": "b", + "Is input?": "Yes", + "Direction": "EAST", + "Bitsize": "1" + } + }, + { + "name": "com.ra4king.circuitsim.gui.peers.wiring.PinPeer", + "x": 44, + "y": 13, + "properties": { + "Label location": "EAST", + "Label": "c", + "Is input?": "No", + "Direction": "WEST", + "Bitsize": "1" + } + } + ], + "wires": [ + { + "x": 15, + "y": 11, + "length": 2, + "isHorizontal": true + }, + { + "x": 15, + "y": 18, + "length": 3, + "isHorizontal": true + }, + { + "x": 17, + "y": 10, + "length": 1, + "isHorizontal": false + }, + { + "x": 17, + "y": 10, + "length": 6, + "isHorizontal": true + }, + { + "x": 17, + "y": 11, + "length": 6, + "isHorizontal": false + }, + { + "x": 17, + "y": 17, + "length": 9, + "isHorizontal": true + }, + { + "x": 18, + "y": 12, + "length": 6, + "isHorizontal": false + }, + { + "x": 18, + "y": 12, + "length": 8, + "isHorizontal": true + }, + { + "x": 18, + "y": 18, + "length": 1, + "isHorizontal": false + }, + { + "x": 18, + "y": 19, + "length": 5, + "isHorizontal": true + }, + { + "x": 30, + "y": 11, + "length": 1, + "isHorizontal": true + }, + { + "x": 30, + "y": 18, + "length": 1, + "isHorizontal": true + }, + { + "x": 31, + "y": 11, + "length": 2, + "isHorizontal": false + }, + { + "x": 31, + "y": 13, + "length": 3, + "isHorizontal": true + }, + { + "x": 31, + "y": 15, + "length": 3, + "isHorizontal": true + }, + { + "x": 31, + "y": 15, + "length": 3, + "isHorizontal": false + }, + { + "x": 38, + "y": 14, + "length": 6, + "isHorizontal": true + } + ] + } + ] +} \ No newline at end of file From e7f3f44d8088bdc293914f2f73c5580ea5434465 Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Tue, 26 Nov 2024 11:32:05 +0100 Subject: [PATCH 7/8] Removed samples that are too big to show in a git diff on GitHub --- samples/Simula/deasm.sim | 642 ---------- samples/Simula/demos.sim | 2628 -------------------------------------- 2 files changed, 3270 deletions(-) delete mode 100644 samples/Simula/deasm.sim delete mode 100644 samples/Simula/demos.sim diff --git a/samples/Simula/deasm.sim b/samples/Simula/deasm.sim deleted file mode 100644 index 2d6e23f6e1..0000000000 --- a/samples/Simula/deasm.sim +++ /dev/null @@ -1,642 +0,0 @@ -comment License: program borrowed from S-PORT https://github.com/portablesimula/S-PORT; -begin Boolean Listing; ! Output Listing Indicator ; - Ref(InByteFile) Inpt; ! NRF-Input File ; - Ref(OutFile) Oupt; ! Created Output File ; - - Text array Names(1:100); ! Global Name Table ; - Integer nnam; ! Table length ; - - Ref(SEGDEF) array Seg(1:100); ! Global Segment Table ; - Integer nseg; ! Table length ; - - Ref(GRPDEF) array Grp(1:100); ! Global Group Table ; - Integer ngrp; ! Table length ; - - Ref(EXTDEF) array Ext(1:100); ! Global External Table ; - Integer next; ! Table length ; - - Ref(Thread) array ImpTarget(0:3); ! Implicit Target Table ; - Ref(Thread) array ImpFrame(0:3); ! Implicit Frame Table ; - - Integer CurSeg; ! Current Segment Index ; - Integer CurOfst; ! Current Segment Offset ; - - Integer Sequ; ! Input byte number ; - Integer Lng; ! Length of current record ; - Integer ChkSum; ! Check-sum of current record ; - Integer Start; ! Start byte number ; - Integer Count; ! Count byte number ; - Integer Code; ! Current Record Code ; - - Class Thread(Code,Val); integer Code,Val; - begin end; - -%page - Text Procedure Prompt(ms,meny); value ms,meny; text ms,meny; - begin text R; L: OutText(Cat(ms,": ")); BreakOutImage; inimage; - R:-SysIn.image.strip; R.SetPos(R.length); - if if R==notext then true else R.GetChar='?' then - begin OutText("Input Format: "); OutText(meny); - OutImage; goto L; - end; Prompt:-copy(R); SysIn.SetPos(SysIn.length+1); - OutText(R); OutImage; - end *** Prompt ***; - - Procedure InputFile; - begin text F; S: F:-Prompt("Input File","Standard NORD File Format"); - F:-Cat(F,":OBJ"); Inpt:-new InByteFile(F); - if not Inpt.Open then - begin OutImage; OutText("The File """); OutText(F); - OutText(""" does not exist or is not accessible"); - OutImage; OutImage; goto S; - end; - end; - - Procedure OutputFile; - begin text F; S: F:-Prompt("Output File","Standard NORD File Format"); - if F="TERM" then Oupt:-SysOut else - begin F:-Cat(F,":SYMB"); Oupt:-new OutFile(F); - if not Oupt.Open(Blanks(100)) then - begin OutImage; OutText("The File """); OutText(F); - OutText(""" does not exist or is not accessible"); - OutImage; OutImage; goto S; - end; - end; - end; - - Procedure ERROR(msg); value msg; text msg; - begin OutImage; OutText("Byte"); OutInt(Sequ,6); - OutText(": ***ERROR*** "); OutText(msg); OutImage; - end; - - Text Procedure Cat(t1,t2); value t1,t2; text t1,t2; - begin text t; Cat:-t:-Blanks(t1.length+t2.length); - t:=t1; t.Sub(t1.length+1,t2.length):=t2; - end *** Cat ***; - -%page - - Integer Procedure InByte; - begin integer n; InByte:=n:=Inpt.InByte; - Lng:=Lng-1; Sequ:=Sequ+1; - ChkSum:=mod(ChkSum+n,256); - end; - - Procedure OutByte(n); integer n; inspect Oupt do - begin integer a,b,c; a:=n//64; - b:=mod(n,64)//8; c:=mod(n,8); - OutChar(' '); OutInt(a,1); OutInt(b,1); OutInt(c,1); - end; - - Procedure PrtInt(n); integer n; - begin if n<10 then Oupt.OutInt(n,1) - else if n<100 then Oupt.OutInt(n,2) - else if n<1000 then Oupt.OutInt(n,3) - else if n<10000 then Oupt.OutInt(n,4) - else if n<100000 then Oupt.OutInt(n,5) - else Oupt.OutInt(n,12) - end; - - Procedure PrtNam(n); integer n; - begin if n>0 and n<=nnam then Oupt.OutText(Names(n)) - else Oupt.OutText("????"); - end; - - Procedure PrtSeg(n); integer n; - begin Oupt.OutText("Seg"); PrtInt(n); Oupt.OutChar(':'); - if n>0 and n<=nseg then PrtNam(Seg(n).SegmentNameIndex) - else Oupt.OutText("????"); - end; - - Procedure PrtGrp(n); integer n; - begin Oupt.OutText("Grp"); PrtInt(n); Oupt.OutChar(':'); - if n>0 and n<=ngrp then PrtNam(Grp(n).GroupNameIndex) - else Oupt.OutText("????"); - end; - - Procedure PrtExt(n); integer n; - begin Oupt.OutText("Ext"); PrtInt(n); Oupt.OutChar(':'); - if n>0 and n<=next then Oupt.OutText(Ext(n).ExternalName) - else Oupt.OutText("????"); - end; - - Procedure PrtIdent(Code,Val); integer Code,Val; - begin if Code=0 then PrtSeg(Val) - else if Code=1 then PrtGrp(Val) - else if Code=2 then PrtExt(Val) - else if Code=3 then begin Oupt.OutText("Abs:"); PrtInt(Val) end - else begin Oupt.OutText("????:"); PrtInt(Code); - Oupt.OutChar(':'); PrtInt(Val); - end; - end; - -%page - - Integer Procedure ScanByte(id); text id; - begin integer n; n:=InByte; - Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); - OutByte(n); ScanByte:=n; - end; - - Procedure ScanBytes(id,n); text id; integer n; - begin Oupt.OutImage; Oupt.SetPos(19); Oupt.OutText(id); - for n:=n-1 while n >= 0 do - begin if Oupt.Pos > 63 then - begin Oupt.OutImage; Oupt.SetPos(24) end; - OutByte(InByte); - end; - end; - - Integer Procedure ScanIndex(id); text id; - begin integer n; n:=InByte; - Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); - if n>127 then n:=(n-128)*256+InByte; - OutByte(n); ScanIndex:=n; - end; - - Text Procedure ScanName(id); text id; - begin integer n; text t; character c; n:=InByte; - Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); - ScanName:-t:-blanks(n); - for n:=n-1 while n>=0 do - begin c:=Char(InByte); OutChar(c); t.PutChar(c) end; - end; - - Integer Procedure ScanWord(id); text id; - begin integer n; n:=InByte; n:=InByte*256+n; - Oupt.OutChar(' '); Oupt.OutText(id); Oupt.OutChar(':'); - PrtInt(n); ScanWord:=n; - end; - - Procedure ScanChk; - begin if Lng > 1 then ScanBytes("Tail:",Lng-1); InByte; - if ChkSum <> 0 then ERROR("Check-Sum Error"); - ChkSum:=0; - end; -%title *** L o g i c a l A d d r e s s *** - - Class LogicalAddr; - begin integer n,F,FRAME,T,P,TARGT,FDAT,TDAT,TDIS; - if Lng<2 then begin ERROR("LogicalAddr-1"); goto E end; - Oupt.OutImage; Oupt.SetPos(18); - n:=InByte; TARGT:=mod(n,4); n:=n//4; - P:=mod(n,2); n:=n//2; T:=mod(n,2); n:=n//2; - FRAME:=mod(n,8); F:=n//8; - Oupt.OutText(" ADDRESS'); - end; - - Procedure PrtAddr(x); ref(LogicalAddr) x; inspect x do - begin ref(Thread) ThT,ThF; - if T=0 then PrtIdent(TARGT,TDAT) - else begin ThT:-ImpTarget(TARGT); PrtIdent(ThT.Code,ThT.Val) end; - if P=0 then begin Oupt.OutChar('+'); PrtInt(TDIS) end; - Oupt.OutText("(in "); - if F=1 then - begin ThF:-ImpFrame(FRAME); PrtIdent(ThF.Code,ThF.Val) end - else begin if FRAME<4 then PrtIdent(FRAME,FDAT) - else if FRAME=4 then PrtIdent(0,CurSeg) - else if FRAME=5 then - begin if T=1 then PrtIdent(ThT.Code,ThT.Val) - else PrtIdent(TARGT,TDAT); - end - else if FRAME=6 then Oupt.OutText("none") - else Oupt.OutText("????"); - end; - Oupt.OutChar(')'); - end; -%title *************************** - - Procedure THEADR; - begin Lng:=ScanWord("THEADR=80H Lng"); - ScanName("ModuleName"); - end; - - Procedure MODEND; - begin integer n,Mattr,L; ref(LogicalAddr) adr; - Lng:=ScanWord("MODEND=8AH Lng"); - n:=InByte; Mattr:=n//64; L:=mod(n,2); - OutText(" ModuleType:"); PrtInt(Mattr); - OutText(" L:"); PrtInt(L); - if Mattr=1 or Mattr=3 then - begin !*** Start Address ***; - if L=1 then - begin adr:-new LogicalAddr; - Oupt.OutImage; Oupt.SetPos(18); - Oupt.OutText("Start Address: "); PrtAddr(adr); - end - else begin if Lng<5 then begin ERROR("MODEND"); goto E end; - ScanWord("FrameNumber"); - ScanWord("Offset"); - end; - end; - E:end; - - Procedure LNAMES; - begin Lng:=ScanWord("LNAMES=96H Lng"); - while Lng > 1 do - begin if Oupt.Pos > 60 then - begin Oupt.OutImage; Oupt.SetPos(18) end; - nnam:=nnam+1; Names(nnam):-ScanName("Name"); - end; - end; -%page - - Class SEGDEF; - begin integer n,A,C,B,P; - integer FrameNumber,Offset,LTL,MaxLng,SegLng; - integer SegmentNameIndex,ClassNameIndex,OverlayNameIndex; - Lng:=ScanWord("SEGDEF=98H Lng"); - n:=InByte; P:=mod(n,2); n:=n//2; - B:=mod(n,2); n:=n//2; c:=mod(n,8); A:=n//8; - OutText(" A:"); Prtint(A); OutText(" C:"); Prtint(C); - OutText(" B:"); Prtint(B); OutText(" P:"); Prtint(P); - if A=0 or A=5 then - begin Oupt.OutImage; Oupt.SetPos(18); - FrameNumber:=ScanWord("FrameNumber"); - Offset:=ScanByte("Offset"); - end - else if A=6 then - begin Oupt.OutImage; Oupt.SetPos(18); - LTL:=ScanByte("LTL"); - MaxLng:=ScanWord("MaxSegmentLength"); - Offset:=ScanWord("GroupOffset"); - end; - SegLng:=ScanWord("SegmentLength"); - if Lng>1 then - begin Oupt.OutImage; Oupt.SetPos(18); - SegmentNameIndex:=ScanIndex("SegmentNameIndex"); - if Lng>1 then ClassNameIndex:=ScanIndex("ClassNameIndex"); - if Lng>1 then OverlayNameIndex:=ScanIndex("OverlayNameIndex"); - end; - nseg:=nseg+1; Seg(nseg):-this SEGDEF; - end; - - Class GRPDEF; - begin integer GroupNameIndex; - Lng:=ScanWord("GRPDEF=9AH Lng"); - GroupNameIndex:=ScanIndex("GroupNameIndex"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - ngrp:=ngrp+1; Grp(ngrp):-this GRPDEF; - end; - - Class EXTDEF; - begin text ExternalName; integer TypeIndex; - Lng:=ScanWord("EXTDEF=8CH Lng"); - while Lng > 2 do - begin ExternalName:-ScanName("ExternalName"); - TypeIndex:=ScanIndex("TypeIndex"); - end; - next:=next+1; Ext(next):-this EXTDEF; - end; - - Procedure PUBDEF; - begin integer grp,seg; Lng:=ScanWord("PUBDEF=90H Lng"); - grp:=ScanIndex("GroupIndex"); - seg:=ScanIndex("SegmentIndex"); - if seg=0 then ScanWord("FrameNumber"); - while Lng > 2 do - begin Oupt.OutImage; Oupt.SetPos(18); - ScanName("PublicName"); - ScanWord("PublicOffset"); - ScanIndex("TypeIndex"); - end; - end; -%page - - Procedure LIDATA; - begin - Procedure ScanBlock; - begin integer rep,blk,n; - Oupt.OutImage; Oupt.SetPos(18); - rep:=ScanWord("RepeatCount"); - blk:=ScanWord("BlockCount"); - if blk = 0 then - begin if Lng < 2 then - begin ERROR("ScanBlock-1"); goto F end; - n:=InByte; - if n >= Lng then - begin ERROR("ScanBlock-2"); n:=Lng-1 end; - ScanBytes("Data:",n); - end - else for blk:=blk-1 while blk >= 0 do ScanBlock; - end; - - Lng:=ScanWord("LIDATA=A2H Lng"); - CurSeg:=ScanIndex("SegmentIndex"); - CurOfst:=ScanWord("IteratedDataOffset"); - while Lng > 2 do ScanBlock; - F:end; - - Procedure LEDATA; - begin Lng:=ScanWord("LEDATA=A0H Lng"); - CurSeg:=ScanIndex("SegmentIndex"); - CurOfst:=ScanWord("DataOffset"); - ScanBytes("Data:",Lng-1); - end; -%title *** F I X U P P *** - Procedure FIXUPP; - begin integer n; Lng:=ScanWord("FIXUPP=9CH Lng"); - while Lng > 1 do - begin n:=inbyte; Oupt.OutImage; Oupt.SetPos(18); - if n < 128 then - begin integer D,Z,METHOD,THRED,Val; !*** THREAD ***; - THRED:=mod(n,4); n:=n//4; - METHOD:=mod(n,8); n:=n//8; - Z:=mod(n,2); D:=n//2; - Oupt.OutText(" THREAD D:"); PrtInt(D); - Oupt.OutText(" Z:"); PrtInt(Z); - Oupt.OutText(" METHOD:"); PrtInt(METHOD); - Oupt.OutText(" THRED:"); PrtInt(THRED); - if D*METHOD < 4 then - begin if Lng < 2 then - begin ERROR("THREAD-1"); goto E end; - if METHOD=0 then Val:=ScanIndex("SegmentIndex") - else if METHOD=1 then Val:=ScanIndex("GroupIndex") - else if METHOD=2 then Val:=ScanIndex("ExternalIndex") - else begin if Lng < 3 then - begin ERROR("THREAD-2"); goto E end; - Val:=ScanWord("FrameNumber"); - end; - end; - if D=1 then ImpFrame(THRED):-new Thread(METHOD,Val) - else ImpTarget(THRED):-new Thread(METHOD,Val); - end - else begin integer M,S,LOC,OFST; !*** FIXUPP ***; - ref(LogicalAddr) adr; - if Lng<2 then begin ERROR("FIXUPP"); goto E end; - OFST:=mod(n,4)*256 + InByte; n:=n//4; - LOC:=mod(n,8); n:=n//8; - S:=mod(n,2); n:=n//2; M:=mod(n,2); - Oupt.OutText(" FIXUPP M:"); PrtInt(M); - Oupt.OutText(" S:"); PrtInt(S); - Oupt.OutText(" LOC:"); PrtInt(LOC); - Oupt.OutText(" OFFSET:"); PrtInt(OFST); - adr:-new LogicalAddr; - Oupt.OutImage; Oupt.SetPos(18); - if LOC=0 then Oupt.OutText("LowByte(") - else if LOC=1 then Oupt.OutText("Offset(") - else if LOC=2 then Oupt.OutText("Base(") - else if LOC=3 then Oupt.OutText("Pointer(") - else if LOC=4 then Oupt.OutText("HighByte(") - else Oupt.OutText("????("); - PrtSeg(CurSeg); Oupt.OutChar('+'); - PrtInt(CurOfst+OFST); Oupt.OutText(") <= "); - if M=0 then Oupt.OutText("Self") - else Oupt.OutText("Segm"); - Oupt.OutText("Rel <= "); PrtAddr(adr); - end; - end; - E:end; -%title - - Procedure COMENT; - begin integer n,NP,NL,ZZ,CLS; - Lng:=ScanWord("COMENT=88H Lng"); - n:=InByte; ZZ:=mod(n,64); n:=n//64; - NL:=mod(n,2); NP:=n//2; CLS:=InByte; - OutText(" NP:"); PrtInt(NP); - OutText(" NL:"); PrtInt(NL); - OutText(" ZZ:"); PrtInt(ZZ); - OutText(" CLASS:"); PrtInt(CLS); - end; - - Procedure TYPDEF; - begin Lng:=ScanWord("TYPDEF=8EH Lng"); - ScanName("Link86Name"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure RHEADR; - begin Lng:=ScanWord("RHEADR=6EH Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure REGINT; - begin Lng:=ScanWord("REGINT=70H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure REDATA; - begin Lng:=ScanWord("REDATA=72H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure RIDATA; - begin Lng:=ScanWord("RIDATA=74H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure OVLDEF; - begin Lng:=ScanWord("OVLDEF=76H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure ENDREC; - begin Lng:=ScanWord("ENDREC=78H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure BLKDEF; - begin Lng:=ScanWord("BLKDEF=7AH Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure BLKEND; - begin Lng:=ScanWord("BLKEND=7CH Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure DEBSYM; - begin Lng:=ScanWord("DEBSYM=7EH Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure LHEADR; - begin Lng:=ScanWord("LHEADR=82H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure PEDATA; - begin Lng:=ScanWord("PEDATA=84H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure PIDATA; - begin Lng:=ScanWord("PIDATA=86H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure LOCSYM; - begin Lng:=ScanWord("LOCSYM=92H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure LINNUM; - begin Lng:=ScanWord("LINNUM=94H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure LIBHED; - begin Lng:=ScanWord("LIBHED=A4H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure LIBNAM; - begin Lng:=ScanWord("LIBNAM=A6H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure LIBLOC; - begin Lng:=ScanWord("LIBLOC=A8H Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; - - Procedure LIBDIC; - begin Lng:=ScanWord("LIBDIC=AAH Lng"); - - ! ... MERE SENERE ... ; - ! ... MERE SENERE ... ; - - end; -%title *** M O N I T O R *** - - OutText("OBJECT CODE ANALYZER - 8086/80286"); - OutImage; OutImage; InputFile; OutputFile; - Start:=Prompt("Start Byte","0,1, ...").GetInt; - Count:=Prompt("Item Count","1,2, ...").GetInt; - -NESTE: - if Listing then Oupt.OutImage else - begin Oupt.SetPos(1); Oupt.image:=notext end; - - Code:=InByte; if Inpt.EndFile then goto FERDIG; - if Listing then - begin Count:=Count-1; - if Count < 1 then - begin Count:=Prompt("Item Count","0,1,2, ...").GetInt; - if Count <= 0 then goto FERDIG; - end; - end else Listing := Sequ >= Start; - Oupt.OutInt(Sequ,4); Oupt.OutText(": "); - - if Code=110 then RHEADR - else if Code=112 then REGINT - else if Code=114 then REDATA - else if Code=116 then RIDATA - else if Code=118 then OVLDEF - else if Code=120 then ENDREC - else if Code=122 then BLKDEF - else if Code=124 then BLKEND - else if Code=126 then DEBSYM - else if Code=128 then THEADR - else if Code=130 then LHEADR - else if Code=132 then PEDATA - else if Code=134 then PIDATA - else if Code=136 then COMENT - else if Code=138 then MODEND - else if Code=140 then new EXTDEF - else if Code=142 then TYPDEF - else if Code=144 then PUBDEF - else if Code=146 then LOCSYM - else if Code=148 then LINNUM - else if Code=150 then LNAMES - else if Code=152 then new SEGDEF - else if Code=154 then new GRPDEF - else if Code=156 then FIXUPP - - else if Code=160 then LEDATA - else if Code=162 then LIDATA - else if Code=164 then LIBHED - else if Code=166 then LIBNAM - else if Code=168 then LIBLOC - else if Code=170 then LIBDIC - else begin OutText("**RecType: "); PrtInt(Code); - Lng:=ScanWord("Lng"); - end; - ScanChk; goto NESTE; - -FERDIG: - - if Oupt =/= SysOut then Oupt.Close; - Inpt.Close; - OutImage; OutImage; - OutText("END -- Input Bytes"); OutInt(Sequ-1,6); - OutImage; OutImage; -end; diff --git a/samples/Simula/demos.sim b/samples/Simula/demos.sim deleted file mode 100644 index a0f547a942..0000000000 --- a/samples/Simula/demos.sim +++ /dev/null @@ -1,2628 +0,0 @@ -comment License: program borrowed from S-PORT https://github.com/portablesimula/S-PORT; - CLASS DEMOS; - BEGIN - COMMENT----D A T A C O L L E C T I O N D E V I C E S---- - * - * THIS LEVEL CONTAINS THE DATA COLLECTING MECHANISMS - * AND THEIR PRINTING ROUTINES. THE DEFINITIONS ARE: - * - * ACCUMULATE COUNT HISTOGRAM TALLY - * - * ACCUMULATE COLLECTS TIME DEPENDENT DATA - * - * COUNT IS USED TO COUNT INCIDENCES ONLY - * - * HISTOGRAM COLLECTS DATA IN HISTOGRAM FORM AND - * PRINTS THE END RESULT AS A PICTURE - * - * TALLY COLLECTS TIME INDEPENDENT DATA - * - * ATTRIBUTES SHARED BY THESE DEFINITIONS : - * RESET NOTE TIME AND RESET STATUS - * TO ZERO - * UPDATE(V) RECORD NEW ENTRY V - * REPORT PRINT CURRENT STATUS - * - * THESE CLASSES ARE PREFIXED BY 'TAB' WHICH CONTAINS - * COMMON VARIABLES AND THE PARAMETER 'TITLE' WHICH NAMES - * THE PARTICULAR OBJECT. - * EVERY OBJECT OF A CLASS INNER TO TAB IS PUT INTO A - * 'REPORTQ' BEHIND THE SCENES. - * THESE REPORTQS ARE SYSTEM DEFINED AND ARE CALLED - * - * ACCUMQ COUNTQ DIST(+EMP)Q HISTOQ TALLYQ - * - * ON A CALL 'REPORT', THE CURRENT STATUSES OF ALL THESE - * REPORTQS ARE WRITTEN OUT. - * - * THE SET OF PREDEFINED DATA COLLECTION FACILITIES - * IS PREFIXED BY TAB. - * - * TAB DEFINES THE COMMON CORE - * - * VARIABLES: - * TITLE USER SUPPLIED DESCRIPTIVE TEXT - * OBS NO. OF ENTRIES SINCE RESETAT - * RESETAT TIME WHEN INITIATED, OR LAST RESET - * NEXT REF TO NEXT TAB IN REPORTQ - * - * PROCEDURES: - * - * JOIN ENTERS THIS TAB INTO A NAMED - * REPORTQ AT THE END - * - * RESET (VIRTUAL) NOTES THE TIME IN - * RESETAT AND SETS OBS TO ZERO - * - * WRITETRN PRINTS ON ONE (PART)LINE - * TITLE/RESET TIME/OBSERVATIONS - *; - - - COMMENT------------------ T A B ----------------------------; - - CLASS TAB(TITLE); VALUE TITLE; TEXT TITLE; - VIRTUAL : PROCEDURE RESET, REPORT; - BEGIN INTEGER OBS; REAL RESETAT; - REF(TAB)NEXT; - - PROCEDURE JOIN(R); REF(REPORTQ)R; - BEGIN - IF R == NONE THEN ERROR(18, NONE, THIS TAB, 0, - "T.JOIN(R); REF(TAB)T; REF(REPORTQ)R;") ELSE - IF R.FIRST == NONE - THEN R.FIRST :- R.LAST :- THIS TAB - ELSE R.LAST :- R.LAST.NEXT :- THIS TAB; - END***JOIN***; - - PROCEDURE REPORT; - BEGIN - WRITETRN; - OUTF.OUTIMAGE; - END***REPORT***; - - PROCEDURE RESET; - BEGIN - OBS := 0; - RESETAT := TIME; - END***RESET***; - - PROCEDURE WRITETRN; - BEGIN - OUTF.OUTTEXT(TITLE); - OUTF.SETPOS(OUTF.POS+(13-TITLE.LENGTH)); - PRINTREAL(RESETAT); - OUTF.OUTINT(OBS, 7); - END***REPORT TITLE, RESETAT AND READINGS***; - - IF TITLE.LENGTH > 12 THEN TITLE :- TITLE.SUB(1, 12); - RESET; - END***TAB***; - - COMMENT-------------------- T A L L Y -----------------------; - - TAB CLASS TALLY; - BEGIN COMMENT - * - * VARIABLES: - * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER) - * .OBS NUMBER OF INCIDENCES - * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION - * .NEXT REF TO .NEXT TAB IN REPORTQ - * SUM SUM OF SAMPLE VALUES - * SUMSQ SUM OF SQUARES OF SAMPLE VALUES - * (VARIANCE)(OBS*SUMSQ - SUM*SUM)/(OBS*(OBS-1)) - * (SIGMA) SQRT(VARIANCE) - * MIN LEAST SAMPLE VALUE - * MAX LARGEST SAMPLE VALUE - * - * PROCEDURES : - * RESET RESETS OBS, SUM, SUMSQ, MIN, MAX TO ZERO - * COPIES TIME INTO RESETAT - * - * UPDATE(V) ADDS 1 TO OBS - * ADDS V TO SUM - * ADDS V*V TO SUMSQ - * MAX BECOMES MAXIMUM (MAX,V) - * MIN BECOMES MINIMUM (MIN,V) - * - * REPORT PRINTS ON ONE LINE: - * TITLE/RESET/OBS/AV/EST.ST.DEV/MIN/MAX - *; - - REAL SUM, SUMSQ, MIN, MAX; - - PROCEDURE REPORT; - BEGIN WRITETRN; - IF OBS = 0 THEN OUTF.OUTTEXT(MINUSES.SUB(1, 40)) ELSE - BEGIN PRINTREAL(SUM/OBS); - IF OBS = 1 THEN OUTF.OUTTEXT(MINUSES.SUB(1, 10)) ELSE - PRINTREAL(SQRT(ABS(OBS*SUMSQ-SUM**2)/(OBS*(OBS-1)))); - PRINTREAL(MIN); - PRINTREAL(MAX); - END; - OUTF.OUTIMAGE; - END***REPORT***; - - PROCEDURE RESET; - BEGIN OBS := 0; - SUM := SUMSQ := MIN := MAX := 0.0; - RESETAT := TIME; - END***RESET***; - - PROCEDURE UPDATE(V); REAL V; - BEGIN OBS := OBS + 1; - SUM := SUM + V; - SUMSQ := SUMSQ + V**2; - IF OBS = 1 THEN MIN := MAX := V ELSE - IF V < MIN THEN MIN := V ELSE - IF V > MAX THEN MAX := V; - END*** UPDATE ***; - - IF NOT(THIS TALLY IS NOTALLY) THEN JOIN(TALLYQ); - END*** TALLY ***; - - - COMMENT NOTALLY IS USED IN HISTOGRAM. NOTALLY OBJECTS ARE - NOT ENTERED INTO TALLYQ; - - TALLY CLASS NOTALLY;; - - COMMENT------------------ C O U N T -------------------------; - - TAB CLASS COUNT; - BEGIN COMMENT - * - * VARIABLES : - * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAMETER) - * .OBS NUMBER OF INCIDENCES - * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION - * .NEXT REF TO NEXT TAB IN REPORTQ - * - * PROCEDURES : - * .RESET RESETS OBS TO ZERO - * COPIES TIME INTO RESETAT - - * UPDATE(V) ADDS V TO OBS - * - * REPORT PRINTS ON ONE LINE: - * TITLE/RESET/OBSERVATIONS - *; - - PROCEDURE REPORT; - BEGIN - OUTF.SETPOS(21); - WRITETRN; - OUTF.OUTIMAGE; - END***REPORT***; - - PROCEDURE UPDATE(V); INTEGER V; - BEGIN - OBS := OBS + V; - END***UPDATE***; - - JOIN(COUNTQ); - END***COUNT***; - - COMMENT-------------------- A C C U M U L A T E -------------; - - TAB CLASS ACCUMULATE; - BEGIN COMMENT - * - * VARIABLES : **** TIME WEIGHTED **** - * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAM.) - * .OBS NUMBER OF INCIDENCES - * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION - * .NEXT REF TO NEXT TAB IN REPORTQ - * SUMT TIME WEIGHTED SUM - * SUMSQT TIME WEIGHTED SUM OF SQUARES - * (MEAN) SUM/TIMESPAN = (LAST UPDATE TIME-RESETAT) - * (SIGMA) SQRT( SUMSQT / TIMESPAN - MEAN**2) - * MIN LEAST SAMPLE VALUE - * MAX LARGEST SAMPLE VALUE - * LASTTIME TIME OF LAST UPDATE - * LASTV LAST UPDATE VALUE - * - * PROCEDURES : - * RESET RESETS OBS, SUM, SUMSQT, MIN, MAX TO ZERO - * COPIES TIME INTO RESETAT, LASTTIME - * - * UPDATE(V) ADDS 1 TO OBS - * ADDS V*SPAN TO SUMT - * ADDS V*V*SPAN TO SUMSQT - * MIN BECOMES MINIMUM(MIN, V) - * MAX BECOMES MAXIMUM(MAX, V) - * COPIES TIME INTO LASTTIME - * - * REPORT PRINTS ON ONE LINE: - * TITLE/RESET/OBS/MEAN/EST.ST.DEV./MIN/MAX - *; - - REAL SUMT, SUMSQT, MIN, MAX, LASTTIME, LASTV; - - PROCEDURE REPORT; - BEGIN REAL SPAN, AVG, T; - WRITETRN; - IF OBS = 0 THEN OUTF.OUTTEXT(MINUSES.SUB(1, 40)) ELSE - BEGIN T := TIME; - SPAN := T - RESETAT; T := T - LASTTIME; - IF SPAN MAX THEN MAX := V; - END*** UPDATE ***; - - JOIN(ACCUMQ); - END***ACCUMULATE***; - - COMMENT-------------------- H I S T O G R A M ---------------; - - TAB CLASS HISTOGRAM(LOWER, UPPER, NCELLS); REAL LOWER, UPPER; - INTEGER NCELLS; - BEGIN COMMENT - * - * VARIABLES: - * - * .TITLE USER SUPPLIED DESCRIPTIVE TEXT (PARAM.) - * .N NUMBER OF INCIDENCES - * .RESETAT LAST TIME OF SETTING OR TIME OF CREATION - * .NEXT REF TO NEXT TAB IN REPORTQ - * LOWER LOWER LIMIT OF THE VARIABLE RANGE - * UPPER UPPER LIMIT OF THE VARIABLE RANGE - * NCELLS NUMBER OF CELLS IN THIS RANGE - * WIDTH CELL WIDTH (= (UPPER - LOWER)/NCELLS) - * TABLE ARRAY TO HOLD THE INCIDENCES. VALUES IN - * RANGE GO IN CELLS 1, 2, .... , N. - * UNDERFLOW VALUES GO IN CELL 0. - * OVERFLOW VALUES IN CELL LIMIT=NCELLS+1 - * LIMIT NCELLS + 1. - * MYT TO ACCUMULATE SUM , SUMSQ OF READINGS - * - * PROCEDURES: - * RESET SETS OBS TO ZERO - * COPIES TIME INTO RESETAT - * RESETS MYT - * - * UPDATE(V) ADDS 1 TO OBS - * ADDS 1 TO THE APPROPRIATE TABLE CELL - * CALLS MYT.UPDATE(V) - * - * REPORT DRAWS A PICTURE OF THE HISTOGRAM. - * CALLS MYT.REPORT - *; - - INTEGER ARRAY TABLE(0 : NCELLS + 1); - REF(NOTALLY)MYT; - INTEGER LIMIT; - REAL WIDTH; - - PROCEDURE REPORT; - BEGIN TEXT T; - INTEGER I, NEXT, A, OCC; - REAL R, F, SCALE, SUM, FREQ; - - INTEGER PROCEDURE MAXIMUMELEMENT; - BEGIN INTEGER K, J; - IF OBS > 0 THEN - BEGIN K := TABLE(0); - FOR J := 1 STEP 1 UNTIL LIMIT DO - IF TABLE(J) > K THEN K := TABLE(J); - MAXIMUMELEMENT := K; - END; - END*** MAXIMUM ELEMENT ***; - - A := 40; - OUTF.SETPOS(29); - OUTF.OUTTEXT("S U M M A R Y"); - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - OUTF.OUTTEXT(HEADINGRTN); - OUTF.OUTTEXT(TALLYHEADING); - OUTF.OUTIMAGE; - MYT.REPORT; - OUTF.OUTIMAGE; - IF OBS = 0 THEN - BEGIN - OUTF.SETPOS(21); - OUTF.OUTTEXT("***NO ENTRIES RECORDED***"); - END ELSE - BEGIN SCALE := 30 / MAXIMUMELEMENT; - OUTF.OUTTEXT("CELL/LOWER LIM/ N/ FREQ/ CUM %"); - OUTF.OUTIMAGE; - OUTF.SETPOS(A); OUTF.OUTCHAR('I'); - OUTF.OUTTEXT(MINUSES.SUB(1, 30)); OUTF.OUTIMAGE; - F := 1/OBS; - R := LOWER - WIDTH; - FOR I := 0 STEP 1 UNTIL LIMIT DO - BEGIN OUTF.OUTINT(I, 4); - IF I = 0 THEN OUTF.OUTTEXT(" -INFINITY") - ELSE PRINTREAL(R); - NEXT := TABLE(I); OUTF.OUTINT(NEXT, 6); - FREQ := NEXT*F; OUTF.OUTFIX(FREQ, 2, 8); - SUM := SUM + FREQ*100.0; OUTF.OUTFIX(SUM , 2, 8); - OUTF.SETPOS(A); OUTF.OUTCHAR('I'); - IF NEXT > 0 THEN - BEGIN T :- STARS.SUB(1, SCALE*NEXT); - IF T == NOTEXT THEN OUTF.OUTCHAR('.') - ELSE OUTF.OUTTEXT(T); - END; - OUTF.OUTIMAGE; - ANYMORETOPRINT: - OCC := OCC+NEXT; - IF OCC = OBS AND I+3 < LIMIT THEN - BEGIN - OUTF.OUTIMAGE; - OUTF.SETPOS(A+6); - OUTF.OUTTEXT("**REST OF TABLE EMPTY**"); - OUTF.OUTIMAGE; - OUTF.OUTIMAGE; - GOTO FINISH; - END; - R := R + WIDTH; - END; - FINISH: - OUTF.SETPOS(A); OUTF.OUTCHAR('I'); - OUTF.OUTTEXT(MINUSES.SUB(1, 30)); OUTF.OUTIMAGE; - END; - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - END***REPORT***; - - PROCEDURE RESET; - BEGIN INTEGER K; - OBS := 0; - FOR K := 0 STEP 1 UNTIL LIMIT DO - TABLE(K) := 0; - RESETAT := TIME; - IF MYT =/= NONE THEN MYT.RESET; - END***RESET***; - - PROCEDURE UPDATE(V); REAL V; - BEGIN INTEGER CELL; - OBS := OBS + 1; - MYT.UPDATE(V); - V := V - LOWER; - IF V < 0.0 THEN CELL := 0 ELSE - BEGIN CELL := ENTIER(V/WIDTH) + 1; - IF CELL > LIMIT THEN CELL := LIMIT; - END; - TABLE(CELL) := TABLE(CELL) + 1; - END*** UPDATE ***; - - IF UPPER <= LOWER OR NCELLS < 1 THEN - BEGIN - ERROR(19, NONE, THIS TAB, 0, "NEW HISTOGRAM(T,L,U,N);"); - IF NCELLS < 1 THEN NCELLS := 10; - IF LOWER >= UPPER THEN - BEGIN - LOWER := 0.0; - UPPER := 100.0; - END; - END; - WIDTH := (UPPER - LOWER)/NCELLS ; - LIMIT := NCELLS + 1; - MYT :- NEW NOTALLY(TITLE); - JOIN(HISTOQ); - END***HISTOGRAM***; - - COMMENT----------R E G R E S S I O N S-------------; - - TAB CLASS REGRESSION(TITLE2); VALUE TITLE2; TEXT TITLE2; - BEGIN - REAL X, Y, XX, XY, YY; - - PROCEDURE UPDATE(VX, VY); REAL VX, VY; - BEGIN - OBS := OBS + 1; - X := X + VX; - Y := Y + VY; - XX := VX**2 + XX; - XY := VX*VY + XY; - YY := VY**2 + YY; - END***UPDATE***; - - PROCEDURE RESET; - BEGIN - OBS := 0; - RESETAT := TIME; - X := Y := XX := XY := YY := 0.0; - END***RESETAT***; - - PROCEDURE REPORT; - BEGIN - REAL DX, DY, A0, A1, SD, R2; - - OUTF.SETPOS((52-TITLE.LENGTH-TITLE2.LENGTH)//2); - OUTF.OUTTEXT("REGRESSION OF '"); - OUTF.OUTTEXT(TITLE2); - OUTF.OUTTEXT("' UPON '"); - OUTF.OUTTEXT(TITLE); - OUTF.OUTCHAR('''); - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - OUTF.SETPOS(17); - OUTF.OUTTEXT(" (RE)SET/ OBS/ XBAR/ YBAR"); - OUTF.OUTIMAGE; - OUTF.SETPOS(17); - PRINTREAL(RESETAT); - OUTF.OUTINT(OBS, 8); - IF OBS > 0 THEN - BEGIN - PRINTREAL(X/OBS); - PRINTREAL(Y/OBS); - END; - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - IF OBS <= 5 THEN - BEGIN - OUTF.SETPOS(24); - OUTF.OUTTEXT("*** INSUFFICIENT DATA ***"); - END ELSE - BEGIN - DX := ABS(OBS*XX - X**2); - DY := ABS(OBS*YY - Y**2); - IF DX < 0.00001 OR DY < 0.00001 THEN - BEGIN - OUTF.SETPOS(27); - OUTF.OUTTEXT("***DEGENERATE DATA***"); - OUTF.OUTIMAGE; - IF DX < 0.00001 THEN - BEGIN - OUTF.SETPOS(25); - OUTF.OUTTEXT("X = CONSTANT = "); - PRINTREAL(X/OBS); - OUTF.OUTIMAGE; - END; - IF DY < 0.00001 THEN - BEGIN - OUTF.SETPOS(25); - OUTF.OUTTEXT("Y = CONSTANT = "); - PRINTREAL(Y/OBS); - OUTF.OUTIMAGE; - END; - END***DEGENERATE CASE***ELSE - BEGIN - A1 := (OBS*XY - X*Y)/DX; - A0 := (Y*XX - X*XY)/DX; - SD := SQRT((YY - A0*Y - A1*XY)/(OBS-2)); - R2 := (OBS*XY - X*Y)**2/(DX*DY); - OUTF.OUTTEXT(" RES.ST.DEV/ EST.REG.COEFF/ INTERCEPT/"); - OUTF.OUTTEXT(" ST.DEV.REG.COEFF/ CORR.COEFF"); - OUTF.OUTIMAGE; - OUTF.SETPOS( 3); PRINTREAL(SD); - OUTF.SETPOS(18); PRINTREAL(A1); - OUTF.SETPOS(29); PRINTREAL(A0); - OUTF.SETPOS(47); PRINTREAL(OBS*SD/SQRT((OBS-2)*DX)); - OUTF.SETPOS(59); PRINTREAL(SQRT(R2)); - OUTF.OUTIMAGE; - END; - END; - OUTF.OUTIMAGE; - OUTF.OUTIMAGE; - END***REPORT***; - - IF TITLE2.LENGTH > 12 THEN TITLE2 :- TITLE2.SUB(1, 12); - END***REGRESSION***; - - COMMENT--------------------SEED GENERATOR-------------------- - * - * THE BASIC RNG IS - * - * U(K+1) <- U(K) * 2**13 MODULO 67099547 - * - * (SEE !NEXT PAGE: ZYQSAMPLE IN DIST) - * THIS RNG WAS DEVELOPED AND TESTED BY DOWNHAM AND ROBERTS - * BY NOTING THAT - * - * U(K+120633) <- U(K) * 36855 MODULO 67099547 - * - * WE GET OUR ROUTINE FOR GENERATING WELL SEPARATED SEEDS - * - * U(0) <- 907, U(1) <- 33427485, U(2) <- 22276755, ... - * - * YOU MAY CHANGE THE DEFAULTS BY ASSIGNING A FRESH VALUE - * TO ZYQSEED. - *; - - INTEGER PROCEDURE ZYQNEXTSEED; - BEGIN INTEGER K; - FOR K := 7, 13, 15, 27 DO - BEGIN ZYQSEED := ZYQSEED*K; - IF ZYQSEED >= ZYQMODULO THEN - ZYQSEED := ZYQSEED - ZYQSEED//ZYQMODULO*ZYQMODULO; - END; - ZYQNEXTSEED := ZYQSEED; - END***ZYQNEXTSEED***; - - PROCEDURE SETSEED(N); INTEGER N; - BEGIN - IF N < 0 THEN N := -N; - IF N >= ZYQMODULO THEN N := N-N//ZYQMODULO*ZYQMODULO; - IF N = 0 THEN N := ZYQMODULO//2; - ZYQSEED := N; - END***SETSEED***; - - COMMENT-------------D I S T R I B U T I O N S---------------- - * - * THIS SECTION HAS THE DEFINITIONS OF THE SAMPLING MECHANISMS - * DEFINED IN DEMOS. THESE DEFINITIONS ARE: - * - * DIST - * - * RDIST IDIST BDIST - * - * RDIST = - * CONSTANT ERLANG EMPIRICAL NEGEXP NORMAL UNIFORM - * - * IDIST = - * RANDINT POISSON - * - * BDIST = - * DRAW - * CONSTANT EVERY SAMPLE RETURNS THE SAME VALUE. - * - * EMPIRICAL DEFINES A CUMULATIVE PROBABILITY FUNCTION - * SUPPLIED AS A PAIR OF TABLES BY THE USER. - * - * AND THE REST FOLLOW SIMULA'S DRAWING PROCEDURES IN THE - * OBVIOUS WAY. BY BUILDING AN OBJECT, WE MAKE A DRAWING BY A - * CALL 'OBJ'.SAMPLE AND NEED NOT PASS OVER ANY PARAMETERS. - * AND THE OBJECT NAME CAN BE RELEVANT, E.G. ARRIVALS.SAMPLE. - *; - - TAB CLASS DIST; - BEGIN INTEGER U, USTART, TYPE; - BOOLEAN ANTITHETIC; - - REAL PROCEDURE ZYQSAMPLE; - BEGIN INTEGER K; - FOR K := 32, 32, 8 DO - BEGIN U := K*U; - IF U >= ZYQMODULO THEN U := U - U//ZYQMODULO*ZYQMODULO; - END; - ZYQSAMPLE := IF ANTITHETIC THEN 1.0 - U/ZYQMODULO - ELSE U/ZYQMODULO; - OBS := OBS+1; - END***ZYQSAMPLE***; - - PROCEDURE SETSEED(N); INTEGER N; - BEGIN - IF N < 0 THEN N := -N; - IF N >= ZYQMODULO THEN N := N-N//ZYQMODULO*ZYQMODULO; - IF N = 0 THEN N := ZYQMODULO//2; - U := N; - END***SETSEED***; - - PROCEDURE ZYQFAIL(T1,T2,X,Y);VALUE T1,T2;TEXT T1,T2;REAL X,Y; - BEGIN - SWITCH CASE:=NORMALL, UNIFORML, ERLANGL, - RANDINTL, NEGEXPL, POISSONL; - OUTTEXT("**ERROR IN CREATION OF "); - OUTTEXT(DISTTYPE(TYPE)); - OUTTEXT("DIST '"); - OUTTEXT(TITLE); - OUTCHAR('''); OUTCHAR('.'); - OUTIMAGE; - OUTTEXT(ZYQREASON); OUTTEXT(T1); OUTIMAGE; - OUTTEXT(ZYQRECVRY); OUTTEXT(T2); - GOTO CASE(TYPE); - GOTO JOIN; - NORMALL: - ERLANGL: - NEGEXPL: - POISSONL: OUTREAL(X, 5, 12); - GOTO JOIN; - UNIFORML: OUTREAL(X, 5, 12); - OUTTEXT(", B ="); - OUTREAL(Y, 5, 12); - GOTO JOIN; - RANDINTL: OUTINT(THIS DIST QUA RANDINT.A, 10); - OUTTEXT(", B ="); - OUTINT(THIS DIST QUA RANDINT.B, 10); - JOIN: OUTCHAR('.'); OUTIMAGE; OUTIMAGE; - END***ZYQFAIL***; - - PROCEDURE REPORT; - BEGIN SWITCH CASE := NORMALL, UNIFORML, ERLANGL, RANDINTL, - NEGEXPL, POISSONL, DRAWL, CONSTANTL; - WRITETRN; - OUTF.OUTCHAR(' '); - OUTF.OUTTEXT(DISTTYPE(TYPE)); - OUTF.SETPOS(41); - GOTO CASE(TYPE); - GOTO SKIPALL; - NORMALL: PRINTREAL(THIS DIST QUA NORMAL.A); - PRINTREAL(THIS DIST QUA NORMAL.B); - GOTO EXIT; - UNIFORML: PRINTREAL(THIS DIST QUA UNIFORM.A); - PRINTREAL(THIS DIST QUA UNIFORM.B); - GOTO EXIT; - ERLANGL: PRINTREAL(THIS DIST QUA ERLANG.A); - OUTF.OUTINT(THIS DIST QUA ERLANG.B, 10); - GOTO EXIT; - RANDINTL: OUTF.OUTINT(THIS DIST QUA RANDINT.A, 10); - OUTF.OUTINT(THIS DIST QUA RANDINT.B, 10); - GOTO EXIT; - NEGEXPL: PRINTREAL(THIS DIST QUA NEGEXP.A); - GOTO SKIP; - POISSONL: PRINTREAL(THIS DIST QUA POISSON.A); - GOTO SKIP; - DRAWL: PRINTREAL(THIS DIST QUA DRAW.A); - GOTO SKIP; - CONSTANTL: PRINTREAL(THIS DIST QUA CONSTANT.A); - GOTO SKIPALL; - SKIP: OUTF.SETPOS(61); - EXIT: OUTF.OUTINT(USTART, 10); - SKIPALL: OUTF.OUTIMAGE; - END***REPORT***; - - U := USTART := ZYQNEXTSEED; - IF THIS DIST IN EMPIRICAL THEN JOIN(EMPQ) - ELSE JOIN(DISTQ); - END***DIST***; - - COMMENT--------------------R D I S T S--------------------; - - - DIST CLASS RDIST; VIRTUAL: REAL PROCEDURE SAMPLE;; - - RDIST CLASS CONSTANT(A); REAL A; - BEGIN - REAL PROCEDURE SAMPLE; - BEGIN OBS := OBS + 1; - SAMPLE := A; - END***SAMPLE***; - - TYPE := 8; - END***CONSTANT***; - - - RDIST CLASS NORMAL(A, B); REAL A, B; - BEGIN REAL ZYQU, ZYQV; BOOLEAN ZYQEVEN; - - REAL PROCEDURE SAMPLE; - BEGIN REAL Z; - IF ZYQEVEN THEN - BEGIN ZYQEVEN := FALSE; - Z := ZYQU*COS(ZYQV); - OBS := OBS + 1; - END ELSE - BEGIN ZYQEVEN := TRUE; - ZYQU := SQRT(-2.0*LN(ZYQSAMPLE)); - ZYQV := 6.28318530717959*ZYQSAMPLE; - Z := ZYQU*SIN(ZYQV); - OBS := OBS - 1; - END; - SAMPLE := Z*B+A; - END***SAMPLE***; - - TYPE := 1; - IF B < 0.0 THEN - BEGIN B := -B; - ZYQFAIL("ST. DEV. 'B' < 0.0.", - "ABSOLUTE VALUE ~B~ TAKEN. B IS NOW", B, 0.0); - END; - END***NORMAL***; - - - RDIST CLASS NEGEXP(A); REAL A; - BEGIN - REAL PROCEDURE SAMPLE; - BEGIN - SAMPLE := -LN(ZYQSAMPLE)/A; - END***SAMPLE***; - - TYPE := 5; - IF A <= 0.0 THEN - BEGIN A := IF A < 0.0 THEN -A ELSE 0.001; - ZYQFAIL("NON-POSITIVE VALUE FOR 'A' (=ARRIVAL RATE).", - "A RESET TO", A, 0.0); - END; - END***NEGEXP***; - - - RDIST CLASS UNIFORM(A, B); REAL A, B; - BEGIN REAL ZYQSPAN; - REAL PROCEDURE SAMPLE; - BEGIN - SAMPLE := ZYQSPAN*ZYQSAMPLE + A; - END***SAMPLE***; - - TYPE := 2; - IF A > B THEN - BEGIN REAL Q; - Q := A; A := B; B := Q; - ZYQFAIL("LOWER BOUND 'A' > UPPER BOUND 'B'.", - "BOUNDS SWAPPED. NOW, A =", A, B); - END; - ZYQSPAN := B-A; - END***UNIFORM***; - - - RDIST CLASS ERLANG(A, B); REAL A; INTEGER B; - BEGIN REAL ZYQAB; - REAL PROCEDURE SAMPLE; - BEGIN INTEGER K, M; REAL PROD; - M := OBS; - PROD := ZYQSAMPLE; - FOR K := 2 STEP 1 UNTIL B DO - PROD := PROD * ZYQSAMPLE; - OBS := M+1; - SAMPLE := -LN(PROD)*ZYQAB; - END***SAMPLE***; - - TYPE := 3; - IF A <= 0.0 THEN - BEGIN A := IF A < 0.0 THEN -A ELSE 0.01; - ZYQFAIL("'A' (=1/MEAN) <= 0.0.", - "A RESET TO", A, 0.0); - END; - IF B < 0.0 THEN - BEGIN B := IF B < 0 THEN -B ELSE 1; - ZYQFAIL("'B' (ERLANG ST. DEV.) <= 0.0.", - "B RESET TO", B, 0.0); - END; - ZYQAB := A/B; - END***ERLANG***; - - RDIST CLASS EMPIRICAL(SIZE); INTEGER SIZE; - BEGIN REAL ARRAY X, P(1 : SIZE); - - REAL PROCEDURE SAMPLE; - BEGIN REAL Q; INTEGER K; - Q := ZYQSAMPLE; - K := 2; - WHILE P(K) < Q DO - K := K + 1; - SAMPLE := X(K-1) + (X(K)-X(K-1))*(Q-P(K-1))/(P(K)-P(K-1)); - END***SAMPLE***; - - PROCEDURE REPORT; - BEGIN INTEGER K; - OUTF.SETPOS(16); - OUTF.OUTTEXT(HEADINGRTN); OUTF.OUTTEXT("/ SEED"); - OUTF.OUTIMAGE; - OUTF.SETPOS(16); - WRITETRN; - OUTF.OUTINT(USTART, 10); - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - OUTF.SETPOS(16); - OUTF.OUTTEXT(" K/ DIST. X(K)/ PROB. P(K)"); - OUTF.OUTIMAGE; - FOR K := 1 STEP 1 UNTIL SIZE DO - BEGIN - OUTF.SETPOS(16); - OUTF.OUTINT(K, 8); - OUTF.OUTFIX(X(K), 5, 13); - OUTF.OUTFIX(P(K), 5, 13); - OUTF.OUTIMAGE; - END; - OUTF.OUTIMAGE; - END***REPORT***; - - PROCEDURE READ; - BEGIN BOOLEAN GOOD, FIRST; INTEGER K, L; - REAL A, B; - - PROCEDURE Z(W, R, F, C); VALUE W, C; TEXT W, C; - REAL R; BOOLEAN F; - BEGIN - IF GOOD THEN - BEGIN GOOD := FALSE; - SYSOUT.SETPOS(11); - OUTTEXT("**READ FAULT(S) IN EMPIRICAL '"); - OUTTEXT(TITLE); - OUTCHAR('''); OUTCHAR('.'); - OUTIMAGE; - END; - IF FIRST THEN - BEGIN FIRST := FALSE; - OUTIMAGE; - OUTTEXT("**INPUTS : K ="); OUTINT(K, 4); - OUTTEXT(", DIST(K) ="); OUTFIX(A, 3, 10); - OUTTEXT(", PROB(K) ="); OUTFIX(B, 3, 10); - OUTIMAGE; - OUTTEXT(ZYQRECVRY); - END; - SYSOUT.SETPOS(14); - OUTTEXT(W); - IF F THEN OUTFIX(R, 6, 10) ELSE OUTFIX(R, 3, 10); - OUTTEXT(C); OUTCHAR('.'); - OUTIMAGE; - END***Z - THE WARNING ROUTINE***; - - K := 1; - GOOD := FIRST := TRUE; - X(1) := A := INF.INREAL; B := INF.INREAL; - IF ABS(B) > EPSILON THEN - Z("P(1) IS NOT ZERO. P(1) =>",0.0,TRUE," (FIRST PROB)"); - FOR K := 2 STEP 1 UNTIL SIZE DO - BEGIN FIRST := TRUE; - X(K) := A := INF.INREAL; P(K) := B := INF.INREAL; - IF A < X(K-1) THEN - BEGIN X(K) := X(K-1); - Z("X(K) < X(K-1). X(K) =>",X(K),FALSE," (=X(K-1))"); - END; - IF B < 0.0 OR B < P(K-1) OR B > 1.0 THEN - BEGIN P(K) := P(K-1)+0.001; - IF P(K) > 1.0 THEN P(K) := 1.0; - Z("ILLEGAL PROB. P(K) =>",P(K),TRUE," (=P(K-1)+)"); - END; - END; - IF ABS(P(SIZE)-1.0) > EPSILON THEN - Z("P(SIZE) NE 1.0. P(SIZE) =>", 1.0, TRUE, " (LAST PROB.)"); - P(SIZE) := 1.0; - IF NOT GOOD THEN - BEGIN OUTTEXT(MINUSES.SUB(1, 62)); - OUTIMAGE; OUTIMAGE; - END; - END***READ***; - - TYPE := 9; - IF SIZE = 1 THEN ERROR(20, NONE, THIS EMPIRICAL, 0, - "NEW EMPIRICAL(T, SIZE); TEXT T; INTEGER SIZE;"); - READ; - END***EMPIRICAL***; - - COMMENT--------------------I D I S T S--------------------; - - DIST CLASS IDIST; VIRTUAL: INTEGER PROCEDURE SAMPLE;; - - IDIST CLASS RANDINT(A, B); INTEGER A, B; - BEGIN REAL ZYQSPAN; - INTEGER PROCEDURE SAMPLE; - BEGIN - SAMPLE := ENTIER(ZYQSPAN*ZYQSAMPLE) + A; - END***SAMPLE***; - - TYPE := 4; - IF A > B THEN - BEGIN INTEGER Q; - Q := A; A := B; B := Q; - ZYQFAIL("LOWER BOUND 'A' > UPPER BOUND 'B'.", - "BOUNDS SWAPPED. NOW A =", A, B); - END; - ZYQSPAN := B-A+1; - END***RANDINT***; - - IDIST CLASS POISSON(A); REAL A; - BEGIN - INTEGER PROCEDURE SAMPLE; - BEGIN INTEGER M; REAL P, Q; - P := EXP(-A); - Q := 1.0; - L: Q := Q*ZYQSAMPLE; - IF Q >= P THEN - BEGIN - M := M + 1; - GOTO L; - END; - SAMPLE := M; - OBS := OBS - M; - END***SAMPLE***; - - TYPE := 6; - IF A <= 0.0 THEN - BEGIN A := IF A < 0.0 THEN -A ELSE 0.001; - ZYQFAIL("NON-POSITIVE VALUE FOR 'A' (=MEAN).", - "A RESET TO", A, 0.0); - END; - END***POISSON***; - - COMMENT--------------------B D I S T S--------------------; - - DIST CLASS BDIST; VIRTUAL: BOOLEAN PROCEDURE SAMPLE;; - - BDIST CLASS DRAW(A); REAL A; - BEGIN - BOOLEAN PROCEDURE SAMPLE; - BEGIN - SAMPLE := A > ZYQSAMPLE; - END***SAMPLE***; - - TYPE := 7; - END***DRAW***; - - COMMENT-------------READDIST-----------------------------------; - - PROCEDURE READDIST(D, TITLE); NAME D; VALUE TITLE; - REF(DIST)D; TEXT TITLE; - BEGIN TEXT F, REST; - INTEGER P, IMLENGTH1, L, K, T; - - PROCEDURE FAIL(D, EOF); BOOLEAN D, EOF; - BEGIN OUTTEXT("**ERROR IN READING DIST WITH TITLE = '"); - OUTTEXT(TITLE); - OUTCHAR('''); OUTCHAR('.'); - OUTIMAGE; - OUTTEXT("**NO MATCH FOUND WHEN SCANNING INPUT FILE FOR "); - IF D THEN OUTTEXT(" DIST TYPE") ELSE OUTTEXT("TITLE"); - OUTCHAR('.'); - OUTIMAGE; - OUTTEXT(ZYQREASON); - IF EOF THEN OUTTEXT("END OF INPUT FILE MARKER HIT.") ELSE - BEGIN OUTTEXT("REST OF CURRENT INPUT IMAGE READS:"); - OUTIMAGE; - OUTTEXT(REST); - END; - ABORT(TRUE); - END***FAIL***; - - COMMENT***CHECKTITLE***; - IMLENGTH1 := INF.IMAGE.LENGTH + 1; - IF INF.LASTITEM THEN FAIL(FALSE, TRUE); - L := TITLE.LENGTH; - P := INF.IMAGE.POS; - REST :- INF.IMAGE.SUB(P, IMLENGTH1 - P); - IF REST.LENGTH >= L THEN F :- REST.SUB(1, L); - IF F NE TITLE THEN FAIL(FALSE,FALSE); - INF.SETPOS(P + L); - - COMMENT***GET DIST TYPE***; - IF INF.LASTITEM THEN FAIL(TRUE, TRUE); - P := INF.IMAGE.POS; - REST :- INF.IMAGE.SUB(P, IMLENGTH1 - P); - L := REST.LENGTH; - FOR K := 6, 7, 6, 7, 6, 7, 4, 8, 9 DO - BEGIN T := T + 1; - IF K <= L THEN - BEGIN - IF DISTTYPE(T) = REST.SUB(1, K) THEN GOTO FOUND; - END; - END; - FAIL(TRUE, FALSE); - FOUND: INF.SETPOS(P + K); - IF T=1 THEN D:-NEW NORMAL(TITLE,INF.INREAL,INF.INREAL) ELSE - IF T=2 THEN D:-NEW UNIFORM(TITLE,INF.INREAL,INF.INREAL)ELSE - IF T=3 THEN D:-NEW ERLANG(TITLE,INF.INREAL,INF.ININT) ELSE - IF T=4 THEN D:-NEW RANDINT(TITLE,INF.ININT,INF.ININT) ELSE - IF T=5 THEN D:-NEW NEGEXP(TITLE,INF.INREAL) ELSE - IF T=6 THEN D:-NEW POISSON(TITLE,INF.INREAL) ELSE - IF T=7 THEN D:-NEW DRAW(TITLE,INF.INREAL) ELSE - IF T=8 THEN D:-NEW CONSTANT(TITLE,INF.INREAL) ELSE - IF T=9 THEN D:-NEW EMPIRICAL(TITLE, INF.ININT); - END***READDIST***; - - COMMENT-------------------- REPORTQ -------------------------; - - CLASS REPORTQ(H, L1, L2); VALUE H; TEXT H, L1, L2; - BEGIN COMMENT - * - * EVERY CREATED TAB IS PUT INTO A REPORTQ IN THE ORDER - * OF ITS CREATIONS. FROM THERE THEY CAN ALL BE REPORTED - * TOGETHER ON A CALL 'REPORT' , OR ALL RESET TO THE NULL - * STATE BY A CALL 'RESET'. - * - * VARIABLES : - * FIRST REF TO FIRST TAB IN REPORTQ - * LAST REF TO LAST TAB IN REPORTQ - * - * PROCEDURES: - * RESET RESETS EACH AND EVERY REPRESENTED TAB - * - * REPORT REPORTS EACH AND EVERY TAB AS ABOVE - *; - - REF(TAB)FIRST, LAST; - - PROCEDURE REPORT; - BEGIN REF(TAB)T; - INTEGER P, L; - L := H.LENGTH; P := (72-L)//2; - OUTF.SETPOS(P); OUTF.OUTTEXT(H); - OUTF.OUTIMAGE; - OUTF.SETPOS(P); OUTF.OUTTEXT(STARS.SUB(1, L)); - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - IF L1 =/= NOTEXT THEN - BEGIN - OUTF.OUTTEXT(L1); - IF L2 =/= NOTEXT THEN OUTF.OUTTEXT(L2); - OUTF.OUTIMAGE; - END; - T :- FIRST; - WHILE T =/= NONE DO - BEGIN T.REPORT; - T :- T.NEXT; - END; - END***REPORT***; - - PROCEDURE RESET; - BEGIN REF(TAB)T; - T :- FIRST; - WHILE T =/= NONE DO - BEGIN T.RESET; - T :- T.NEXT; - END; - END***RESET***; - - END***REPORTQ***; - - COMMENT-------------------- REPORTING AIDS -----------------; - - PROCEDURE CLOCKTIME; - BEGIN OUTF.SETPOS(24); - OUTF.OUTTEXT("CLOCK TIME = "); - PRINTREAL(TIME); - OUTF.OUTIMAGE; - END***CLOCK TIME***; - - - PROCEDURE BOX(T); VALUE T; TEXT T; - BEGIN - OUTF.OUTTEXT(STARS); OUTF.OUTIMAGE; - OUTF.OUTCHAR('*'); OUTF.SETPOS(70); - OUTF.OUTCHAR('*'); OUTF.OUTIMAGE; - OUTF.OUTCHAR('*'); - OUTF.SETPOS((72 - T.LENGTH)//2); - OUTF.OUTTEXT(T); - OUTF.SETPOS(70); - OUTF.OUTCHAR('*'); - OUTF.OUTIMAGE; - OUTF.OUTCHAR('*'); OUTF.SETPOS(70); - OUTF.OUTCHAR('*'); OUTF.OUTIMAGE; - OUTF.OUTTEXT(STARS); OUTF.OUTIMAGE; - OUTF.OUTIMAGE; - END***BOX***; - - - TEXT PROCEDURE EDIT(T, K); VALUE T; TEXT T; INTEGER K; - BEGIN TEXT S; - T :- T.STRIP; - IF T.LENGTH > 10 THEN T :- T.SUB(1, 10); - EDIT :- S :- BLANKS(T.LENGTH + 2); - S := T; - IF K < 0 THEN K := -K; - IF K > 99 THEN K := K - K//100*100; - S.SUB(S.LENGTH-1, 2).PUTINT(K); - END***EDIT***; - - - PROCEDURE PRINTREAL(X); REAL X; - BEGIN - IF X > 0.0 THEN - BEGIN - IF X > 99999.999 OR X < 0.1 THEN OUTF.OUTREAL(X, 4, 10) - ELSE OUTF.OUTFIX (X, 3, 10); - END ELSE - IF X = 0.0 THEN OUTF.OUTFIX(X, 3, 10) ELSE - BEGIN - IF X < -9999.999 OR X > -0.1 THEN OUTF.OUTREAL(X, 3, 10) - ELSE OUTF.OUTFIX (X, 3, 10); - END; - END***PRINTREAL***; - - COMMENT----------E N T I T Y-------------------------; - - CLASS ENTITY(TITLE); VALUE TITLE; TEXT TITLE; - VIRTUAL: LABEL LOOP; - BEGIN REAL TIMEIN, EVTIME; - INTEGER PRIORITY, CYCLE, WANTS, INTERRUPTED; - REF(QUEUE)CURRENTQ; - REF(ENTITY)OWNER; - BOOLEAN TERMINATED; - REF(ENTITY)LL, BL, RL; - REF(ENTITY)SUC, PRED; - - BOOLEAN PROCEDURE AVAIL; - AVAIL := OWNER == NONE; - - BOOLEAN PROCEDURE IDLE; - IDLE := EVTIME < 0.0; - - PROCEDURE COOPT; - BEGIN - IF OWNER =/= NONE THEN ERROR(1, THIS ENTITY, NONE, 0, - "E.COOPT; REF(ENTITY)E;"); - OWNER :- CURRENT; - IF ZYQTRACE > 0 THEN - NOTE(1,"COOPTS",THIS ENTITY,CURRENTQ,0.0,0); - IF CURRENTQ =/= NONE THEN OUT; - END***COOPT***; - - PROCEDURE INTERRUPT(N); INTEGER N; - BEGIN - INTERRUPTED := N; - IF ZYQTRACE > 0 THEN - NOTE(24,"INTERRUPTS",THIS ENTITY,NONE,0.0,N); - IF CURRENT =/= THIS ENTITY THEN - BEGIN - IF CURRENTQ =/= NONE THEN OUT; - IF EVTIME >= 0.0 THEN CANCEL; - INSERTDELAY0; - END; - END***INTERRUPT***; - - PROCEDURE REPEAT; - BEGIN CYCLE := CYCLE+1; - GOTO LOOP; - END***REPEAT***; - - PROCEDURE INTO(Q); REF(QUEUE)Q; - BEGIN REF(ENTITY)E; - IF CURRENTQ =/= NONE THEN - BEGIN - ERROR(3, THIS ENTITY, CURRENTQ, 0, "E.INTO(Q); REF(QUEUE)Q;"); - OUT; - END; - CURRENTQ :- Q; - TIMEIN := TIME; - INSPECT CURRENTQ DO - BEGIN QINT := QINT + (TIMEIN-LASTQTIME)*LENGTH; - LASTQTIME := TIMEIN; - LENGTH := LENGTH+1; - IF LENGTH > MAXLENGTH THEN MAXLENGTH := LENGTH; - E :- LAST; - IF E == NONE THEN FIRST :- LAST :- THIS ENTITY ELSE - IF E.PRIORITY >= PRIORITY THEN - BEGIN - PRED :- LAST; - LAST :- LAST.SUC :- THIS ENTITY; - END ELSE - BEGIN - E :- FIRST; - WHILE E.PRIORITY >= PRIORITY DO - E :- E.SUC; - SUC :- E; - PRED :- E.PRED; - IF PRED == NONE THEN FIRST :- THIS ENTITY - ELSE PRED.SUC :- THIS ENTITY; - SUC.PRED :- THIS ENTITY; - END; - END OTHERWISE ERROR(2, THIS ENTITY, NONE, 0, - "E.INTO(Q); REF(QUEUE)Q;"); - END***INTO***; - - PROCEDURE OUT; - BEGIN REAL T; - T := TIME; - INSPECT CURRENTQ DO - BEGIN QINT := QINT + (T-LASTQTIME)*LENGTH; - LENGTH := LENGTH-1; - LASTQTIME := T; - OBS := OBS+1; - T := LASTQTIME-TIMEIN; - IF T < EPSILON THEN ZEROS := ZEROS+1; - CUM := CUM+T; - IF SUC == NONE THEN LAST :- PRED ELSE SUC.PRED :- PRED; - IF PRED == NONE THEN FIRST :- SUC ELSE PRED.SUC :- SUC; - SUC :- PRED :- NONE; - END; - CURRENTQ :- NONE; - END***OUT***; - - PROCEDURE GETSERIALNO; - BEGIN REF(ZYQENTTITLE)Z; - Z :- ZYQENTNAMES; - WHILE (IF Z == NONE THEN FALSE ELSE TITLE NE Z.T) DO - Z :- Z.NEXTTITLE; - IF Z == NONE THEN Z :- NEW ZYQENTTITLE(TITLE); - TITLE :- BLANKS(Z.L+2); - TITLE := Z.T; - TITLE.SUB(Z.L+1, 2).PUTINT(Z.N); - Z.N := Z.N+1; - IF Z.N = 100 THEN Z.N := 0; - END***GET SERIALNO***; - - REF(ENTITY)PROCEDURE NEXTEV; - BEGIN - REF(ENTITY)P; - P :- BL; - IF P =/= NONE THEN - BEGIN - P :- P.RL; - IF P =/= NONE THEN - BEGIN - WHILE P.LL =/= NONE DO - P :- P.LL; - END; - NEXTEV :- P; - END; - END***NEXTEV***; - - PROCEDURE LIST; - BEGIN - REF(ENTITY)R; - INTEGER N; - OUTF.SETPOS(6); - PRINTREAL(EVTIME); - OUTF.OUTCHAR(' '); - OUTF.OUTTEXT(TITLE); - N := 30; - FOR R :- LL, BL, RL DO - BEGIN - OUTF.SETPOS(N); - IF R =/= NONE THEN OUTF.OUTTEXT(R.TITLE); - N := N + 13; - END; - OUTF.OUTIMAGE; - END***LIST***; - - PROCEDURE INSERT; - BEGIN - COMMENT - * ASSUME: - * LL == BL == RL == NONE - * EVTIME HAS BEEN SET BY HOLD OR SCHEDULE - * - * THIS ROUTINE IS CALLED BY SCHEDULE AND HOLD - * AND INSERTS O(LOG N) FROM THE TOP. - * - *; - - REF(ENTITY)W, X; - - NEWROOT: - IF EVTIME >= ROOT.EVTIME THEN - BEGIN - LL :- ROOT; - ROOT :- ROOT.BL :- THIS ENTITY; - END ELSE - - INSERTBELOWW: - BEGIN - W :- ROOT; - DESCEND: - X :- W.LL; - IF X == NONE THEN - BEGIN - INSERTASLLOFW: - W.LL :- THIS ENTITY; - BL :- W; - IF W == CURRENT THEN - BEGIN - ERROR(15, THIS ENTITY, NONE, 0, - "E.INSERT; REF(ENTITY)E;"); - CURRENT :- THIS ENTITY; - RESUME(CURRENT); - END; - END ELSE - IF EVTIME < X.EVTIME THEN - INSERT1BELOWX: - BEGIN - W :- X; - GOTO DESCEND; - END ELSE - IF EVTIME = X.EVTIME THEN - INSERTBETWEENXANDW: - BEGIN - W.LL :- X.BL :- THIS ENTITY; - BL :- W; - LL :- X; - END ELSE - INSERTINRIGHTSUBTREEOFW: - BEGIN - X :- W.RL; - IF X == NONE THEN - INSERTASNEWRLOFW: - BEGIN - W.RL :- THIS ENTITY; - BL :- W; - END ELSE - INSERT2BELOWX: - IF EVTIME < X.EVTIME THEN - BEGIN - W :- X; - GOTO DESCEND; - END ELSE - INSERT3BETWEENWANDX: - BEGIN - W.RL :- X.BL :- THIS ENTITY; - BL :- W; - LL :- X; - END; - END; - END; - END***INSERT***; - - PROCEDURE INSERTAFTERCURRENT; - BEGIN - COMMENT - * ASSUME: - * LL == BL == RL == NONE - * THIS ROUTINE IS CALLED BY ACQUIRE, RELEASE, ETC - * AND INSERTS O(1) FROM THE BOTTOM. - *; - - IF EVTIME < 0.0 THEN - BEGIN - LL :- CURRENT; - EVTIME := CURRENT.EVTIME; - IF CURRENT==ROOT THEN CURRENT.BL:-ROOT:-THIS ENTITY ELSE - BEGIN - BL :- CURRENT.BL; - CURRENT.BL :- BL.LL :- THIS ENTITY; - END; - END; - END***INSERTAFTERCURRENT***; - - PROCEDURE INSERTDELAY0; - BEGIN - COMMENT - * ASSUME: - * LL == BL == RL == NONE - * THIS ROUTINE IS CALLED BY ACQUIRE, RELEASE, ETC - * AND INSERTS O(1) FROM THE BOTTOM. - * - *; - - REF(ENTITY)P; - IF EVTIME < 0.0 THEN - BEGIN - EVTIME := CURRENT.EVTIME; - IF EVTIME >= ROOT.EVTIME THEN - BEGIN - LL :- ROOT; - ROOT :- ROOT.BL :- THIS ENTITY; - END ELSE - BEGIN - P :- CURRENT.BL; - WHILE EVTIME >= P.EVTIME DO - P :- P.BL; - LL :- P.LL; - BL :- P; - LL.BL :- BL.LL :- THIS ENTITY; - END; - END; - END***INSERTDELAY0***; - - PROCEDURE SCHEDULE(T); REAL T; - BEGIN - COMMENT - * - * A CALL E.SCHEDULE(T) DOES NOTHING IF E - * IS ALREADY IN THE EVENT LIST(E.EVTIME >= 0.0). - * OTHERWISE, IT INSERTS E INTO THE EVENT LIST - * 'DELAY' T. THERE ARE THREE SEPARATE CASES: - * T < 0.0, E PREEMPTS CURRENT (0(1) INSERT) - * T = 0.0, E FOLLOWS CURRENT (O(1) INSERT) - * T > 0.0, INSERT E FROM THE TOP - *; - - REF(ENTITY)E; - - IF TERMINATED THEN ERROR(14, THIS ENTITY, NONE, 0, - "E.SCHEDULE(T); REF(ENTITY)T; REAL T;"); - IF EVTIME < 0.0 THEN - BEGIN - IF ZYQTRACE > 0 THEN - NOTE(2,"SCHEDULES",THIS ENTITY, NONE,T,0); - OWNER :- NONE; - IF CURRENTQ =/= NONE THEN OUT; - PREEMPTCURRENT: - IF T <= NOW THEN - BEGIN - EVTIME := CURRENT.EVTIME; - BL :- CURRENT; - CURRENT :- CURRENT.LL :- THIS ENTITY; - RESUME(CURRENT); - END ELSE - INSERTBEHINDCURRENT: - IF T <= 0.0 THEN INSERTDELAY0 ELSE - INSERTFROMTHETOP: - BEGIN - EVTIME := CURRENT.EVTIME + T; - INSERT; - END; - END ELSE ERROR(16, THIS ENTITY, NONE, 0, - "E.SCHEDULE(T); REF(ENTITY)E; REAL T;"); - END***SCHEDULE***; - - PROCEDURE CANCEL; - BEGIN - COMMENT - * A CALL E.CANCEL DELETES E FROM THE EVENT LIST. - * IT HAS NO EFFECT IF E IS PASSIVE (E.EVTIME < 0) - *; - REF(ENTITY)P; - IF EVTIME >= 0.0 THEN - BEGIN - IF ZYQTRACE > 0 AND NOT TERMINATED THEN - NOTE(23,"CANCELS",THIS ENTITY,NONE,0.0,0); - EVTIME := -1.0; - IF LL == NONE THEN - BEGIN - IF THIS ENTITY == ROOT THEN - ERROR(13,THIS ENTITY,NONE,0,"E.CANCEL; REF(ENTITY)E;"); - IF THIS ENTITY == CURRENT THEN - BEGIN - IF BL.RL == NONE THEN - BLISNEWCURRENT: - BEGIN - CURRENT :- BL; - CURRENT.LL :- NONE; - END ELSE - LEFTMOSTOFSUBTREEOFBLISNEWCURRENT: - BEGIN - P :- BL.RL; - WHILE P.LL =/= NONE DO - P :- P.LL; - SWINGRSUBTREETOTHELEFT: - BL.LL :- BL.RL; - BL.RL :- NONE; - CURRENT :- P; - END; - BL:- NONE; - RESUME(CURRENT); - END ELSE - LEAFBUTNOTCURRENT: - BEGIN - IF BL.LL == THIS ENTITY THEN BL.LL :- RL; - BL.RL :- NONE; - BL :- NONE; - END; - END ELSE - IF RL == NONE THEN COMMENT BUT LL =/= NONE; - BEGIN - IF THIS ENTITY == ROOT THEN ROOT :- LL ELSE - IF THIS ENTITY == BL.LL THEN BL.LL :- LL - ELSE BL.RL :- LL; - LL.BL :- BL; - BL :- LL :- NONE; - END ELSE - BEGIN COMMENT NEITHER LL NOR RL == NONE; - P :- RL; - P.BL :- BL; - IF THIS ENTITY == ROOT THEN ROOT :- P ELSE - BEGIN - IF BL.LL == THIS ENTITY THEN BL.LL :- RL - ELSE BL.RL :- RL; - BL :- NONE; - END; - WHILE P.LL =/= NONE DO - P :- P.LL; - P.LL :- LL; - LL.BL :- P; - RL :- LL :- NONE; - END; - END ELSE ERROR(17, THIS ENTITY, NONE, 0, - "E.CANCEL; REF(ENTITY)E;"); - END***CANCEL***; - - IF TITLE.LENGTH > 10 THEN TITLE :- TITLE.SUB(1, 10); - GETSERIALNO; - EVTIME := -1.0; - DETACH; - LOOP:; - INNER; - TERMINATED := TRUE; - IF ZYQTRACE>0 THEN NOTE(3,"***TERMINATES",NONE,NONE,0.0,0); - IF EVTIME >= 0.0 THEN ZYQPASSIVATE; - END***ENTITY***; - - COMMENT------------H O L D AND P A S S I V A T E----------; - - REAL PROCEDURE TIME; - TIME := CURRENT.EVTIME; - - - PROCEDURE ZYQPASSIVATE; - BEGIN - REF(ENTITY)P; - IF CURRENT == ROOT THEN ERROR(15, CURRENT, NONE, 0, - "PASSIVATE;"); - P :- CURRENT.BL; - CURRENT.BL :- NONE; - CURRENT.EVTIME := -1.0; - LOCATENEWCURRENT: - IF P.RL =/= NONE THEN - BEGIN - P.LL :- P.RL; - P.RL :- NONE; - WHILE P.LL =/= NONE DO - P :- P.LL; - END ELSE P.LL :- NONE; - CURRENT :- P; - RESUME(CURRENT); - END***ZYQPASSIVATE***; - - - PROCEDURE PASSIVATE; - BEGIN - IF ZYQTRACE>0 THEN NOTE(22,"PASSIVATES",NONE,NONE,0.0,0); - ZYQPASSIVATE; - END***PASSIVATE***; - - - PROCEDURE HOLD(T); REAL T; - BEGIN - COMMENT - * - * DELAYS CURRENT BY T (T >= 0.0). - * IF T < 0.0, THEN T := 0.0 - *; - - REF(ENTITY)P; - - IF T < 0.0 THEN T := 0.0; - IF ZYQTRACE>0 THEN NOTE(21,"HOLDS FOR",NONE,NONE,T,0); - INSPECT CURRENT DO - BEGIN - EVTIME := EVTIME+T; - IF ROOT =/= CURRENT THEN - MOREWORKTODO: - BEGIN - LOCATENEXTEV: - IF BL.RL == NONE THEN P :- BL ELSE - BEGIN - P :- BL.RL; - WHILE P.LL =/= NONE DO - P :- P.LL; - END; - SKIPIFSTILLCURRENT: - IF EVTIME >= P.EVTIME THEN - BEGIN - BL.LL :- BL.RL; - BL.RL :- NONE; - BL :- NONE; - CURRENT :- P; - INSERT; - RESUME(CURRENT); - END; - END; - END; - END***HOLD***; - - COMMENT----------- Q U E U E ------------------; - - TAB CLASS QUEUE; - BEGIN - COMMENT - * - * QUEUE OBJECTS MAY BE USED BY ANYONE AS THEY - * STAND TO 'SAVE' ENTITIES, BUT THE PRIME USE - * OF THIS CLASS IS TO SERVE AS PREFIX TO - * - * RES BIN WAITQ CONDQ - * - * VARIABLES: - * .TITLE USER SUPPLIED DESCRIPTIVE TEXT - * .OBS NO. OF COMPLETED WAITS IN THIS Q - * .RESETAT TIME OF CREATION, OR LAST RESET - * .NEXT REF TO NEXT TAB IN REPORTQ - * LENGTH CURRENT NO. OF ENTITIES WAITING - * ZEROS NO. OF ZERO ( 0 THEN PRINTREAL(CUM/OBS) - ELSE OUTF.OUTTEXT(MINUSES.SUB(1,10)); - OUTF.OUTIMAGE; - IF THIS QUEUE IS WAITQ THEN OUTF.OUTIMAGE; - END***REPORT***; - - PROCEDURE RESET; - BEGIN - ZEROS := OBS := 0; - QINT := CUM := 0.0; - MAXLENGTH := LENGTH; - LASTQTIME := RESETAT:= TIME; - END***RESET***; - - IF THIS QUEUE IS QUEUE THEN JOIN(QUEUEQ); - END***QUEUE***; - - - QUEUE CLASS NOQUEUE;; - - COMMENT------------R E S O U R C E-------------; - - QUEUE CLASS RESOURCE(AVAIL); INTEGER AVAIL; - BEGIN - COMMENT - * DEFINES THE COMMON CORE TO RES AND BIN - * - * VARIABLES: - * .AS CLASS QUEUE - * AVAIL AMOUNT OF RESOURCE CURRENTLY FREE - * SINT TO MAINTAIN USAGE*TIME INTEGRAL - * EXTREME MIN VALUE OF AVAIL IF RES - * MAX VALUE OF AVAIL IF BIN - * INITIAL INITIAL VALUE OF THE RESOURCE - * LASTRTIME TIME OF LAST ACQUIRE/RETURN OF RES - * OR LAST TAKE/GET OF BIN - * - * PROCEDURES: - * REPORT PRINTS ON ONE LINE - * RES =TITLE/RESET/OBS/LIMIT/MIN/NOW/%USAGE/AV.WAIT/QMAX - * BIN =TITLE/RESET/OBS/INIT/MAX/NOW/AV.FREE/WAIT/QMAX - * - * RESET SETS OBS, ZEROS, USERS TO ZERO - * SINT, QINT, CUM TO ZERO - * LASTQTIME, RESETAT TO TIME - * MAXLENGTH TO LENGTH - * EXTREME TO AVAIL - *; - INTEGER EXTREME, INITIAL, USERS; - REAL SINT, LASTRTIME; - - PROCEDURE REPORT; - BEGIN REAL T, SPAN, X; - T := TIME; - SPAN := T- RESETAT; - WRITETRN; - FUDGE: OUTF.IMAGE.SUB(24, 7).PUTINT(USERS); - OUTF.OUTINT(INITIAL, 5); - OUTF.OUTINT(EXTREME, 5); - OUTF.OUTINT(AVAIL, 5); - X := SINT + (T-LASTRTIME)*AVAIL; - IF SPAN < EPSILON THEN OUTF.OUTTEXT(MINUSES.SUB(1, 10)) ELSE - IF THIS RESOURCE IS BIN THEN PRINTREAL(X/SPAN) ELSE - PRINTREAL((1.0-X/(INITIAL*SPAN))*100.0); - IF OBS = 0 THEN OUTF.OUTTEXT(MINUSES.SUB(1,10)) - ELSE PRINTREAL(CUM/OBS); - OUTF.OUTINT(MAXLENGTH,5); - OUTF.OUTIMAGE; - END***REPORT***; - - PROCEDURE RESET; - BEGIN - OBS := ZEROS := USERS := 0; - MAXLENGTH := LENGTH; - LASTRTIME := LASTQTIME := RESETAT := TIME; - QINT := SINT := CUM := 0.0; - EXTREME := AVAIL; - END***RESET***; - - INITIAL := AVAIL; - END***RESOURCE***; - - COMMENT------------R E S-----------------------; - - RESOURCE CLASS RES; - BEGIN - COMMENT - * A RES OBJECT MAKES MUTUAL EXCLISION AVAILABLE IN DEMOS. - * AN OBJECT WITH LIMIT = N > 0 CAN BE 'USED' BY UP TO - * N ENTITIES AT A TIME, BUT NO MORE. IT CAN BE SEIZED - * IN INTEGER CHUNKS (0 < CHUNK <= LIMIT), AND RETURNED - * ALL AT ONCE OR IN PART CHUNKS. IF THE AMOUNT - * REQUESTED IS NOT FREE, THE REQUESTER IS DELAYED. - * WHEN AN ENTITY RETURNS UNITS TO THE RES, THE - * QUEUE OF BLOCKED ENTITIES IS TESTED FROM THE - * FRONT. - * - * VARIABLES: - * .TITLE USER SUPPLIED DESCRIPTIVE TEXT - * .OBS NO. OF COMPLETED USAGES (CALLS ON RETURN) - * .RESETAT TIME OF CREATION, OR LAST RESET. - * .NEXT REF TO NEXT TAB IN REPORTQ - * .AVAIL AMOUNT CURRENTLY FREE - * .SINT MAINTAINS TIME WEIGHTED AVERAGE OF - * RESOURCE USAGE - * .EXTREME MINIMUM LEVEL REACHED - * INITIAL MAXIMUM LEVEL - * - * PROCEDURES: - * ACQUIRE(N) SUCCESS IF N <= AVAIL AND - * CURRENT.PRIORITY > FIRST.PRIORITY - * AND THEN AVAIL := AVAIL - N. - * ELSE CURRENT IS BLOCKED IN THIS QUEUE - * *ERRORS: N < 0 - * N > LIMIT - * - * RETURN(N) AVAIL := AVAIL + N - * ACTIVATE FIRST DELAY 0.0 - * (FIRST WILL HIMSELF SEE IF HE CAN GO) - * *ERRORS: N < 0 - * N > LIMIT - * - * .REPORT SEE RESOURCE - * - * .RESET SEE RESOURCE - * - *; - - PROCEDURE ACQUIRE(M); INTEGER M; - BEGIN - REAL T; - IF M < 1 OR M > INITIAL THEN - ERROR(IF M < 1 THEN 4 ELSE 5, NONE, THIS RES, M, - "R.AQUIRE(N); REF(RES)R; INTEGER N;"); - CURRENT.INTO(THIS QUEUE); - CURRENT.WANTS := M; - IF M > AVAIL OR CURRENT =/= FIRST THEN - BEGIN - IF ZYQTRACE>0 THEN NOTE(4,"AWAITS",NONE,THIS RES,0.0,M); - ZYQPASSIVATE; - WHILE M > AVAIL OR CURRENT =/= FIRST DO - ZYQPASSIVATE; - END; - IF ZYQTRACE>0 THEN NOTE(5,"SEIZES",NONE,THIS RES,0.0,M); - T := TIME; - SINT := SINT + (T-LASTRTIME)*AVAIL; - LASTRTIME := T; - AVAIL := AVAIL - M; - IF AVAIL < EXTREME THEN EXTREME := AVAIL; - CURRENT.OUT; - CURRENT.WANTS := 0; - IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) - THEN FIRST.INSERTAFTERCURRENT; - END***ACQUIRE***; - - PROCEDURE RELEASE(M); INTEGER M; - BEGIN - REAL T; - IF M < 1 OR (AVAIL+M) > INITIAL THEN - ERROR(IF M < 1 THEN 7 ELSE 8, NONE, THIS RES, M, - "R.RELEASE(N); REF(RES)R; INTEGER N;"); - IF ZYQTRACE>0 THEN NOTE(6,"RELEASES",NONE,THIS RES,0,M); - T := TIME; - SINT := SINT + (T-LASTRTIME)*AVAIL; - LASTRTIME := T; - AVAIL := AVAIL + M; - USERS := USERS + 1; - IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) - THEN FIRST.INSERTDELAY0; - END***RELEASE***; - - IF AVAIL < 1 THEN - ERROR(10, NONE, THIS RES, AVAIL, - "NEW RES(TITLE, LIM); TEXT TITLE; INTEGER LIM;"); - JOIN(RESQ); - END***RES***; - - COMMENT------------B I N-----------------------; - - RESOURCE CLASS BIN; - BEGIN - COMMENT - * CLASS BIN CATERS FOR FOR THE PRODUCER/CONSUMER - * COOPERATION : THE PRODUCER GIVES, THE CONSUMER - * TAKES. - * - * VARIABLES: - * .TITLE USER SUPPLIED DESCRIPTIVE TEXT - * .RESETAT TIME OF CREATION, OR LAST RESET - * .OBS NO. OF COMPLETED USAGES(CALLS ON GIVE) - * .NEXT REF TO NEXT TAB IN BINQ - * .AVAIL AMOUNT CURRENTLY FRCE - * .SINT KEEPS TIME-WEIGHTED AVERAGE OF BIN USAGE - * .EXTREME MAXIMUM LEVEL ATTAINED - * INITIAL INITIAL VALUE OF AVAIL - * - * PROCEDURES: - * GIVE(M) INCREMENTS AVAIL BY M - * ACTIVATES FIRST - * *ERRORS : M <= 0 - * - * TAKE(M) BLOCKS CURRENT IF CAN'T PROCEED - * (FIRST IN 0 AND AVAIL > = M) - * WHEN CAN PROCEED, LEAVES Q - * DECREMENTS AVAIL AND ACTIVATES - * FIRST - * *ERROR : M <= 0. - * - * .RESET SEE RESOURCE - * - * .REPORT SEE RESOURCE - *; - - PROCEDURE TAKE(M); INTEGER M; - BEGIN - REAL T; - IF M < 1 THEN - ERROR(6, NONE, THIS BIN, 0, - "B.TAKE(M); REF(BIN)B; INTEGER M;"); - CURRENT.INTO(THIS QUEUE); - CURRENT.WANTS := M; - IF CURRENT =/= FIRST OR M > AVAIL THEN - BEGIN - IF ZYQTRACE>0 THEN NOTE(7,"AWAITS",NONE,THIS BIN,0.0,M); - ZYQPASSIVATE; - WHILE CURRENT =/= FIRST OR M > AVAIL DO - ZYQPASSIVATE; - END; - CURRENT.OUT; - CURRENT.WANTS := 0; - IF ZYQTRACE>0 THEN NOTE(8,"SEIZES",NONE,THIS BIN,0.0,M); - T := TIME; - SINT := SINT + (T-LASTRTIME)*AVAIL; - LASTRTIME := T; - AVAIL := AVAIL - M; - IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) - THEN FIRST.INSERTAFTERCURRENT; - END***TAKE***; - - PROCEDURE GIVE(M); INTEGER M; - BEGIN - REAL T; - IF M < 1 THEN ERROR(9, NONE, THIS BIN, M, - "B.GIVE(N); REF(BIN)B; INTEGER N;"); - IF ZYQTRACE>0 THEN NOTE(9,"GIVES",NONE,THIS BIN,0.0,M); - T := TIME; - SINT := SINT + (T-LASTRTIME)*AVAIL; - LASTRTIME := T; - AVAIL := AVAIL + M; - USERS := USERS + 1; - IF AVAIL > EXTREME THEN EXTREME := AVAIL; - IF (IF FIRST == NONE THEN FALSE ELSE FIRST.WANTS <= AVAIL) - THEN FIRST.INSERTDELAY0; - END***GIVE***; - - IF AVAIL < 0 THEN ERROR(11, NONE, THIS BIN, AVAIL, - "NEW BIN(TITLE, INIT); TEXT TITLE; INTEGER INIT;"); - JOIN(BINQ); - END***BIN***; - - COMMENT----------------W A I T Q--------------------; - - QUEUE CLASS WAITQ; - BEGIN - REF(QUEUE)MASTERQ; - - PROCEDURE WAIT; - BEGIN - CURRENT.INTO(THIS QUEUE); - IF ZYQTRACE>0 THEN NOTE(14,"WAITS",NONE,THIS QUEUE,0.0,0); - IF MASTERQ.FIRST =/= NONE THEN MASTERQ.FIRST.INSERTDELAY0; - ZYQPASSIVATE; - END***WAIT***; - - REF(ENTITY)PROCEDURE COOPT; - BEGIN - REF(ENTITY)P; - CURRENT.INTO(MASTERQ); - IF LENGTH = 0 OR CURRENT =/= MASTERQ.FIRST THEN - BEGIN - IF ZYQTRACE>0 THEN NOTE(17,"WAITS",NONE,MASTERQ,0.0,0); - ZYQPASSIVATE; - WHILE LENGTH = 0 DO - ZYQPASSIVATE; - P :- CURRENT.SUC; - IF P =/= NONE AND LENGTH > 1 THEN P.INSERTAFTERCURRENT; - END; - CURRENT.OUT; - P :- COOPT :- FIRST; - P.COOPT; - END***COOPT***; - - BOOLEAN PROCEDURE AVAIL(E, C); NAME E, C; - REF(ENTITY)E; BOOLEAN C; - BEGIN - REF(ENTITY)P; - E :- P :- FIRST; - WHILE (IF P == NONE THEN FALSE ELSE NOT C) DO - P :- E :- P.SUC; - AVAIL := P =/= NONE; - END***AVAIL***; - - PROCEDURE FIND(E, C); NAME E, C; - REF(ENTITY)E; BOOLEAN C; - BEGIN - REF(ENTITY)P; - CURRENT.INTO(MASTERQ); - IF NOT AVAIL(E, C) THEN - BEGIN - IF ZYQTRACE > 0 THEN - NOTE(15,"IS BLOCKED",NONE,THIS WAITQ,0.0,0); - ZYQPASSIVATE; - WHILE NOT AVAIL(E, C) DO - BEGIN - IF CURRENT.SUC =/= NONE AND LENGTH > 0 THEN - CURRENT.SUC.INSERTAFTERCURRENT; - ZYQPASSIVATE; - END; - END; - P :- CURRENT.SUC; - CURRENT.OUT; - E.COOPT; - IF ZYQTRACE>0 THEN NOTE(16,"FINDS",E,THIS WAITQ,0.0,0); - IF P =/= NONE AND LENGTH > 0 THEN P.INSERTAFTERCURRENT; - END***FIND***; - - MASTERQ :- NEW NOQUEUE(TITLE); - MASTERQ.JOIN(WAITQQ); - JOIN(WAITQQ); - END***WAITQ***; - - COMMENT---------------C O N D Q-------------------; - - QUEUE CLASS CONDQ; - BEGIN - COMMENT - * CONDQ SUPPLIES THE WAITUNTIL CAPABILITY TO DEMOS. - * AN ENTITY WAITING UNTIL TESTS THE CONDITION AT - * ONCE: IF TRUE, IT PROCEEDS WITHOUT DELAY. - * OTHERWISE IT IS DELAYED UNTIL SIGNALLED TO GO ON. - * IF ALL IS SET, SIGNAL CHECKS EACH AND EVERY ENTITY - * WAITING UNTIL. ELSE ONLY THOSE AT THE HEAD OF THE - * QUEUE ARE TESTED. - * - * VARIABLES: - * .AS QUEUE - * ALL SIGNAL TESTS ALL WAITING ENTITIES IF SET - * - * PROCEDURES: - * WAITUNTIL KEEPS AN ENTITY IN THIS CONDQ - * UNTIL THE CONDITION IS FULFILLED - * - * SIGNAL ISSUED BY AN ENTITY ON FREEING SYSTEM - * RESOURCES. TESTS DORMANT ENTITIES - *; - - BOOLEAN ALL; - - PROCEDURE WAITUNTIL(C); NAME C; BOOLEAN C; - BEGIN - CURRENT.INTO(THIS CONDQ); - IF NOT C THEN - BEGIN - IF ZYQTRACE > 0 THEN - NOTE(19,"W'UNTIL IN", NONE,THIS CONDQ,0.0,0); - ZYQPASSIVATE; - WHILE NOT C DO - BEGIN - IF ALL AND CURRENT.SUC =/= NONE THEN - CURRENT.SUC.INSERTAFTERCURRENT; - ZYQPASSIVATE; - END; - IF ZYQTRACE>0 THEN NOTE(20,"LEAVES",NONE,THIS CONDQ,0.0,0); - END; - IF CURRENT.SUC=/=NONE THEN CURRENT.SUC.INSERTAFTERCURRENT; - CURRENT.OUT; - END***WAITUNTIL***; - - PROCEDURE SIGNAL; - BEGIN - IF ZYQTRACE > 0 THEN - NOTE(25, "SIGNALS", NONE, THIS CONDQ, 0.0, 0); - IF LENGTH > 0 THEN FIRST.INSERTDELAY0; - END***SIGNAL***; - - JOIN(CONDQQ); - END***CONDQ***; - - COMMENT----------T R A C I N G R O U T I N E S-------------; - - REAL ZYQNOTELASTT; REF(ENTITY)ZYQNOTELASTE; INTEGER ZYQTRACE; - - PROCEDURE TRACE; - IF ZYQTRACE > 0 THEN ZYQTRACE := ZYQTRACE+1 ELSE - BEGIN OUTF.OUTIMAGE; OUTF.OUTIMAGE; - CLOCKTIME; - BOX("T R A C I N G C O M M E N C E S"); - OUTF.OUTTEXT(" TIME/ CURRENT AND ITS ACTION(S)"); - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - ZYQTRACE := 1; - END***TRACE***; - - PROCEDURE NOTRACE; - IF ZYQTRACE > 1 THEN ZYQTRACE := ZYQTRACE-1 ELSE - BEGIN OUTF.OUTIMAGE; OUTF.OUTIMAGE; - CLOCKTIME; - BOX("T R A C I N G S W I T C H E D O F F"); - ZYQTRACE := 0; - ZYQNOTELASTT := -15.0; - ZYQNOTELASTE :- NONE; - END***NOTRACE***; - - PROCEDURE NOTE(INDEX,ACTION,E,L,T1,N);VALUE ACTION;TEXT ACTION; - INTEGER INDEX, N; REAL T1; REF(ENTITY)E; REF(TAB)L; - BEGIN REAL T; REF(ENTITY)C; - - PROCEDURE INTOUT(N); INTEGER N; - BEGIN INTEGER P; - IF N < 0 THEN - BEGIN - N := -N; - OUTF.OUTCHAR('-'); - END; - P := IF N < 10 THEN 1 ELSE - IF N < 100 THEN 2 ELSE - IF N < 1000 THEN 3 ELSE - IF N < 10000 THEN 4 ELSE - IF N < 100000 THEN 5 ELSE 10; - OUTF.OUTINT(N, P); - END***INTOUT***; - - PROCEDURE REALOUT(X); REAL X; - BEGIN INTEGER P; - IF X < 0 THEN - BEGIN - X := -X; - OUTF.OUTCHAR('-'); - END; - P := IF X < 10.0 THEN 5 ELSE - IF X < 100.0 THEN 6 ELSE - IF X < 1000.0 THEN 7 ELSE - IF X < 10000.0 THEN 8 ELSE - IF X < 100000.0 THEN 9 ELSE 0; - IF P = 0 THEN OUTF.OUTREAL(X, 5, 10) ELSE OUTF.OUTFIX(X, 3, P); - END***REALOUT***; - - SWITCH MESSAGE := M1, M2, M3, M4, M5, M6, M7, M8, M9, - M10,M11,M12,M13,M14,M15,M16,M17,M18, - M19,M20,M21,M22,M23,M24,M25; - T := TIME; - C :- CURRENT; - IF (ABS(T)-ZYQNOTELASTT) > 0.0005 THEN - BEGIN ZYQNOTELASTT := T; - PRINTREAL(T); - END; - IF ZYQNOTELASTE =/= C THEN - BEGIN OUTF.SETPOS(12); - ZYQNOTELASTE :- C; - OUTF.OUTTEXT(C.TITLE); - END; - - OUTF.SETPOS(25); - OUTF.OUTTEXT(ACTION); - OUTF.OUTCHAR(' '); - GOTO MESSAGE(INDEX); - - M1: COMMENT E.COOPT; - M18: COMMENT Q.COOPT - COOPTS; - M23: COMMENT CANCEL(E); - IF E == NONE THEN OUTF.OUTTEXT("NONE~") ELSE - IF E == CURRENT THEN OUTF.OUTTEXT("ITSELF") - ELSE OUTF.OUTTEXT(E.TITLE); - IF L =/= NONE THEN - BEGIN OUTF.OUTTEXT(" FROM "); - OUTF.OUTTEXT(L.TITLE); - END; - GOTO EXIT; - - M2: COMMENT E.SCHEDULE(T); - OUTF.OUTTEXT(E.TITLE); - IF T1 <= 0.0 THEN OUTF.OUTTEXT(" NOW") ELSE - BEGIN OUTF.OUTTEXT(" AT "); - REALOUT(T+T1); - END; - GOTO EXIT; - - M3: COMMENT TERMINATES; - GOTO EXIT; - - M4: COMMENT RES.ACQUIRE - BLOCKED; - M5: COMMENT RES.ACQUIRE - SEIZES; - M6: COMMENT RES.RELEASE - RELEASES; - M7: COMMENT BIN.TAKE - BLOCKED; - M8: COMMENT BIN.TAKE - SEIZES; - M9: COMMENT BIN.GIVE - RELEASES; - INTOUT(N); - IF INDEX=6 OR INDEX=9 THEN OUTF.OUTTEXT(" TO ") - ELSE OUTF.OUTTEXT(" OF "); - OUTF.OUTTEXT(L.TITLE); - GOTO EXIT; - - M16: COMMENT Q.FIND - FINDS; - OUTF.OUTTEXT(E.TITLE); - OUTF.OUTCHAR(' '); - - M14: COMMENT Q.WAIT; - M15: COMMENT Q.FIND - BLOCKED; - M17: COMMENT Q.COOPT - BLOCKED; - OUTF.OUTTEXT("IN "); - - M19: COMMENT Q.WAITUNTIL - WAITS; - M20: COMMENT Q.WAITUNTIL - LEAVES; - M25: COMMENT Q.SIGNAL; - OUTF.OUTTEXT(L.TITLE); - GOTO EXIT; - - M21: COMMENT HOLDS; - REALOUT(T1); - OUTF.OUTTEXT(", UNTIL "); - REALOUT(T+T1); - GOTO EXIT; - - M22: COMMENT ZYQPASSIVATE; - GOTO EXIT; - - M24: COMMENT E.INTERRUPT(N); - OUTF.OUTTEXT(E.TITLE); - OUTF.OUTTEXT(", WITH N = "); - INTOUT(N); - GOTO EXIT; - - M10:M11:M12:M13: - EXIT: OUTF.OUTIMAGE; - END***NOTE***; - - PROCEDURE ERROR(NO, E, Q, N, CALL); - VALUE CALL; INTEGER NO, N; - TEXT CALL; REF(ENTITY)E; REF(TAB)Q; - BEGIN - - PROCEDURE NEXTLINE; - BEGIN - OUTCHAR('.'); - OUTIMAGE; - SYSOUT.SETPOS(9); - END***NEXTLINE***; - - PROCEDURE INTOUT(N); INTEGER N; - BEGIN INTEGER P; - OUTCHAR(' '); - IF N < 0 THEN - BEGIN - N := -N; - OUTCHAR('-'); - END; - P := IF N < 10 THEN 1 ELSE - IF N < 100 THEN 2 ELSE - IF N < 1000 THEN 3 ELSE - IF N < 10000 THEN 4 ELSE - IF N < 100000 THEN 5 ELSE 10; - OUTINT(N, P); - END***INTOUT***; - - PROCEDURE PRINTREAL(X); REAL X; - BEGIN INTEGER P; - OUTCHAR(' '); - IF X < 0 THEN - BEGIN - X := -X; - OUTCHAR('-'); - END; - P := IF X < 10.0 THEN 5 ELSE - IF X < 100.0 THEN 6 ELSE - IF X < 1000.0 THEN 7 ELSE - IF X < 10000.0 THEN 8 ELSE - IF X < 100000.0 THEN 9 ELSE 0; - IF P = 0 THEN OUTREAL(X, 5, 10) ELSE OUTFIX(X, 3, P); - END***PRINTREAL***; - - REF(ENTITY)C; - SWITCH CASE := E1, E2, E3, E4, E5, E6, E7, E8, E9, E10, - E11,E12,E13,E14,E15,E16,E17,E18,E19,E20; - - SYSOUT.SETPOS(23); - OUTTEXT("CLOCK TIME = "); - IF TIME > 99999.0 THEN OUTREAL(TIME, 5, 12) - ELSE OUTFIX(TIME, 3, 10); - OUTIMAGE; - ABORT(FALSE); - - OUTTEXT("**CAUSE : CALL ON '"); - OUTTEXT(CALL); - OUTCHAR('''); - NEXTLINE; - - OUTTEXT("CURRENT == "); - OUTTEXT(CURRENT.TITLE); - NEXTLINE; - GOTO CASE(NO); - - E1: COMMENT E.COOPT; - OUTTEXT("ATTEMPT BY CURRENT TO COOPT '"); - OUTTEXT(E.TITLE); - OUTCHAR('''); - NEXTLINE; - OUTTEXT(E.TITLE); - OUTTEXT(" IS ALREADY COOPTED BY "); - OUTTEXT(E.OWNER.TITLE); - GOTO BLOWUP; - - E2: COMMENT E.INTO(Q); - OUTTEXT("Q == NONE"); - NEXTLINE; - OUTTEXT("ATTEMPT BY CURRENT TO PLACE "); - IF E == CURRENT THEN OUTTEXT("ITSELF") - ELSE OUTTEXT(E.TITLE); - OUTTEXT(" INTO A NULL QUEUE"); - NEXTLINE; - OUTTEXT("STATEMENT IGNORED."); - GOTO CONTINUE; - - E3: COMMENT E.INTO(Q); - OUTTEXT("CURRENT TRIES TO PLACE "); - IF E == CURRENT THEN OUTTEXT("ITSELF") - ELSE OUTTEXT(E.TITLE); - OUTTEXT(" INTO QUEUE '"); - OUTTEXT(Q.TITLE); OUTCHAR('''); - NEXTLINE; - OUTTEXT(E.TITLE); - OUTTEXT(" IS ALREADY IN "); - OUTTEXT(E.CURRENTQ.TITLE); - NEXTLINE; - OUTTEXT(E.TITLE); - OUTTEXT(" LEAVES "); - OUTTEXT(E.CURRENTQ.TITLE); - OUTTEXT(" AND ENTERS "); - IF Q == NONE THEN OUTTEXT("A NULL QUEUE~") - ELSE OUTTEXT(Q.TITLE); - GOTO CONTINUE; - - E4: COMMENT R.ACQUIRE(N) : N < 0; - E5: COMMENT R.ACQUIRE(N) : N > R.LIMIT; - E6: COMMENT B.TAKE(N) : N < 0; - E7: COMMENT R.RELEASE(N) : N < 0; - E8: COMMENT R.RELEASE(N) : N > R.LIMIT; - E9: COMMENT B.GIVE(N) : N < 0; - OUTTEXT("N ="); - INTOUT(N); - NEXTLINE; - IF NO <= 6 THEN OUTTEXT("REQUEST FOR ") - ELSE OUTTEXT("ATTEMPT TO RETURN "); - IF N < 1 THEN OUTTEXT("NON-POSITIVE") - ELSE OUTTEXT("TOO MANY"); - OUTTEXT(" UNITS "); - IF NO <= 6 THEN OUTTEXT("FROM ") ELSE OUTTEXT("TO "); - IF Q IN RES THEN OUTTEXT("RES") ELSE OUTTEXT("BIN"); - OUTCHAR(' '); OUTCHAR('''); - OUTTEXT(Q.TITLE); OUTCHAR('''); - NEXTLINE; - IF Q IN BIN THEN OUTTEXT("SET N > 0") ELSE - BEGIN - OUTTEXT("SET 0 < N <= R.LIMIT (="); - INTOUT(Q QUA RESOURCE.INITIAL); - OUTCHAR(')'); - END; - GOTO BLOWUP; - - E10: COMMENT NEW RES(TITLE, LIMIT); - E11: COMMENT NEW BIN(TITLE, INITIAL SIZE); - IF NO = 10 THEN OUTTEXT("LIMIT OF RES '") - ELSE OUTTEXT("INITIAL SIZE OF BIN '"); - OUTTEXT(Q.TITLE); - OUTTEXT("' ="); - INTOUT(N); - NEXTLINE; - OUTTEXT("IT SHOULD BE "); - IF NO=10 THEN OUTTEXT("POSITIVE") - ELSE OUTTEXT("NON-NEGATIVE"); - OUTCHAR('.'); OUTCHAR(' '); - IF NO=10 THEN OUTTEXT("SET LIMIT > 0") - ELSE OUTTEXT("SET INITIAL SIZE >= 0"); - GOTO BLOWUP; - - E12: COMMENT X.CANCEL : X IDLE; - OUTTEXT("ENTITY '"); - OUTTEXT(E.TITLE); - OUTTEXT("' IS NOT IN THE EVENT LIST."); - OUTIMAGE; - GOTO CONTINUE; - - E13: COMMENT X.CANCEL : X SOLE ENTITY IN EVENT LIST; - OUTTEXT("ATTEMPT TO CANCEL LAST ENTITY IN EVENT LIST"); - GOTO BLOWUP; - - E14: COMMENT E.SCHEDULE(T) : E TERMINATED; - OUTTEXT("E == '"); - OUTTEXT(E.TITLE); - OUTTEXT("' IS TERMINATED AND CANNOT BE SCHEDULED"); - GOTO BLOWUP; - - E15: COMMENT IMPLEMENTATION ERROR; - OUTTEXT("SYSTEM ERROR: PLEASE CONTACT THE "); - OUTTEXT("IMPLEMENTOR, GRAHAM BIRTWISTLE."); - GOTO BLOWUP; - - E16: COMMENT E.SCHEDULE(T): REF(ENTITY)T: REAL T; - OUTTEXT("E == '"); - OUTTEXT(E.TITLE); - OUTTEXT("' IS ALREADY SCHEDULED."); - GOTO JOIN; - - E17: COMMENT E.CANCEL: REF(ENTITY)E; - OUTTEXT("ATTEMPT TO CANCEL NON-SCHEDULED ENTITY E == '"); - OUTTEXT(E.TITLE); OUTCHAR('''); - JOIN: NEXTLINE; - OUTTEXT("STATEMENT IGNORED."); - GOTO CONTINUE; - - E18: COMMENT T.JOIN(R): REF(TAB)T: REF(REPORTQ)R; - OUTTEXT("TAB '"); - OUTTEXT(Q.TITLE); - OUTTEXT("' TRIES TO JOIN A NULL REPORTQ"); - NEXTLINE; - OUTTEXT("T WILL NOT BE REPORTED UNLESS YOU "); - OUTTEXT(" CALL 'T.REPORT'."); - GOTO CONTINUE; - - E19: COMMENT NEW HISTOGRAM(T, L, U, N); - OUTTEXT("ATTEMPT TO CREATE ILLEGAL HISTOGRAM '"); - OUTTEXT(Q.TITLE); - OUTCHAR('''); - NEXTLINE; - OUTTEXT("LOWER BOUND = "); - PRINTREAL(Q QUA HISTOGRAM.LOWER); - NEXTLINE; - OUTTEXT("UPPER BOUND = "); - PRINTREAL(Q QUA HISTOGRAM.UPPER); - NEXTLINE; - OUTTEXT("UPPER MUST BE GREATER THAN LOWER"); - NEXTLINE; - OUTTEXT("ACTION: LOWER <- 0.0, AND UPPER <- 100.0."); - GOTO CONTINUE; - - E20: COMMENT NEW EMPIRICAL(T, 1); - OUTTEXT("ATTEMPT TO CREATE EMPIRICAL OBJECT '"); - OUTTEXT(Q.TITLE); OUTCHAR('''); - NEXTLINE; - OUTTEXT("SIZE = 1. SET SIZE > 1"); - GOTO BLOWUP; - - BLOWUP: OUTCHAR('.'); OUTIMAGE; - ABORT(TRUE); - CONTINUE: OUTIMAGE; OUTIMAGE; - END***ERROR***; - - PROCEDURE ABORT(B); BOOLEAN B; - BEGIN - INTEGER L; - IF B THEN L := 27 ELSE L := 28; - OUTTEXT(MINUSES); OUTIMAGE; - OUTTEXT(MINUSES.SUB(1, L)); - IF B THEN OUTTEXT("PROGRAM ABORTED") - ELSE OUTTEXT("SERIOUS ERROR"); - OUTTEXT(MINUSES.SUB(1, L)); OUTIMAGE; - OUTTEXT(MINUSES); OUTIMAGE; - IF B THEN - BEGIN - IF INF =/= SYSIN AND INF.IMAGE =/= NOTEXT THEN INF.CLOSE; - IF OUTF =/= SYSOUT AND OUTF.IMAGE =/= NOTEXT THEN OUTF.CLOSE; - L := 0; - L := 1/L; - END; - END***ABORT***; - - COMMENT---------S N A P P I N G R O U T I N E S------------; - - PROCEDURE REPORT; - BEGIN REF(REPORTQ)R; - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - CLOCKTIME; - BOX("R E P O R T"); - FOR R:-DISTQ,EMPQ,ACCUMQ,COUNTQ,TALLYQ,HISTOQ,REGRESSQ, - RESQ,BINQ,QUEUEQ,WAITQQ,CONDQQ DO - IF R.FIRST =/= NONE THEN - BEGIN - OUTF.OUTIMAGE; - OUTF.OUTIMAGE; - R.REPORT; - END; - END***REPORT***; - - PROCEDURE NOREPORT; - ZYQREPORT := FALSE; - - PROCEDURE RESET; - BEGIN REF(REPORTQ)R; - FOR R:-DISTQ,EMPQ,ACCUMQ,COUNTQ,TALLYQ,HISTOQ,REGRESSQ, - RESQ,BINQ,QUEUEQ,WAITQQ,CONDQQ DO - IF R.FIRST =/= NONE THEN R.RESET; - END***RESET***; - - PROCEDURE SNAPQUEUES; - BEGIN REF(TAB)Q; INTEGER K; REF(ENTITY)E; - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - CLOCKTIME; - BOX("L I S T O F P A S S I V E O B J E C T S"); - FOR Q :- QUEUEQ.FIRST, CONDQQ.FIRST, WAITQQ.FIRST DO - BEGIN - WHILE Q =/= NONE DO - BEGIN - Q QUA QUEUE.LIST; - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - Q :- Q.NEXT; - END; - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - END; - END***SNAPQUEUES***; - - PROCEDURE SNAPSQS; - BEGIN INTEGER K; - PROCEDURE TRAVERSE(R); REF(ENTITY)R; - BEGIN - IF R.LL =/= NONE THEN TRAVERSE(R.LL); - IF R.RL =/= NONE THEN TRAVERSE(R.RL); - K := K+1; OUTF.OUTINT(K, 5); R.LIST; - END***TRAVERSE***; - - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - CLOCKTIME; - BOX("E V E N T L I S T"); - OUTF.OUTTEXT(" N/ EV. TIME/OBJ. TITLE / "); - OUTF.OUTTEXT("LL BL RL"); - OUTF.OUTIMAGE; - TRAVERSE(ROOT); - OUTF.OUTIMAGE; OUTF.OUTIMAGE; - END***SNAPSQS***; - - ENTITY CLASS MAINPROGRAM; - BEGIN - LOOP: - DETACH; - GOTO LOOP; - END***MAINPROGRAM***; - - CLASS ZYQENTTITLE(T); TEXT T; - BEGIN INTEGER N, L; - REF(ZYQENTTITLE)NEXTTITLE; - NEXTTITLE :- ZYQENTNAMES; - ZYQENTNAMES :- THIS ZYQENTTITLE; - L := T.LENGTH; - N := 1; - END***ZYQENTTITLE***; - - COMMENT--------LOCAL VARIABLES AND THEIR INITIALISATIONS ----; - - REF(REPORTQ)EMPQ, TALLYQ, ACCUMQ, HISTOQ, COUNTQ, DISTQ; - REF(REPORTQ)RESQ, BINQ, QUEUEQ, CONDQQ, WAITQQ, REGRESSQ; - TEXT TALLYHEADING, ACCUMHEADING, DISTHEADING; - TEXT HEADINGRTN, STARS, MINUSES, ZYQREASON, ZYQRECVRY; - TEXT RESHEADING, BINHEADING, QHEADING; - TEXT ARRAY DISTTYPE(0:9); - INTEGER ZYQSEED, ZYQMODULO; - REF(INFILE)INF; - REF(OUTFILE)OUTF; - REF(ZYQENTTITLE)ZYQENTNAMES; - REF(MAINPROGRAM)DEMOS; - REF(ENTITY)ROOT, CURRENT; - REAL NOW, SIMPERIOD, EPSILON; - BOOLEAN ZYQREPORT; - - ZYQREPORT := TRUE; - - EPSILON := 0.00001; - - HEADINGRTN :-COPY("TITLE / (RE)SET/ OBS"); - ACCUMHEADING:-COPY("/ AVERAGE/EST.ST.DV/ MINIMUM/ MAXIMUM"); - DISTHEADING :-COPY("/TYPE / A/ B/ SEED"); - TALLYHEADING:-ACCUMHEADING; - RESHEADING :-COPY("/ LIM/ MIN/ NOW/ % USAGE/ AV. WAIT/QMAX"); - BINHEADING :-COPY("/INIT/ MAX/ NOW/ AV. FREE/ AV. WAIT/QMAX"); - QHEADING :-COPY("/ QMAX/ QNOW/ Q AVERAGE/ZEROS/ AV. WAIT"); - - DISTTYPE(0) :-COPY("UNDEFINED"); - DISTTYPE(1) :-COPY("NORMAL"); DISTTYPE(2) :-COPY("UNIFORM"); - DISTTYPE(3) :-COPY("ERLANG"); DISTTYPE(4) :-COPY("RANDINT"); - DISTTYPE(5) :-COPY("NEGEXP"); DISTTYPE(6) :-COPY("POISSON"); - DISTTYPE(7) :-COPY("DRAW"); DISTTYPE(8) :-COPY("CONSTANT"); - DISTTYPE(9) :-COPY("EMPIRICAL"); - - ACCUMQ :- NEW REPORTQ("A C C U M U L A T E S", - HEADINGRTN, ACCUMHEADING); - COUNTQ :- NEW REPORTQ("C O U N T S", BLANKS(20), HEADINGRTN); - DISTQ :- NEW REPORTQ("D I S T R I B U T I O N S", - HEADINGRTN, DISTHEADING ); - EMPQ :- NEW REPORTQ("E M P I R I C A L S", NOTEXT, NOTEXT); - REGRESSQ:-NEW REPORTQ("R E G R E S S I O N S",NOTEXT,NOTEXT); - HISTOQ :- NEW REPORTQ("H I S T O G R A M S", NOTEXT, NOTEXT); - TALLYQ :- NEW REPORTQ("T A L L I E S",HEADINGRTN,TALLYHEADING); - RESQ :- NEW REPORTQ("R E S O U R C E S",HEADINGRTN, - RESHEADING); - BINQ :- NEW REPORTQ("B I N S",HEADINGRTN,BINHEADING); - QUEUEQ :- NEW REPORTQ("Q U E U E S",HEADINGRTN,QHEADING); - CONDQQ :- NEW REPORTQ("C O N D I T I O N Q U E U E S", - HEADINGRTN, QHEADING); - WAITQQ :- NEW REPORTQ("W A I T Q U E U E S", - HEADINGRTN, QHEADING); - - STARS :- BLANKS(70); - WHILE STARS.MORE DO - STARS.PUTCHAR('*'); - - MINUSES :- BLANKS(70); - WHILE MINUSES.MORE DO - MINUSES.PUTCHAR('-'); - - INF :- SYSIN; - OUTF :- SYSOUT; - ZYQREASON :- COPY("**REASON : "); - ZYQRECVRY :- COPY("**RECOVERY : "); - ZYQMODULO := 67099547; ZYQSEED := 907; - NOW := -10&20; - ZYQNOTELASTT := -15.0; - CURRENT :- ROOT :- DEMOS :- NEW MAINPROGRAM("DEMOS"); - DEMOS.EVTIME := 0.0; - DEMOS.TITLE :- DEMOS.TITLE.SUB(1, 5); - INNER; - WHILE (IF DEMOS==ROOT THEN FALSE ELSE - DEMOS.BL.EVTIME<=DEMOS.EVTIME) DO - BEGIN - HOLD(0.0); - END; - IF ZYQREPORT THEN REPORT; - IF INF =/= SYSIN AND INF.IMAGE =/= NOTEXT THEN INF.CLOSE; - IF OUTF =/= SYSOUT AND OUTF.IMAGE =/= NOTEXT THEN OUTF.CLOSE; - END***DEMOS***; \ No newline at end of file From 395ca273adc2077e572709efcf253726d2b9ee2f Mon Sep 17 00:00:00 2001 From: Eirik Sletteberg Date: Tue, 26 Nov 2024 20:51:52 +0100 Subject: [PATCH 8/8] Use same scope name as grammar definition Co-authored-by: Colin Seymour --- lib/linguist/languages.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 484b31ea21..cd15b8dc7e 100644 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -6830,7 +6830,7 @@ Simula: - ".sim" aliases: - sim - tm_scope: source.simula + tm_scope: source.sim ace_mode: simula codemirror_mode: simula codemirror_mime_type: text/x-simula