1259 lines
41 KiB
VB.net
1259 lines
41 KiB
VB.net
|
|
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
|