Public Class Acepm ' Integer -> Short, Long -> Integer. ' Data sizes changed since DD implemented all this. Dim MemH(500) As Integer, MemL(500) As Integer Dim N As Short, S As Short, D As Short Dim C As Short, W As Short, T As Short, M As Integer Dim Go As Short, TT As Integer, ST As Short, TE As Short Dim SWH As Integer, SWL As Integer Dim TCA As Short, TCB As Short Dim Disc As Short, Buzzer As Short Dim DLA As Short, DLB As Short, MC As Short Dim ConvertedH As Integer, ConvertedL As Integer Dim Carry As Integer, Neg As Short Dim H As Integer, L As Integer Dim I As Integer, Buzz As Short Dim TempL As Integer, TempH As Integer Dim A1 As Integer, A2 As Integer, A3 As Integer, A4 As Integer Dim B1 As Integer, B2 As Integer, Prod As Integer Dim ROH As Integer, ROL As Integer, REH As Integer, REL As Integer Dim Res1 As Single, Res2 As Single 'FOR THE MULT TEST Dim Running As Short, StartMC As Short, IMC As Short Dim HeadR As Short, ShiftR As Short, Track As Short Dim HeadW As Short, ShiftW As Short, TrackR As Short, TrackW As Short Dim DLNo As Short Dim Row As Short, CardReading As Short, CardPunching As Short Dim PunchAnyCard As Short, Initial As Short Dim NewCard As Short Dim TempText As String Sub Transfer() 'Performs one minor cycle of the transfer of data from a 'source (S) to a destination (D). The word on the highway 'is SWH and SWL. A 'long' transfer with characteristic C=0 'or a double transfer with C=3 consist of more than one 'call of this subroutine in succession, under the control 'of Sub Oneshoot. There are special problems with source 20 'when TCA=1 if D=10 because the contents of DL10 must not 'be changed yet. TempH and TempL hold the transferred word 'for the next transfer, if there is one, otherwise it is 'used at the end of Oneshoot. Adding into DS14 (D=13) 'can produce a carry which must be completed, which is 'another task for Oneshoot. If the buzzer(D=29) is 'stimulated by a long transfer it creates many message 'boxes, which is annoying, so Oneshoot completes this 'operation if Buzz=1. 'ADJUST THE CONTENTS OF TS20 If TCA = 1 Then MemH(390) = MemH(320 + ((ST + 31) Mod 32)) : MemL(390) = MemL(320 + ((ST + 31) Mod 32)) 'COMPLETE THE TS20 TO DL10 TRANSFER WHEN TCA=1 If (TCA = 1 And S = 20 And D = 10 And TT > M + 2 + W) Then MemL(320 + ((ST + 31) Mod 32)) = TempL MemH(320 + ((ST + 31) Mod 32)) = TempH End If 'FIND SOURCE WORD If S = 0 Then SWL = MemL(1) SWH = MemH(1) ElseIf S < 12 Then SWL = MemL(32 * S + ST) : SWH = MemH(32 * S + ST) End If If S = 12 Then SWL = MemL(384 + (ST Mod 2)) : SWH = MemH(384 + (ST Mod 2)) If S = 13 Then 'DIVIDE DS14 BY TWO WITH POSSIBLE CARRY IN FROM 14 ODD L = MemL(386 + (ST Mod 2)) : H = MemH(386 + (ST Mod 2)) SWL = L \ 2 If (H And 1) > 0 Then SWL = SWL + 32768 SWH = H \ 2 If ST Mod 2 = 0 And TCB = 0 Then If ((MemL(387) And 1) > 0) Then SWH = SWH + 32768 Else SWH = SWH + (H And 32768) End If End If If S = 14 Then SWL = MemL(386 + (ST Mod 2)) : SWH = MemH(386 + (ST Mod 2)) If S = 15 Then SWL = MemL(388) : SWH = MemH(388) If S = 16 Then SWL = MemL(389) : SWH = MemH(389) If S = 17 Then SWL = (Not MemL(391)) And 65535 SWH = (Not MemH(391)) And 65535 End If If S = 18 Then 'DIVIDE TS26 BY TWO L = MemL(391) : H = MemH(391) SWL = L \ 2 If (H And 1) > 0 Then SWL = SWL + 32768 SWH = H \ 2 + (H And 32768) End If If S = 19 Then 'LEFT SHIFT OF TS26 SWL = MemL(391) * 2 SWH = MemH(391) * 2 If (SWL And 65536) > 0 Then SWH = SWH + 1 SWL = SWL And 65535 SWH = SWH And 65535 End If If S = 20 Then SWL = MemL(390) : SWH = MemH(390) If S = 21 Then SWL = MemL(391) And MemL(392) : SWH = MemH(391) And MemH(392) If S = 22 Then SWL = MemL(391) Xor MemL(392) : SWH = MemH(391) Xor MemH(392) If S = 23 Then SWL = 0 : SWH = 1 If S = 24 Then SWL = 0 : SWH = 32768 If S = 25 Then SWL = 1 : SWH = 0 If S = 26 Then SWL = MemL(391) : SWH = MemH(391) If S = 27 Then SWL = MemL(392) : SWH = MemH(392) If S = 28 Then SWL = 0 : SWH = 0 If S = 29 Then SWL = 65535 : SWH = 65535 If S = 30 Then If Row = 12 Then SWL = 65535 : SWH = 65535 Else SWL = 0 : SWH = 0 End If End If If S = 31 Then SWL = 0 : SWH = 0 'DELIVER TO DESTINATION If D = 0 Then MemL(0) = SWL : MemH(0) = SWH If (D = 10 And TCA = 1 And S = 20) Then TempL = SWL : TempH = SWH ElseIf (D > 0 And D < 12) Then MemL(32 * D + ST) = SWL : MemH(32 * D + ST) = SWH End If If D = 12 Then MemL(384 + (ST Mod 2)) = SWL : MemH(384 + (ST Mod 2)) = SWH If D = 13 Then 'ADD INTO DS14 WITH POSSIBLE CARRY OVER L = SWL + MemL(386 + (ST Mod 2)) 'BRINGING A CARRY OVER INTO 14 ODD If (ST Mod 2 = 1) Then If Carry = 1 Then L = L + 1 Carry = 0 End If H = SWH + MemH(386 + (ST Mod 2)) If (L And 65536) > 0 Then H = H + 1 MemL(386 + (ST Mod 2)) = L And 65535 MemH(386 + (ST Mod 2)) = H And 65535 'PRODUCING A CARRY OVER FROM 14 EVEN If (ST Mod 2 = 0) And TCB = 0 And (H And 65536) > 0 Then Carry = 1 Else Carry = 0 End If End If If D = 14 Then MemL(386 + (ST Mod 2)) = SWL : MemH(386 + (ST Mod 2)) = SWH If D = 15 Then MemL(388) = SWL : MemH(388) = SWH If D = 16 Then MemL(389) = SWL : MemH(389) = SWH If D = 17 Then 'ADD INTO TS16 L = SWL + MemL(389) H = SWH + MemH(389) If (L And 65536) > 0 Then H = H + 1 MemL(389) = L And 65535 MemH(389) = H And 65535 End If If D = 18 Then 'SUBTRACT FROM TS 16 L = MemL(389) - SWL H = MemH(389) - SWH If (L And 65536) > 0 Then H = H - 1 MemL(389) = L And 65535 MemH(389) = H And 65535 End If 'DESTINATIONS 19(MULT), 21(TCA), 22(DRUM) AND 23(TCB) ARE 'DEALT WITH IN 0NESHOOT If D = 20 Then MemL(390) = SWL : MemH(390) = SWH If D = 24 And (SWH And 32768) > 0 Then Disc = 1 If D = 25 And (SWH > 0 Or SWL > 0) Then Disc = 1 If D = 26 Then MemL(391) = SWL : MemH(391) = SWH If D = 27 Then MemL(392) = SWL : MemH(392) = SWH If D = 28 Then MemL(28) = SWL MemH(28) = SWH End If If (D = 29 And (SWH Or SWL) > 0) Then Buzz = 1 'DESTINATIONS 30(PUNCH) AND 31(READ) ARE DEALT WITH IN ONESHOOT End Sub Sub Exitt_Click(sender As Object, e As EventArgs) Handles Exitt.Click End End Sub ' Sub Oneshot_Click(sender As Object, e As EventArgs) Handles Oneshot.Click 'RowDone is a message from Oneshoot to Runit and is cleared 'when it is not wanted, in manual one-shotting. Oneshoot() 'RowDone = 0 Display() End Sub Sub Oneshoot() 'This is invoked either by the 'One-shot' button or to 'perform a single instruction when the AcePM is running 'under the Run_Click subroutine of the 'Run' button. 'First the instruction is parsed, then one of three 'routines performs the Sub Transfer operations, according 'to the value of the characteristic (C). There follow 'three short routines to complete transfer operations, '(see Sub Transfer) and fnally the next instruction is 'into the instruction register, MemH(0) and MemH(0). Dim X As Integer Disc = 0 Carry = 0 'PARSE THE INSTRUCTION X = MemL(0) \ 2 N = X Mod 8 X = X \ 8 S = X Mod 32 X = X \ 32 D = X Mod 32 X = X \ 32 C = X Mod 4 X = MemH(0) W = X Mod 32 X = X \ 256 T = X Mod 32 X = X \ 128 Go = X Mod 2 'DEAL WITH READING ROWS OF A CARD If S = 0 Then If (CardReading > 0 And Go = 0) Then If Track < 256 Then Microsoft.VisualBasic.FileSystem.FileGet(2, MemH(1)) Microsoft.VisualBasic.FileSystem.FileGet(2, MemL(1)) Else Microsoft.VisualBasic.FileSystem.FileGet(3, MemH(1)) Microsoft.VisualBasic.FileSystem.FileGet(3, MemL(1)) End If Row = Row + 1 If Row = 12 Then If Initial = 1 Then If Track < 256 Then Microsoft.VisualBasic.FileSystem.FileGet(2, MemH(2)) Else Microsoft.VisualBasic.FileSystem.FileGet(3, MemH(2)) End If End If Track = Track + 1 CardNumber.Text = Str$(Track) If (MemH(2) > 0 And Initial = 1) Then NewCard = 1 Else CardReading = 0 Initial = 0 End If End If End If End If 'RECORD THE STARTING MINOR CYCLE M M = TT 'PREPARE TE, TO ADJUST THE VALUE OF T IF NECESSARY TE = T If C = 0 Then 'CASE OF MULTIPLE TRANSFER If T < W Then TE = T + 32 For I = M + 2 + W To M + 2 + TE TT = I ST = TT And 31 Transfer() Next I End If If C = 1 Then 'CASE OF SINGLE TRANSFER If T < W Then TE = T + 32 TT = M + 2 + W ST = TT And 31 Transfer() TT = M + 2 + TE End If If C = 3 Then 'CASE OF DOUBLE TRANSFER If T < W + 1 Then TE = T + 32 TT = M + 2 + W ST = TT And 31 Transfer() TT = TT + 1 ST = TT And 31 Transfer() TT = M + 2 + TE End If 'COMPLETE THE OUTPUT AND PUNCH ROWS OF A CARD If D = 28 Then If Hexadecimal.Checked Then OutText.Text = Hexstring(28) If Dec.Checked Then OutText.Text = Decstring(28) If Instruction.Checked Then OutText.Text = Inststring(28) If (CardPunching > 0 And Go = 0) Then If Track < 256 Then Microsoft.VisualBasic.FileSystem.FilePut(2, SWH) Microsoft.VisualBasic.FileSystem.FilePut(2, SWL) Else Microsoft.VisualBasic.FileSystem.FilePut(3, SWH) Microsoft.VisualBasic.FileSystem.FilePut(3, SWL) End If Row = Row + 1 If Row = 12 Then CardPunching = 0 Track = Track + 1 PunchNumber.Text = Str$(Track) End If End If End If 'COMPLETE ANY REMAINING CARRY INTO 14 ODD L = MemL(387) H = MemH(387) If Carry = 1 Then L = L + 1 : Carry = 0 If (L And 65536) > 0 Then H = H + 1 MemL(387) = L And 65535 MemH(387) = H And 65535 'COMPLETE THE LAST TS20 TO DL10 TRANSFER WHEN TCA=1 If (TCA = 1 And S = 20 And D = 10) Then MemL(320 + ST) = TempL MemH(320 + ST) = TempH End If 'SOUND THE BUZZER IF IT HAS BEEN STIMULATED If Buzz = 1 Then Beep() : 'MsgBox("Buzzer is Sounding") :' Buzz = 0 'EFFECT MULT AND DRUM If D = 19 Then Mult() If D = 22 Then Drum() 'EFFECT TCA AND TCB If D = 21 Then TCA = C And 1 If D = 23 Then TCB = C And 1 'EFFECT READ OR PUNCH If D = 30 Then If S = 31 Then PunchAnyCard = 1 Else PunchAnyCard = 0 Track = Val(PunchNumber.Text) : PunchCard() End If If D = 31 Then Track = Val(CardNumber.Text) : ReadCard() 'PLACE THE NEXT INSTRUCTION IN MemL(1) AND MemH(1) TT = TT + Disc ST = TT And 31 If N = 0 Then N = 11 If D <> 0 Then MemL(0) = MemL(N * 32 + ST) : MemH(0) = MemH(N * 32 + ST) 'START THE NEXT CARD IN INITIAL INPUT If NewCard = 1 Then NewCard = 0 : ReadCard() End Sub Sub DLAP_Click(sender As Object, e As EventArgs) Handles DLAP.Click 'The A button at the top of the form changes the display 'of this DL successively from DL1 upwards to DL11, then 'returns to DL1, displaying the result. DLA = DLA + 1 If DLA = 12 Then DLA = 1 Display() End Sub Sub DLBP_Click(sender As Object, e As EventArgs) Handles DLBP.Click 'The B button at the top of the form changes the display 'of this DL successively from DL1 upwards to DL11, then 'returns to DL1, displaying the result. DLB = DLB + 1 If DLB = 12 Then DLB = 1 Display() End Sub Sub Form_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'Sets default values for the DLs which are displayed and 'the Hexadecimal option for word display format. Opens the 'files which store the drum and card data. DLA = 1 DLB = 2 Hexadecimal.Checked = True 'Fix the bug implemented by DD - default to hex mode so that we can run Display after opening the files ' Fix a bug implemented by DD, where you could only load data from a single path on the filesystem Dim drumLoc = IO.Path.Combine(IO.Directory.GetParent(Application.ExecutablePath).FullName, "Acedrum") Dim cardsLoc = IO.Path.Combine(IO.Directory.GetParent(Application.ExecutablePath).FullName, "Acecards") Dim punchLoc = IO.Path.Combine(IO.Directory.GetParent(Application.ExecutablePath).FullName, "Acepunch") FileOpen(1, drumLoc, OpenMode.Binary) FileOpen(2, cardsLoc, OpenMode.Binary) FileOpen(3, punchLoc, OpenMode.Binary) Display() End Sub Sub Hexadecimal_Click(sender As Object, e As EventArgs) Handles Hexadecimal.CheckedChanged 'Ensures that the result of changing the option to 'Hexadecimal is seen on the display Display() End Sub Sub Instruction_Click(sender As Object, e As EventArgs) Handles Instruction.CheckedChanged 'Ensures that the result of changing the option to 'Instruction is seen on the display Display() End Sub Sub InA_Click(sender As Object, e As EventArgs) Handles InA.Click 'The A button near the Text Box converts the text according 'to the option chosen then places it in DLA, the DL being 'displayed. The minor cycle used is MC, which is 'incremented for the next input and the new MC is shown 'in its text box MCV If Instruction.Checked Then ConvertI() If Hexadecimal.Checked Then ConvertH() If Dec.Checked Then ConvertD() MC = Val(MCV.Text) Mod 32 MCV.Text = Str$(MC) MemL(32 * DLA + MC) = ConvertedL MemH(32 * DLA + MC) = ConvertedH Display() MC = (MC + 1) Mod 32 MCV.Text = Str$(MC) End Sub Sub InB_Click(sender As Object, e As EventArgs) Handles InB.Click 'The B button near the Text Box converts the text according 'to the option chosen then places it in DLB, the DL being 'displayed. The minor cycle used is MC, which is 'incremented for the next input and the new MC is shown 'in its text box MCV If Instruction.Checked Then ConvertI() If Hexadecimal.Checked Then ConvertH() If Dec.Checked Then ConvertD() MC = Val(MCV.Text) Mod 32 MCV.Text = Str$(MC) MemL(32 * DLB + MC) = ConvertedL MemH(32 * DLB + MC) = ConvertedH Display() MC = (MC + 1) Mod 32 MCV.Text = Str$(MC) End Sub Sub InputText_Click(sender As Object, e As EventArgs) Handles InputText.Click 'The top text box contents are converted according to the 'option chosen and placed in the input register (1). If Instruction.Checked Then ConvertI() If Hexadecimal.Checked Then ConvertH() If Dec.Checked Then ConvertD() MemH(1) = ConvertedH MemL(1) = ConvertedL Display() End Sub Sub InstrText_Click(sender As Object, e As EventArgs) Handles InstrText.Click 'The top text box contents are converted as an instruction 'and placed in the instruction register (1). ConvertI() MemH(0) = ConvertedH MemL(0) = ConvertedL Display() End Sub Sub ConvertI() 'Converts the contents of the top text box as an 'instruction. First spaces are removed. Any difference 'from instruction format makes F=1 which gives a warning. 'The result is in Converted H and Converted L. Dim X As Integer, text As String, Symb As String, F As Short Dim Textt As String F = 0 text = "" Textt = InText.Text For I = 1 To Len(Textt) Symb = Mid$(Textt, I, 1) If Symb <> " " Then text = text + Symb If Asc(Symb) > 58 Then F = 1 Next I X = 0 Symb = Mid$(text, 1, 1) X = X + 2 * Val(Symb) If X > 15 Then F = 1 Symb = Mid$(text, 2, 2) X = X + 16 * Val(Symb) If X > 511 Then F = 1 Symb = Mid$(text, 4, 2) X = X + 512 * Val(Symb) If X > 16383 Then F = 1 Symb = Mid$(text, 6, 1) If Symb = "2" Then F = 1 X = X + 16384 * Val(Symb) If X > 65535 Then F = 1 ConvertedL = X X = 0 Symb = Mid$(text, 7, 2) X = X + Val(Symb) If X > 31 Then F = 1 Symb = Mid$(text, 9, 2) X = X + 256 * Val(Symb) If X > 8191 Then F = 1 Symb = Mid$(text, 11, 1) X = X + 32768 * Val(Symb) If X > 65535 Then F = 1 ConvertedH = X If F = 1 Then Beep() : ConvertedL = 0 : ConvertedH = 0 : MsgBox("Not in Instruction Format") End Sub Sub ConvertH() 'Converts the contents of the top text box as Hexadecimal 'number. First spaces are removed. The result is 'in Converted H and Converted L. Dim I As Short, X As Integer Dim text As String, Symb As String, Textt As String text = "" Textt = InText.Text For I = 1 To Len(Textt) If Mid$(Textt, I, 1) <> " " Then text = text + Mid$(Textt, I, 1) Next I X = 0 For I = 0 To 3 Symb = Mid$(text, 1 + I, 1) X = X + 2 ^ (4 * (3 - I)) * Val("&H" + Symb) Next I ConvertedH = X X = 0 For I = 4 To 7 Symb = Mid$(text, 1 + I, 1) X = X + 2 ^ (4 * (7 - I)) * Val("&H" + Symb) Next I ConvertedL = X End Sub Sub Display() 'Prints all the words of the AcePM memory on the form. 'M is the line number. A line begins with the two displays 'of the chosen DLs. Then some lines have TS and DS 'displays. Instruction (0), Input (1) and Output (28) 'are also shown. Sub PrintWord does the actual printing 'of the contents. Output.Text = "" Dim Line As String If TCA = 0 Then TCAText.Text = "Off" Else TCAText.Text = "On" If TCB = 0 Then TCBText.Text = "Off" Else TCBText.Text = "On" mcText.Text = Str$(ST) TotalText.Text = Str$(TT - StartMC) Print: Line += ("DELAY LINE") Line += (Format$(DLA, " 00")) Line += (" DELAY LINE") Line += (Format$(DLB, " 00")) Line += (" INSTRUCTION (0)") Output.Text += Line + Environment.NewLine Line = "" For M = 0 To 31 Line += (" ") PrintWord(32 * DLA + M) Line += TempText Line += Microsoft.VisualBasic.Strings.StrDup((23 - Line.Length), " ") Line += (Format$(M, " 00")) Line += Microsoft.VisualBasic.Strings.StrDup((29 - Line.Length), " ") PrintWord(32 * DLB + M) Line += TempText Line += Microsoft.VisualBasic.Strings.StrDup((48 - Line.Length), " ") If M = 0 Then Line += (" " + Inststring(0)) If M = 2 Then Line += (" INPUT (1)") If M = 4 Then Line += (" ") Line += (Format$(0, " ")) PrintWord(1) Line += TempText End If If M = 6 Then Line += (" DS") If M = 8 Then Line += (Format$(12, " 00 ")) PrintWord(384) Line += TempText End If If M = 9 Then Line += (Format$(12, " 00 ")) PrintWord(385) Line += TempText End If If M = 12 Then Line += (Format$(14, " 00 ")) PrintWord(386) Line += TempText End If If M = 13 Then Line += (Format$(14, " 00 ")) PrintWord(387) Line += TempText End If If M = 15 Then Line += (" TS") End If If M = 17 Then Line += (Format$(15, " 00 ")) PrintWord(388) Line += TempText End If If M = 19 Then Line += (Format$(16, " 00 ")) PrintWord(389) Line += TempText End If If M = 21 Then Line += (Format$(20, " 00 ")) PrintWord(390) Line += TempText End If If M = 23 Then Line += (Format$(26, " 00 ")) PrintWord(391) Line += TempText End If If M = 25 Then Line += (Format$(27, " 00 ")) PrintWord(392) Line += TempText End If If M = 27 Then Line += (" OUTPUT") End If If M = 29 Then Line += (Format$(28, " 00 ")) PrintWord(28) Line += TempText End If Output.Text += Line + Environment.NewLine Line = "" Next M End Sub Sub Intext_KeyPress(KeyAscii As Integer) 'Allows acceptable character to enter the top text box 'which is Intext. Converts Hex Letters to capitals. Dim X As Integer X = KeyAscii If X > 96 And X < 123 Then X = X - 32 If (X < 47 And X <> 32) Or (X > 57 And X < 65) Or X > 72 Then X = 0 If Not Hexadecimal.Checked And X > 57 Then X = 0 KeyAscii = X End Sub Sub Up_Click(sender As Object, e As EventArgs) Handles Up.Click 'Increments MC, the minor cycle number for the DLs displayed MC = Val(MCV.Text) MC = (MC + 31) Mod 32 MCV.Text = Str$(MC) End Sub Sub Down_Click(sender As Object, e As EventArgs) Handles Down.Click 'Decrements MC, the minor cycle number for the DLs displayed MC = Val(MCV.Text) MC = (MC + 1) Mod 32 MCV.Text = Str$(MC) End Sub Sub Zero_Click(sender As Object, e As EventArgs) Handles Button6.Click 'Zeroises MC, the minor cycle number for the DLs displayed MC = 0 MCV.Text = Str$(MC) End Sub Sub TS_Click(sender As Object, e As EventArgs) Handles TS.Click 'The TS button loads the contents of the top text box into 'the TS or DS chosen on the minor cycle text box. X is the 'memory position of the TS or DS. For a DS, the even minor 'cycle is loaded and the even contents moved to the odd. Dim X As Short MC = Val(MCV.Text) Mod 32 MCV.Text = Str$(MC) X = 0 If MC = 12 Then X = 384 : MemL(385) = MemL(384) : MemH(385) = MemH(384) If MC = 14 Then X = 386 : MemL(387) = MemL(386) : MemH(387) = MemH(386) If MC = 15 Then X = 388 If MC = 16 Then X = 389 If MC = 20 Then X = 390 If MC = 26 Then X = 391 If MC = 27 Then X = 392 If MC = 28 Then X = 28 If X = 0 Then Beep: MsgBox("Not a TS, DS or Output Destination") Else If Instruction.Checked Then ConvertI() If Hexadecimal.Checked Then ConvertH() If Dec.Checked Then ConvertD() MemL(X) = ConvertedL MemH(X) = ConvertedH Display() End If End Sub Sub Decimal_Click(sender As Object, e As EventArgs) Handles Dec.CheckedChanged 'Ensures that the result of changing the option to Decimal 'is seen on the display Display() End Sub Sub PrintWord(X) 'Prints a word on the form in the chosen format If Instruction.Checked Then TempText = (Inststring(X)) End If If Hexadecimal.Checked Then TempText = (Hexstring(X)) End If If Dec.Checked Then TempText = (Decstring(X)) End If End Sub Sub ConvertD() 'Converts the contents of the top text box as Decimal 'number. Spaces are removed. The result is 'in Converted H and Converted L. Dim text As String, Symb As String text = InText.Text H = 0 : L = 0 For I = 1 To Len(text) Symb = Mid$(text, I, 1) If Asc(Symb) > 58 Then Beep() : MsgBox("Not a decimal number") If Symb <> " " Then L = L * 10 + Val(Symb) Carry = L And 983040 L = L And 65535 H = H * 10 + Carry / 65536 End If Next I ConvertedH = H And 65535 ConvertedL = L And 65535 If (H And 983040) > 0 Then Beep() MsgBox("Too large an number") ConvertedH = 0 ConvertedL = 0 End If End Sub Sub TimesTen() 'Used for decimal conversion. The 32 bit number in 16 bit 'pieces in H and L is multiplied by 10. Dim X As Integer L = L * 10 X = (L And 983040) \ 65536 L = (L And 65535) + 2 ^ 24 H = H * 10 + X H = H - 9 * 2 ^ 24 End Sub Sub MinusK() 'Used for decimal conversion. The 32 bit number in 16 bit 'pieces in H and L has 10^10 subtracted from it. Neg records 'if the result is negative. L = L - 58368 If (L And 65536) > 0 Then H = H - 1 : L = L + 65536 H = H - 152587 If (H And 2 ^ 23) > 0 Then Neg = 1 Else Neg = 0 End Sub Sub PlusK() 'Used for decimal conversion. The 32 bit number in 16 bit 'pieces in H and L has 10^10 added to it. L = L + 58368 If (L And 65536) > 0 Then H = H + 1 : L = L - 65536 H = H + 152587 End Sub Sub GenK() 'Used in development to find the value of 10^10 as two '16 bit numbers. L = 1 + 2 ^ 24 H = 2 ^ 24 For I = 0 To 9 TimesTen() Next I L = L - 2 ^ 24 H = H - 2 ^ 24 End Sub Sub Mult() 'Multiplication of TS20 by the odd minor cycle of DS14. 'TS20 is broken into 4 bytes in A1, A2, A3 and A4. 'DS14 odd is in 16 bit pieces in B1 and B2. 'From these pieces, eight multiplications are done, with 'results of length 24 bits, which are broken into 8 'and 16 bit pieces for accumulation in the result, which 'is 16 bit pieces in REH, REL for the least significant '32 bits and ROH, ROL for the most significant. 'Carries between the 16 bit pieces are not performed until 'all the 8 multiplications are complete. Note that 983040 'is 15*2^16 to collect the carries. If (MemL(386) Or MemH(386)) > 0 Then Beep() : MsgBox("TS14 even must be zero for multiplication") If TCA = 1 Then Beep() : MsgBox("TCA must be off for multiplication") If TCB = 1 Then Beep() : MsgBox("TCB must be off for multiplication") A1 = MemH(390) \ 256 : A2 = MemH(390) And 255 A3 = MemL(390) \ 256 : A4 = MemL(390) And 255 B1 = MemH(387) : B2 = MemL(387) REL = 0 : REH = 0 : ROL = 0 : ROH = 0 Prod = A4 * B2 REL = REL + (Prod And 65535) REH = REH + (Prod \ 65536) Prod = A3 * B2 REL = REL + (Prod And 255) * 256 REH = REH + (Prod \ 256) Prod = (A2 * B2) + (A4 * B1) REH = REH + (Prod And 65535) ROL = ROL + (Prod \ 65536) Prod = (A1 * B2) + (A3 * B1) REH = REH + (Prod And 255) * 256 ROL = ROL + (Prod \ 256) Prod = A2 * B1 ROL = ROL + (Prod And 65535) ROH = ROH + (Prod \ 65536) Prod = A1 * B1 ROL = ROL + (Prod And 255) * 256 ROH = ROH + (Prod \ 256) REH = REH + (REL And 983040) \ 65536 REL = REL And 65535 ROL = ROL + (REH And 983040) \ 65536 REH = REH And 65535 ROH = ROH + (ROL And 983040) \ 65536 ROL = ROL And 65535 MemH(387) = ROH MemL(387) = ROL MemH(386) = REH MemL(386) = REL End Sub Sub Test20_Click(sender As Object, e As EventArgs) 'Sets up a pattern in DL10 to enable the effect of Source 20 'operations with TCA=1 to be tested. A useful instruction is 'also loaded, Used only for debugging. For I = 0 To 31 MemH(320 + I) = 0 MemL(320 + I) = I Next I DLA = 10 TCA = 1 InText.Text = "0 20 10" Dec.Checked = True End Sub Sub Run_Click(sender As Object, e As EventArgs) Handles Run.Click Oneshoot() RunIt() End Sub Sub Drum() 'Administers Drum operations. 'DrumWrite and DrumRead do the jobs but DLNo sets the 'DL employed (always DL9 but not when manually operated) 'and Track sets the track number. The unit bit of C decides 'read or write. The bit "S and 16" decides head shift or 'select track and go ahead. DLNo = 9 If (C And 1) > 0 Then If (S And 16) > 0 Then ShiftW = S And 7 TrackW = HeadW + 16 * ShiftW Else HeadW = S And 15 Track = HeadW + 16 * ShiftW DrumWrite() End If End If If (C And 1) = 0 Then If (S And 16) > 0 Then ShiftR = S And 7 TrackR = HeadR + 16 * ShiftR Else HeadR = S And 15 Track = HeadR + 16 * ShiftR DrumRead() End If End If End Sub Sub DrumRead() 'The files have been opened by the Form_Load routine. Drum 'tracks are on #1 and cards on #2. The Seek 'locates the start of the Track data, which is read in blocks 'of four bytes into DLNo. If Track < 128 Then Microsoft.VisualBasic.FileSystem.Seek(1, 1 + Track * 256) For I = 0 To 31 Microsoft.VisualBasic.FileSystem.FileGet(1, MemH(32 * DLNo + I)) Microsoft.VisualBasic.FileSystem.FileGet(1, MemL(32 * DLNo + I)) Next I ElseIf Track < 256 Then Microsoft.VisualBasic.FileSystem.Seek(2, 1 + (Track - 128) * 256) For I = 0 To 31 Microsoft.VisualBasic.FileSystem.FileGet(2, MemH(32 * DLNo + I)) Microsoft.VisualBasic.FileSystem.FileGet(2, MemL(32 * DLNo + I)) Next I Else Microsoft.VisualBasic.FileSystem.Seek(3, 1 + (Track - 256) * 256) For I = 0 To 31 Microsoft.VisualBasic.FileSystem.FileGet(3, MemH(32 * DLNo + I)) Microsoft.VisualBasic.FileSystem.FileGet(3, MemL(32 * DLNo + I)) Next I End If End Sub Sub DrumWrite() 'The file has been opened by the Form_Load routine. The Seek 'locates the start of the Track data, which is written in 'blocks of four bytes from DLNo. If Track < 128 Then Microsoft.VisualBasic.FileSystem.Seek(1, 1 + Track * 256) For I = 0 To 31 Microsoft.VisualBasic.FileSystem.FilePut(1, MemH(32 * DLNo + I)) Microsoft.VisualBasic.FileSystem.FilePut(1, MemL(32 * DLNo + I)) Next I ElseIf Track < 256 Then Microsoft.VisualBasic.FileSystem.Seek(2, 1 + (Track - 128) * 256) For I = 0 To 31 Microsoft.VisualBasic.FileSystem.FilePut(2, MemH(32 * DLNo + I)) Microsoft.VisualBasic.FileSystem.FilePut(2, MemL(32 * DLNo + I)) Next I Else Microsoft.VisualBasic.FileSystem.Seek(3, 1 + (Track - 256) * 256) For I = 0 To 31 Microsoft.VisualBasic.FileSystem.FilePut(3, MemH(32 * DLNo + I)) Microsoft.VisualBasic.FileSystem.FilePut(3, MemL(32 * DLNo + I)) Next I End If End Sub Sub Reader_Click(sender As Object, e As EventArgs) Handles Reader.Click 'The Drum Read button checks the given track number and DL 'number, performs the read and displays so the result 'can be seen. Track = Val(Trackk.Text) If Track > 383 Then MsgBox("Drum track number must be less than 128 or Card number from 128 to 383") Else DLNo = Val(DL.Text) If DLNo > 11 Or DLNo = 0 Then MsgBox("DL must be between 1 and 11") Else DrumRead() Display() End If End If End Sub Sub Writer_Click(sender As Object, e As EventArgs) Handles Writer.Click 'The Drum Write button checks the given track number and DL 'number and performs the write. Track = Val(Trackk.Text) If Track > 383 Then MsgBox("Track number must be less than 128 or Card number from 128 to 383") Else DLNo = Val(DL.Text) If DLNo > 11 Or DLNo = 0 Then MsgBox("DL must be between 1 and 11") Else DrumWrite() End If End If End Sub Sub Enter_Click(sender As Object, e As EventArgs) Handles Enter.Click 'Prepares to enter the program in DLA at minor cycle MC by 'loading the instruction there and resetting the minor cycle 'counters IMC = Val(EnterAt.Text) Mod 32 MemH(0) = MemH(32 * DLA + IMC) MemL(0) = MemL(32 * DLA + IMC) TT = IMC ST = IMC StartMC = IMC Display() End Sub Function Hexstring(X) As String 'Produces a string in Hex notation representing 'the word held in the ACE memory location X. Dim Result As String Result = " " H = MemH(X) L = MemL(X) Result = Result + Hex$((H And 61440) \ 4096) Result = Result + Hex$((H And 3840) \ 256) Result = Result + Hex$((H And 240) \ 16) Result = Result + Hex$(H And 15) Result = Result + " " Result = Result + Hex$((L And 61440) \ 4096) Result = Result + Hex$((L And 3840) \ 256) Result = Result + Hex$((L And 240) \ 16) Result = Result + Hex$(L And 15) Hexstring = Result End Function Function Inststring(X) As String 'Forms a string in Instruction notation representing 'the word held in the ACE memory location X. Dim Result As String Dim Y As Integer Result = "" L = MemL(X) H = MemH(X) Y = (L And 14) \ 2 Result = Result + Format$(Y, " 0") Y = (L And 496) \ 16 Result = Result + Format$(Y, " 00") Y = (L And 15872) \ 512 Result = Result + Format$(Y, " 00") Y = (L And 49152) \ 16384 Result = Result + Format$(Y, " 0") Y = H And 31 Result = Result + Format$(Y, " 00") Y = (H And 7936) \ 256 Result = Result + Format$(Y, " 00") Y = (H And 32768) \ 32768 Result = Result + Format$(Y, " 0") Inststring = Result End Function Function Decstring(X) As String 'Forms a string in decimal notation representing 'the word held in the ACE memory location X 'of the parameter. Uses subroutine TimesTen to multiply 'the contents ofa 32 bit register (H and L) by 10. 'The PlusK subroutine adds 10^10 to the register and 'Subroutine MinusK subtracts this same constant, with 'a returned 'Neg' if the result is negative. Both H and L 'hold 16 bit parts of the register with 2^24 as a one bit 'to stop negative numbers causing an overflow. Dim Result As String Dim Decc As Integer Result = " " H = 2 ^ 24 + MemH(X) L = 2 ^ 24 + MemL(X) For J = 0 To 9 Decc = 0 TimesTen() Do MinusK() Decc = Decc + 1 Loop Until Neg = 1 PlusK() Decc = Decc - 1 Result = Result + Format$(Decc, "0") If J = 4 Then Result = Result + " " Next J Decstring = Result End Function Sub ReadCard() 'Prepares to read the 12 rows of one card, taken from a card number 'equal to the given track number. When an instruction with 'Go=0 is reached, the words are read into 'memory slot "1" and a one-shot given. The most significant 'half of the 13th row is read and if this is non-zero a 'further card is read. If Track < 128 Or Track > 383 Then MsgBox("Card number must be between 128 and 383") Else CardNumber.Text = Str$(Track) If Track > 255 Then Microsoft.VisualBasic.FileSystem.Seek(3, 1 + (Track - 256) * 256) Else Microsoft.VisualBasic.FileSystem.Seek(2, 1 + (Track - 256) * 256) End If Row = 0 CardReading = 1 End If End Sub Sub Card_Click(sender As Object, e As EventArgs) 'Puts 0 00-00 0 00 00 0 into the input register, then reads 'a card from the card or track number in the text box. Track = Val(CardNumber.Text) If Track < 128 Or Track > 255 Then MsgBox("Card number must be between 128 and 255") Else MemH(0) = 0 MemL(0) = 0 TT = 0 ST = 0 Initial = 1 ReadCard() RunIt() End If End Sub Sub RunIt() 'Used by the Run button to start the AcePM running. 'It was intended 'that Running could be made zero to stop it but this proved 'impossible and Control+Break is the only way I have found! RunAgain: While ((MemH(0) And 32768) > 0) Or CardReading > 0 Or CardPunching > 0 If (MemH(0) And 32768) = 0 Then Display() Oneshoot() Display() End While End Sub Sub PunchCard() 'Prepares to punch the 12 rows of one card, taken from a card number 'equal to the given track number. When an instruction with 'Go=0 is reached, the words are written 'from memory slot "28" and a one-shot given. Punching cards 'in the range 128 to 255 requires "PunchAnyCard" to be 1. If (PunchAnyCard = 1 And Track < 256) Then If Track < 128 Then MsgBox("Card number must be greater than 127") Else MsgBox("CAUTION - You are punching in the 'Read Only' region") PunchNumber.Text = Str$(Track) Microsoft.VisualBasic.FileSystem.Seek(2, 1 + (Track - 128) * 256) Row = 0 CardPunching = 1 End If Else If Track < 256 Or Track > 383 Then MsgBox("Card number for punching must be between 256 and 383") Else PunchNumber.Text = Str$(Track) Microsoft.VisualBasic.FileSystem.Seek(3, 1 + (Track - 256) * 256) Row = 0 CardPunching = 1 End If End If End Sub Sub InitCards_Click(sender As Object, e As EventArgs) 'Puts 0 00-00 0 00 00 0 into the input register, then reads 'a card from the card or track number in the text box. Track = Val(CardNumber.Text) If Track < 128 Or Track > 383 Then MsgBox("Card number must be between 128 and 383") Else MemH(0) = 0 MemL(0) = 0 TT = 0 ST = 0 Initial = 1 ReadCard() RunIt() End If End Sub End Class