commit e3a889bc9a2088cbbdecea182bfe7f5396268e06 Author: Curle Date: Sun Jan 28 23:04:59 2024 +0000 First attempt at recreating ACEPM diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3e16852 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +bin/ +obj/ +.vs/ \ No newline at end of file diff --git a/ACEdotnet.sln b/ACEdotnet.sln new file mode 100644 index 0000000..cc81c63 --- /dev/null +++ b/ACEdotnet.sln @@ -0,0 +1,25 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 17 +VisualStudioVersion = 17.8.34330.188 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "ACEdotnet", "ACEdotnet.vbproj", "{331BB0DD-FEC8-48C2-8ADD-CB05DC318FF8}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {331BB0DD-FEC8-48C2-8ADD-CB05DC318FF8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {331BB0DD-FEC8-48C2-8ADD-CB05DC318FF8}.Debug|Any CPU.Build.0 = Debug|Any CPU + {331BB0DD-FEC8-48C2-8ADD-CB05DC318FF8}.Release|Any CPU.ActiveCfg = Release|Any CPU + {331BB0DD-FEC8-48C2-8ADD-CB05DC318FF8}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {28C11CDB-B928-444D-AA9D-B57D1DCAF9E4} + EndGlobalSection +EndGlobal diff --git a/ACEdotnet.vbproj b/ACEdotnet.vbproj new file mode 100644 index 0000000..256812c --- /dev/null +++ b/ACEdotnet.vbproj @@ -0,0 +1,33 @@ + + + + WinExe + net8.0-windows + ACEdotnet.My.MyApplication + true + WindowsForms + Acedotnet + + + + + + + + + + + True + True + Application.myapp + + + + + + MyApplicationCodeGenerator + Application.Designer.vb + + + + \ No newline at end of file diff --git a/ACEdotnet.vbproj.user b/ACEdotnet.vbproj.user new file mode 100644 index 0000000..e903933 --- /dev/null +++ b/ACEdotnet.vbproj.user @@ -0,0 +1,8 @@ + + + + + Form + + + \ No newline at end of file diff --git a/Acedotnet/Application.Designer.vb b/Acedotnet/Application.Designer.vb new file mode 100644 index 0000000..425289e --- /dev/null +++ b/Acedotnet/Application.Designer.vb @@ -0,0 +1,45 @@ +'------------------------------------------------------------------------------ +' +' This code was generated by a tool. +' Runtime Version:4.0.30319.42000 +' +' Changes to this file may cause incorrect behavior and will be lost if +' the code is regenerated. +' +'------------------------------------------------------------------------------ + +Option Strict On +Option Explicit On + + +Namespace My + + 'NOTE: This file is auto-generated; do not modify it directly. To make changes, + ' or if you encounter build errors in this file, go to the Project Designer + ' (go to Project Properties or double-click the My Project node in + ' Solution Explorer), and make changes on the Application tab. + ' + Partial Friend Class MyApplication + + _ + Public Sub New() + MyBase.New(Global.Microsoft.VisualBasic.ApplicationServices.AuthenticationMode.Windows) + Me.IsSingleInstance = false + Me.EnableVisualStyles = true + Me.SaveMySettingsOnExit = true + Me.ShutDownStyle = Global.Microsoft.VisualBasic.ApplicationServices.ShutdownMode.AfterMainFormCloses + Me.HighDpiMode = HighDpiMode.DpiUnaware + End Sub + + _ + Protected Overrides Sub OnCreateMainForm() + Me.MainForm = Global.ACEdotnet.Acepm + End Sub + + _ + Protected Overrides Function OnInitialize(ByVal commandLineArgs As System.Collections.ObjectModel.ReadOnlyCollection(Of String)) As Boolean + Me.MinimumSplashScreenDisplayTime = 0 + Return MyBase.OnInitialize(commandLineArgs) + End Function + End Class +End Namespace diff --git a/Acedotnet/Application.myapp b/Acedotnet/Application.myapp new file mode 100644 index 0000000..4d58c7e --- /dev/null +++ b/Acedotnet/Application.myapp @@ -0,0 +1,10 @@ + + + true + Acepm + false + 0 + true + 0 + true + \ No newline at end of file diff --git a/Acepm.Designer.vb b/Acepm.Designer.vb new file mode 100644 index 0000000..5219bb6 --- /dev/null +++ b/Acepm.Designer.vb @@ -0,0 +1,477 @@ + +Partial Class Acepm + Inherits System.Windows.Forms.Form + + + 'Form overrides dispose to clean up the component list. + + Protected Overrides Sub Dispose(ByVal disposing As Boolean) + Try + If disposing AndAlso components IsNot Nothing Then + components.Dispose() + End If + Finally + MyBase.Dispose(disposing) + End Try + End Sub + + 'Required by the Windows Form Designer + Private components As System.ComponentModel.IContainer + + 'NOTE: The following procedure is required by the Windows Form Designer + 'It can be modified using the Windows Form Designer. + 'Do not modify it using the code editor. + + Private Sub InitializeComponent() + DLAP = New Button() + DLBP = New Button() + InA = New Button() + InText = New TextBox() + InB = New Button() + TS = New Button() + InputText = New Button() + InstrText = New Button() + Up = New Button() + Down = New Button() + Button6 = New Button() + Writer = New Button() + Reader = New Button() + Enter = New Button() + Run = New Button() + Oneshot = New Button() + InitCards = New Button() + Exitt = New Button() + Button14 = New Button() + Frame1 = New GroupBox() + Instruction = New CheckBox() + Hexadecimal = New CheckBox() + Dec = New CheckBox() + MCV = New TextBox() + Label1 = New Label() + TCAText = New TextBox() + TCBText = New TextBox() + mcText = New TextBox() + TotalText = New TextBox() + OutText = New TextBox() + Label2 = New Label() + Label3 = New Label() + Trackk = New TextBox() + DL = New TextBox() + EnterAt = New TextBox() + Label4 = New Label() + CardNumber = New TextBox() + PunchNumber = New TextBox() + Frame1.SuspendLayout() + SuspendLayout() + ' + ' DLAP + ' + DLAP.Location = New Point(25, 25) + DLAP.Name = "DLAP" + DLAP.Size = New Size(25, 25) + DLAP.TabIndex = 0 + DLAP.Text = "A" + DLAP.UseVisualStyleBackColor = True + ' + ' DLBP + ' + DLBP.Location = New Point(225, 25) + DLBP.Name = "DLBP" + DLBP.Size = New Size(25, 25) + DLBP.TabIndex = 1 + DLBP.Text = "B" + DLBP.UseVisualStyleBackColor = True + ' + ' InA + ' + InA.Location = New Point(625, 25) + InA.Name = "InA" + InA.Size = New Size(25, 25) + InA.TabIndex = 2 + InA.Text = "A" + InA.UseVisualStyleBackColor = True + ' + ' InText + ' + InText.Location = New Point(656, 25) + InText.Name = "InText" + InText.Size = New Size(200, 23) + InText.TabIndex = 3 + ' + ' InB + ' + InB.Location = New Point(625, 50) + InB.Name = "InB" + InB.Size = New Size(25, 25) + InB.TabIndex = 4 + InB.Text = "B" + InB.UseVisualStyleBackColor = True + ' + ' TS + ' + TS.Location = New Point(656, 50) + TS.Name = "TS" + TS.Size = New Size(55, 25) + TS.TabIndex = 5 + TS.Text = "TS" + TS.UseVisualStyleBackColor = True + ' + ' InputText + ' + InputText.Location = New Point(717, 50) + InputText.Name = "InputText" + InputText.Size = New Size(55, 25) + InputText.TabIndex = 6 + InputText.Text = "Input" + InputText.UseVisualStyleBackColor = True + ' + ' InstrText + ' + InstrText.Location = New Point(778, 50) + InstrText.Name = "InstrText" + InstrText.Size = New Size(55, 25) + InstrText.TabIndex = 7 + InstrText.Text = "Instr." + InstrText.UseVisualStyleBackColor = True + ' + ' Up + ' + Up.Location = New Point(656, 137) + Up.Name = "Up" + Up.Size = New Size(50, 25) + Up.TabIndex = 8 + Up.Text = "Up" + Up.UseVisualStyleBackColor = True + ' + ' Down + ' + Down.Location = New Point(712, 137) + Down.Name = "Down" + Down.Size = New Size(50, 25) + Down.TabIndex = 9 + Down.Text = "Down" + Down.UseVisualStyleBackColor = True + ' + ' Button6 + ' + Button6.Location = New Point(768, 137) + Button6.Name = "Button6" + Button6.Size = New Size(50, 25) + Button6.TabIndex = 10 + Button6.Text = "Zero" + Button6.UseVisualStyleBackColor = True + ' + ' Writer + ' + Writer.Location = New Point(625, 300) + Writer.Name = "Writer" + Writer.Size = New Size(50, 25) + Writer.TabIndex = 11 + Writer.Text = "Write" + Writer.UseVisualStyleBackColor = True + ' + ' Reader + ' + Reader.Location = New Point(681, 300) + Reader.Name = "Reader" + Reader.Size = New Size(50, 25) + Reader.TabIndex = 12 + Reader.Text = "Read" + Reader.UseVisualStyleBackColor = True + ' + ' Enter + ' + Enter.Location = New Point(625, 350) + Enter.Name = "Enter" + Enter.Size = New Size(50, 25) + Enter.TabIndex = 13 + Enter.Text = "Enter" + Enter.UseVisualStyleBackColor = True + ' + ' Run + ' + Run.Location = New Point(710, 350) + Run.Name = "Run" + Run.Size = New Size(50, 25) + Run.TabIndex = 14 + Run.Text = "Run" + Run.UseVisualStyleBackColor = True + ' + ' Oneshot + ' + Oneshot.Location = New Point(765, 350) + Oneshot.Name = "Oneshot" + Oneshot.Size = New Size(50, 25) + Oneshot.TabIndex = 15 + Oneshot.Text = "1-Shot" + Oneshot.UseVisualStyleBackColor = True + ' + ' InitCards + ' + InitCards.Location = New Point(625, 400) + InitCards.Name = "InitCards" + InitCards.Size = New Size(100, 25) + InitCards.TabIndex = 16 + InitCards.Text = "Init. Cards" + InitCards.UseVisualStyleBackColor = True + ' + ' Exitt + ' + Exitt.Location = New Point(625, 450) + Exitt.Name = "Exitt" + Exitt.Size = New Size(50, 25) + Exitt.TabIndex = 17 + Exitt.Text = "EXIT" + Exitt.UseVisualStyleBackColor = True + ' + ' Button14 + ' + Button14.Location = New Point(700, 450) + Button14.Name = "Button14" + Button14.Size = New Size(50, 25) + Button14.TabIndex = 18 + Button14.Text = "Punch Card" + Button14.UseVisualStyleBackColor = True + ' + ' Frame1 + ' + Frame1.Controls.Add(Instruction) + Frame1.Controls.Add(Hexadecimal) + Frame1.Controls.Add(Dec) + Frame1.Location = New Point(625, 81) + Frame1.Name = "Frame1" + Frame1.Size = New Size(250, 50) + Frame1.TabIndex = 19 + Frame1.TabStop = False + Frame1.Text = "Word Format" + ' + ' Instruction + ' + Instruction.AutoSize = True + Instruction.Location = New Point(179, 22) + Instruction.Name = "Instruction" + Instruction.Size = New Size(49, 19) + Instruction.TabIndex = 22 + Instruction.Text = "Instr" + Instruction.UseVisualStyleBackColor = True + ' + ' Hexadecimal + ' + Hexadecimal.AutoSize = True + Hexadecimal.Location = New Point(21, 22) + Hexadecimal.Name = "Hexadecimal" + Hexadecimal.Size = New Size(47, 19) + Hexadecimal.TabIndex = 20 + Hexadecimal.Text = "Hex" + Hexadecimal.UseVisualStyleBackColor = True + ' + ' Dec + ' + Dec.AutoSize = True + Dec.Location = New Point(106, 22) + Dec.Name = "Dec" + Dec.Size = New Size(46, 19) + Dec.TabIndex = 21 + Dec.Text = "Dec" + Dec.UseVisualStyleBackColor = True + ' + ' MCV + ' + MCV.Location = New Point(625, 137) + MCV.Name = "MCV" + MCV.Size = New Size(25, 23) + MCV.TabIndex = 20 + ' + ' Label1 + ' + Label1.AutoSize = True + Label1.Location = New Point(625, 176) + Label1.Name = "Label1" + Label1.Size = New Size(172, 15) + Label1.TabIndex = 21 + Label1.Text = "TCA TCB m.c. total m.c." + ' + ' TCAText + ' + TCAText.Location = New Point(624, 194) + TCAText.Name = "TCAText" + TCAText.Size = New Size(25, 23) + TCAText.TabIndex = 22 + ' + ' TCBText + ' + TCBText.Location = New Point(655, 194) + TCBText.Name = "TCBText" + TCBText.Size = New Size(25, 23) + TCBText.TabIndex = 23 + ' + ' mcText + ' + mcText.Location = New Point(686, 194) + mcText.Name = "mcText" + mcText.Size = New Size(25, 23) + mcText.TabIndex = 23 + ' + ' TotalText + ' + TotalText.Location = New Point(717, 194) + TotalText.Name = "TotalText" + TotalText.Size = New Size(100, 23) + TotalText.TabIndex = 23 + ' + ' OutText + ' + OutText.Location = New Point(686, 237) + OutText.Name = "OutText" + OutText.Size = New Size(100, 23) + OutText.TabIndex = 23 + ' + ' Label2 + ' + Label2.AutoSize = True + Label2.Location = New Point(625, 239) + Label2.Name = "Label2" + Label2.Size = New Size(45, 15) + Label2.TabIndex = 21 + Label2.Text = "Output" + ' + ' Label3 + ' + Label3.AutoSize = True + Label3.Location = New Point(636, 272) + Label3.Name = "Label3" + Label3.Size = New Size(154, 15) + Label3.TabIndex = 21 + Label3.Text = "DRUM / CARDS Track DL" + ' + ' Trackk + ' + Trackk.Location = New Point(737, 300) + Trackk.Name = "Trackk" + Trackk.Size = New Size(25, 23) + Trackk.TabIndex = 22 + ' + ' DL + ' + DL.Location = New Point(768, 300) + DL.Name = "DL" + DL.Size = New Size(25, 23) + DL.TabIndex = 22 + ' + ' EnterAt + ' + EnterAt.Location = New Point(680, 350) + EnterAt.Name = "EnterAt" + EnterAt.Size = New Size(25, 23) + EnterAt.TabIndex = 22 + ' + ' Label4 + ' + Label4.Location = New Point(731, 400) + Label4.Name = "Label4" + Label4.Size = New Size(61, 20) + Label4.TabIndex = 24 + Label4.Text = "Read Card" + ' + ' CardNumber + ' + CardNumber.Location = New Point(798, 400) + CardNumber.Name = "CardNumber" + CardNumber.Size = New Size(25, 23) + CardNumber.TabIndex = 22 + ' + ' PunchNumber + ' + PunchNumber.Location = New Point(761, 452) + PunchNumber.Name = "PunchNumber" + PunchNumber.Size = New Size(25, 23) + PunchNumber.TabIndex = 22 + ' + ' Acepm + ' + AutoScaleDimensions = New SizeF(7.0F, 15.0F) + AutoScaleMode = AutoScaleMode.Font + ClientSize = New Size(866, 492) + Controls.Add(Label4) + Controls.Add(OutText) + Controls.Add(TotalText) + Controls.Add(mcText) + Controls.Add(TCBText) + Controls.Add(DL) + Controls.Add(PunchNumber) + Controls.Add(CardNumber) + Controls.Add(EnterAt) + Controls.Add(Trackk) + Controls.Add(TCAText) + Controls.Add(Label2) + Controls.Add(Label3) + Controls.Add(Label1) + Controls.Add(MCV) + Controls.Add(Frame1) + Controls.Add(Button14) + Controls.Add(Exitt) + Controls.Add(InitCards) + Controls.Add(Oneshot) + Controls.Add(Run) + Controls.Add(Enter) + Controls.Add(Reader) + Controls.Add(Writer) + Controls.Add(Button6) + Controls.Add(Down) + Controls.Add(Up) + Controls.Add(InstrText) + Controls.Add(InputText) + Controls.Add(TS) + Controls.Add(InB) + Controls.Add(InText) + Controls.Add(InA) + Controls.Add(DLBP) + Controls.Add(DLAP) + Name = "Acepm" + Text = "Acepm" + Frame1.ResumeLayout(False) + Frame1.PerformLayout() + ResumeLayout(False) + PerformLayout() + End Sub + + Friend WithEvents DLAP As Button + Friend WithEvents DLBP As Button + Friend WithEvents InA As Button + Friend WithEvents InText As TextBox + Friend WithEvents InB As Button + Friend WithEvents TS As Button + Friend WithEvents InputText As Button + Friend WithEvents InstrText As Button + Friend WithEvents Up As Button + Friend WithEvents Down As Button + Friend WithEvents Button6 As Button + Friend WithEvents Writer As Button + Friend WithEvents Reader As Button + Friend WithEvents Enter As Button + Friend WithEvents Run As Button + Friend WithEvents Oneshot As Button + Friend WithEvents InitCards As Button + Friend WithEvents Exitt As Button + Friend WithEvents Button14 As Button + Friend WithEvents Frame1 As GroupBox + Friend WithEvents Instruction As CheckBox + Friend WithEvents Hexadecimal As CheckBox + Friend WithEvents Dec As CheckBox + Friend WithEvents MCV As TextBox + Friend WithEvents Label1 As Label + Friend WithEvents TCAText As TextBox + Friend WithEvents TCBText As TextBox + Friend WithEvents mcText As TextBox + Friend WithEvents TotalText As TextBox + Friend WithEvents OutText As TextBox + Friend WithEvents Label2 As Label + Friend WithEvents Label3 As Label + Friend WithEvents Trackk As TextBox + Friend WithEvents DL As TextBox + Friend WithEvents EnterAt As TextBox + Friend WithEvents Label4 As Label + Friend WithEvents CardNumber As TextBox + Friend WithEvents PunchNumber As TextBox + +End Class diff --git a/Acepm.resx b/Acepm.resx new file mode 100644 index 0000000..af32865 --- /dev/null +++ b/Acepm.resx @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + \ No newline at end of file diff --git a/Acepm.vb b/Acepm.vb new file mode 100644 index 0000000..aa996e9 --- /dev/null +++ b/Acepm.vb @@ -0,0 +1,1227 @@ + +Public Class Acepm + + Dim MemH(500) As Long, MemL(500) As Long + Dim N As Integer, S As Integer, D As Integer + Dim C As Integer, W As Integer, T As Integer, M As Long + Dim Go As Integer, TT As Long, ST As Integer, TE As Integer + Dim SWH As Long, SWL As Long + Dim TCA As Integer, TCB As Integer + Dim Disc As Integer, Buzzer As Integer + Dim DLA As Integer, DLB As Integer, MC As Integer + Dim ConvertedH As Long, ConvertedL As Long + Dim Carry As Long, Neg As Integer + Dim H As Long, L As Long + Dim I As Long, Buzz As Integer + Dim TempL As Long, TempH As Long + Dim A1 As Long, A2 As Long, A3 As Long, A4 As Long + Dim B1 As Long, B2 As Long, Prod As Long + Dim ROH As Long, ROL As Long, REH As Long, REL As Long + Dim Res1 As Single, Res2 As Single 'FOR THE MULT TEST + Dim Running As Integer, StartMC As Integer, IMC As Integer + Dim HeadR As Integer, ShiftR As Integer, Track As Integer + Dim HeadW As Integer, ShiftW As Integer, TrackR As Integer, TrackW As Integer + Dim DLNo As Integer + Dim Row As Integer, CardReading As Integer, CardPunching As Integer + Dim PunchAnyCard As Integer, Initial As Integer + Dim NewCard As Integer + + 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 Long + 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) + + '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 = False + + Microsoft.VisualBasic.FileSystem.FileOpen(1, "AceDrum", OpenMode.Binary) + Microsoft.VisualBasic.FileSystem.FileOpen(2, "AceCards", OpenMode.Binary) + Microsoft.VisualBasic.FileSystem.FileOpen(3, "AcePunch", OpenMode.Binary) + 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 Long, text As String, Symb As String, F As Integer + 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 Integer, X As Long + 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. + + 'Form1.Cls + 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: Print(" DELAY LINE") + Print(Format$(DLA, " 00")) + Print(" DELAY LINE") + Print(Format$(DLB, " 00")) + Print(" INSTRUCTION (0)") + Print("") + + For M = 0 To 31 + Print(" ") + PrintWord(32 * DLA + M) + Print(TAB(23).ToString) + Print(Format$(M, " 00")) + Print(TAB(29).ToString) + PrintWord(32 * DLB + M) + Print(TAB(48).ToString) + If M = 0 Then Print(" " + Inststring(0)) + If M = 2 Then Print(" INPUT (1)") + If M = 4 Then + Print(" ") + Print(Format$(0, " ")) + PrintWord(1) + End If + If M = 6 Then Print(" DS") + If M = 8 Then + Print(Format$(12, " 00 ")) + PrintWord(384) + End If + If M = 9 Then + Print(Format$(12, " 00 ")) + PrintWord(385) + End If + If M = 12 Then + Print(Format$(14, " 00 ")) + PrintWord(386) + End If + If M = 13 Then + Print(Format$(14, " 00 ")) + PrintWord(387) + End If + If M = 15 Then + Print(" TS") + End If + If M = 17 Then + Print(Format$(15, " 00 ")) + PrintWord(388) + End If + If M = 19 Then + Print(Format$(16, " 00 ")) + PrintWord(389) + End If + If M = 21 Then + Print(Format$(20, " 00 ")) + PrintWord(390) + End If + If M = 23 Then + Print(Format$(26, " 00 ")) + PrintWord(391) + End If + If M = 25 Then + Print(Format$(27, " 00 ")) + PrintWord(392) + End If + If M = 27 Then + Print(" OUTPUT") + End If + If M = 29 Then + Print(Format$(28, " 00 ")) + PrintWord(28) + End If + Print("") + 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 Integer + 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 + Print(Inststring(X)) + End If + If Hexadecimal.Checked Then + Print(Hexstring(X)) + End If + If Dec.Checked Then + Print(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 diff --git a/ApplicationEvents.vb b/ApplicationEvents.vb new file mode 100644 index 0000000..cf403a0 --- /dev/null +++ b/ApplicationEvents.vb @@ -0,0 +1,29 @@ +Imports Microsoft.VisualBasic.ApplicationServices + +Namespace My + ' The following events are available for MyApplication: + ' Startup: Raised when the application starts, before the startup form is created. + ' Shutdown: Raised after all application forms are closed. This event is not raised if the application terminates abnormally. + ' UnhandledException: Raised if the application encounters an unhandled exception. + ' StartupNextInstance: Raised when launching a single-instance application and the application is already active. + ' NetworkAvailabilityChanged: Raised when the network connection is connected or disconnected. + + ' **NEW** ApplyApplicationDefaults: Raised when the application queries default values to be set for the application. + + ' Example: + ' Private Sub MyApplication_ApplyApplicationDefaults(sender As Object, e As ApplyApplicationDefaultsEventArgs) Handles Me.ApplyApplicationDefaults + ' + ' ' Setting the application-wide default Font: + ' e.Font = New Font(FontFamily.GenericSansSerif, 12, FontStyle.Regular) + ' + ' ' Setting the HighDpiMode for the Application: + ' e.HighDpiMode = HighDpiMode.PerMonitorV2 + ' + ' ' If a splash dialog is used, this sets the minimum display time: + ' e.MinimumSplashScreenDisplayTime = 4000 + ' End Sub + + Partial Friend Class MyApplication + + End Class +End Namespace