pkimpel.retro-220/software/tools/BAC-Xscript-Reformatter.wsf

<?XML version="1.0"?>
<package>
<job id="BAC-Xscript-Reformatter">
<reference object="Scripting.FileSystemObject" /> 'Microsoft Scripting Runtime TypeLib (for fso)
<script language="VBScript">
<![CDATA[

Option Explicit
'-----------------------------------------------------------------------
' retro-220 BAC-Xscript-Reformatter.wsf
' Copyright (c) 2017, Paul Kimpel,
' Licensed under the MIT License, see
'       http://www.opensource.org/licenses/mit-license.php
'-----------------------------------------------------------------------
' VBScript to extract source from the BALGOL assembly listing transcriptions.
' It reads an assembly transcription file and outputs a BAC-Assembler
' card deck.
'
' This script should be executed in the current path of the transcription
' files. Output files will be written to that path as well.
'
' Uses Scripting Runtime FileSystemObject.
' Parameters:
'   1. Name of the transcription file.
'   2. Optional started card sequence string.
'   3. Optional /Q = quiet mode (no MsgBox at end), can be in any position.
'-----------------------------------------------------------------------
' Modification Log.
' 2017-01-06  P.Kimpel
'   Original version, cloned from retro-205/software/tools/
'   Shell-Xscript-Reformatter.wsf.
' 2017-03-05  P.Kimpel
'   Add /Q switch and more flexible parameter ordering; correct EOF problem
'   on last card.
'-----------------------------------------------------------------------

Dim args
Dim deckName
Dim fileName
Dim fso
Dim lastSeq
Dim quietMode

'---------------------------------------
Function PicZn(ByVal s, ByVal chars)
  'Formats the string "s" to be exactly "chars" characters long, padding
  'with spaces or truncating on the left, as necessary.
  Dim sLen

  sLen = Len(s)
  If sLen < chars Then
    PicZn = Space(chars - sLen) & s
  ElseIf sLen > chars Then
    PicZn = Right(s, chars)
  Else
    PicZn = s
  End If
End Function

'---------------------------------------
Function Pic9n(ByVal v, ByVal chars)
  'Formats a numeric value "v" as a string of "chars" length with leading zeroes.
  Dim s
  Dim sz

  s = CStr(v)
  sz = Len(s)
  If sz > chars Then
    Pic9n = Right(s, chars)
  ElseIf sz < chars Then
    Pic9n = String(chars-sz, "0") & s
  Else
    Pic9n = s
  End If
End Function

'---------------------------------------
Function PicXn(ByVal v, ByVal chars)
  'Formats a string value "v" as left justified over spaces in a field "chars" long.
  Dim sz

  sz = Len(CStr(v))
  If sz < chars Then
    PicXn = v & Space(chars-sz)
  ElseIf sz > chars Then
    PicXn = Left(v, chars)
  Else
    PicXn = v
  End If
End Function

'---------------------------------------
Sub WriteCard(cardFile, seq, text)
  'Applies the sequence number to the text and outputs the card image
  Dim image
  Dim seqNr
  Dim seqText

  seqText = PicZn(seq, 8)
  image = PicXn(text, 72)
  If Len(Trim(seqText)) = 0 Then
    seqText = Replace(Replace(lastSeq, " ", ""), ".", "")
    If IsNumeric(seqText) Then
      seqNr = CLng(seqText)
    Else
      seqNr = 999000
    End If

    seqNr = seqNr + 10
    seqText = PicZn("0" & seqNr, 6)
    seqText = Mid(seqText, 1, 3) & " " & Mid(seqText, 4, 2) & " " & Mid(seqText, 6)
  End If

  lastSeq = seqText
  cardFile.WriteLine image & seqText
End Sub

'---------------------------------------
Sub ExtractCode(byVal xScriptName, byVal deckName)
  'Extracts source from an assembler transcription file.
  'The assembler source is written as card images to a file with the same
  'name as the transcription file, but modified with a ".card" extension.
  Dim address
  Dim card
  Dim cardFile
  Dim eof
  Dim label
  Dim lastAddr
  Dim line
  Dim lineNr
  Dim operand
  Dim opCode
  Dim seq
  Dim text
  Dim word
  Dim xFile

  Const addrCol = 14
  Const labelCol = 21
  Const opCodeCol = 27
  Const operandCol = 33
  Const lastCol = 90

  Set cardFile = fso.OpenTextFile(deckName, ForWriting, True, True)
  Set xFile = fso.OpenTextfile(xScriptName, ForReading, False, False)
  lineNr = 1
  line = xFile.ReadLine

  If Mid(line, addrCol, 2) = "  " Then
    text = Mid(line, addrCol+2, opCodeCol-addrCol-2)
    If Len(Trim(text)) > 0 Then
      '-- assume it's a heading line and convert to a HEAD card
      WriteCard cardFile, Mid(line, 1, 8), "1" & Space(9) & "HEAD  " & Mid(line, addrCol+2, lastCol-addrCol+2)
      line = xFile.ReadLine
    End If
  End If

  eof = xFile.AtEndOfStream
  Do While Not eof
    lineNr = lineNr+1
    address = RTrim(Mid(line, addrCol, 4))
    label = RTrim(Mid(line, labelCol, 5))
    opCode = RTrim(Mid(line, opCodeCol, 5))
    operand = RTrim(Mid(line, operandCol, lastCol-operandCol))
    seq = LTrim(Mid(line, 1, 8))

    '-- If the address and opCode fields are blank, generate a REM card
    '-- If the sequence field is blank, and the address field is not, do not generate a card
    If Len(opCode) = 0 And Len(address) = 0 Then
      WriteCard cardFile, seq, "1" & Space(9) & "REM   " & operand
    ElseIf Len(seq) > 0 Or Len(address) = 0 Then
      '-- Reformat and write the assembler card image
      WriteCard cardFile, seq, "1" & Space(3) & _
             PicXn(label, 6) & PicXn(opCode, 6) & operand
    End If

    If xFile.AtEndOfStream Then
      eof = True
    ElseIf opCode = "FINI" Then
      eof = True
    Else
      line = xFile.ReadLine
    End If
  Loop

  cardFile.Close
  Set cardFile = Nothing
  xfile.Close
  Set xFile = Nothing
End Sub

'---------------------------------------------------------------

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
quietMode = False
lastSeq = "01 0"


Set args = WScript.Arguments
For Each deckName In args
  If UCase(Trim(deckName)) = "/Q" Then
    quietMode = True
  ElseIf Len(fileName) = 0 Then
    fileName = Trim(deckName)
  Else
    lastSeq = Trim(deckName)
  End If
Next

Set args = Nothing
If Len(fileName) = 0 Then
  MsgBox "Must supply the name of the transcription file."
  WScript.Quit 9
Else
  '-- Main Line --
  If Not fso.FileExists(fileName) Then
    MsgBox "Transcription file does not exist: " & vbCrLf & fileName
    WScript.Quit 8
  Else
    deckName = fso.BuildPath(fso.GetParentFolderName(fileName), fso.GetBaseName(fileName)) & ".card"
    ExtractCode fileName, deckName
    If not quietMode Then
      MsgBox "BAC-Assembler card deck created: " & vbCrLf & deckName
    End If

    WScript.Quit 0
  End If
End If

Set fso = Nothing

]]>
</script>
</job>
</package>