1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-14 03:44:08 +00:00
Files
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/galtol/qsrcvt.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

414 lines
13 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE QSRCVT - Convert master queues
SUBTTL Universals
SEARCH GLXMAC
PROLOG QSRCVT ; Generate GLXLIB info
;
; Version number
;
QCVVER==2 ; Version number
QCVMIN==0 ; Minor version number
QCVWHO==0 ; Who last edited
QCVEDT==11 ; Edit level
LOC <.JBVER==137> ; Job data location for the version number
VRSN. (QCV) ; Generate the version number
RELOC ; Back to normal
SUBTTL Revision History
COMMENT |
10 Add revision history and version number, so we can keep track of this
program.
11 Fix typo in A7TOA8.
|
SUBTTL Parameters
; Parameters
IDXSIZ==PAGSIZ ; Index is one page
IDXCNT==PAGSIZ-6 ; Number of entries per index block
SECSIZ==200*PAGSIZ ; Number of words per section
PDLLEN==^D100 ; Stack length
SUBTTL Initialization block
CVTINI: $BUILD IB.SZ ; Start the block
$SET IB.PIB,,PIB ; Address of PIB
$SET IB.PRG,,%%.MOD ; Program name
$EOB ; End of block
PIB: $BUILD PB.MNS ; Smallest possible PIB
$SET PB.HDR,PB.LEN,PB.MNS ; Length of PIB
$SET PB.SYS,IP.SQT,-1 ; Send quota
$SET PB.SYS,IP.RQT,-1 ; Receive quota
$EOB ; End of PIB
FILFOB: $BUILD FOB.MZ ; Build the FOB
$SET FOB.FD,,FILFD ; Address of the FD
$SET FOB.CW,FB.BSZ,^D36 ; Byte size
$EOB ; End of block
FILFD: $BUILD FDMSIZ ; Minimum size FD
$SET .FDLEN,FD.LEN,FDMSIZ ; Size
$SET .FDLEN,FD.TYP,.FDNAT ; Native FD
$SET .FDSTR,,<SIXBIT |DSK|> ; Device
$SET .FDNAM,,<SIXBIT |QSRMS1|> ; File name
$SET .FDEXT,,<SIXBIT |QSR|> ; Extension
$SET .FDPPN,,<0-0> ; PPN (default path)
$EOB ; End of FD
QSRSAB::$BUILD SAB.SZ ; Build an SAB
$SET SAB.SI,SI.FLG,1 ; Use SI.IDX field
$SET SAB.SI,SI.IDX,SP.QSR ; Send to [SYSTEM]QUASAR
$EOB ; End of block
SUBTTL Start-up
; After initializing GLXLIB, we will make sure QUASAR is running, and
;determine which version is running by checking if the PID for
;[SYSTEM]MDA is in use. We will then open the copy of QUASAR's master
;queue on our default path, and proceed to read the requests and
;send them to the running QUASAR.
QSRV4==0 ; Version 4 is index 0
QSR37==1 ; Version 5.1 is index 1
QSR40==2 ; Version 5.1 is index 2
QSR41==3 ; Version 5.1 is index 3
QSRCVT: JFCL ; Ignore CCL entry
RESET ; Clear the world
MOVE P,[IOWD PDLLEN,PDL] ; Get the stack pointer
MOVX S1,IB.SZ ; Get the size of our IB
MOVEI S2,CVTINI ; And the address
$CALL I%INIT ; And initialize GLXLIB
GETPPN S1, ; Get out PPN
TRNA
MOVE S1,[1,,2] ; JACCTed is same as OPR
CAME S1,[1,,2] ; Are we operator?
$FATAL <Not an operator - must be [1,2]>
MOVX S1,SP.QSR ; Get the PID to find
$CALL C%RPRM ; Get it
JUMPT QSRC.1 ; Got it, check if MDA is there
$FATAL <QUASAR not running, no conversion possible>
QSRC.1: MOVX S1,SP.CAT ; Get the CATLOGer's PID
$CALL C%RPRM ; . . .
MOVX S1,QSRV4 ; Assume version 4.1 GALAXY
SKIPF ; Is the CATLOGer running?
MOVX S1,QSR41 ; Yes, must be version 5.1
MOVEM S1,QSRVER ; Save the index
; Now open the file and determine which version it is.
MOVX S1,FOB.MZ ; Get the FOB size
MOVEI S2,FILFOB ; And the address
$CALL F%IOPN ; Open it
JUMPT QSRC.2 ; Did we get it?
$FATAL <Cannot open master file ^F/FILFD/ - ^E/S1/>
QSRC.2: MOVEM S1,FILIFN ; Save the IFN
MOVEI S2,200 ; Position to first block of indices
$CALL F%POS ; Position it
JUMPF FILERR ; Error, punt
MOVE S1,FILIFN ; Get the IFN back
$CALL F%IBYT ; And get the word
JUMPF FILERR ; Bad?
HLRZ S1,S2 ; Get the version of the protocol
MOVSI S2,-QVRLEN ; Get the pointer into the table
QSRC.3: CAME S1,QVRTBL(S2) ; Is this the version?
AOBJN S2,QSRC.3 ; No, loop
JUMPL S2,QSRC.4 ; Did we get a valid version number?
$FATAL <File format version number (^O/S1/) is unknown.>
QSRC.4: HRRZM S2,FILVER ; Save the version of the file
HRRZS S2 ; Just right half
MOVE S1,QSRVER ; Get the Quasar version
$TEXT (,<[Converting from version ^O/QVRTBL(S2)/ to version ^O/QVRTBL(S1)/]>)
SUBTTL Main loop
; This is the main loop. It will read in each index page in succession,
;and then process the requests in that section.
MOVE S1,FILIFN ; Get the IFN
MOVX S2,FI.SIZ ; Get the size of the file
$CALL F%INFO ; Get it
IDIVX S1,SECSIZ ; Get the number of sections
MOVNI S1,1(S1) ; Make it negative
MOVSI P1,(S1) ; Get the counter set up
MAIN: MOVE S1,FILIFN ; Get the IFN
MOVEI S2,(P1) ; Get the section number
IMULX S2,SECSIZ ; Convert to byte number
ADDI S2,200 ; Plus offset for first empty block
$CALL F%POS ; Position the file
JUMPF FILERR ; Bad?
MOVE S1,FILIFN ; Get the IFN again
MOVE S2,[XWD -IDXSIZ,IDXBLK] ; Get the pointer
$CALL REDBLK ; And read the block
JUMPF FILERR ; Bad?
MOVSI P4,-IDXCNT ; Get the pointer to the entries
MAIN.0: SKIPN S1,IDXENT(P4) ; Get an entry
JRST MAIN.1 ; None here, try the next
HLRZ S2,S1 ; Get the entry type
CAXE S1,-1 ; Is it a -1?
CAIE S2,1 ; Want this type of entry?
JRST MAIN.1 ; No, skip it
MOVNI S2,(S1) ; Get the length of the request
CAXGE S2,-MXEQSZ ; Will it fit?
$FATAL <Entry in ^F/FILFD/ is too large (^D/S1,RHMASK/)>
MOVSI S2,(S2) ; Put in left half
HRRI S2,EQBUFF ; Get the buffer address
PUSH P,S2 ; Save the pointer
MOVX S1,MXEQSZ ; Get the max EQ size
MOVEI S2,EQBUFF ; And the address
$CALL .ZCHNK ; Clear the block
MOVEI S1,DATSIZ ; Get the independent data size
MOVEI S2,DATA ; Get the address of the interface data
$CALL .ZCHNK ; Clear the block
MOVEI S2,(P1) ; Get the section number
IMULX S2,SECSIZ ; Convert to word offset to first
MOVEI S1,(P4) ; Get the index
IMULX S1,200 ; Make it the word offset
ADDI S2,5*200(S1) ; Get the overall word address
MOVE S1,FILIFN ; Get the IFN
$CALL F%POS ; Position the file
POP P,S2 ; Restore the pointer
JUMPF FILERR ; Position fail?
MOVE S1,FILIFN ; Get the IFN
$CALL REDBLK ; Read the block
JUMPF FILERR ; Couldn't
SKIPN S1,CURPAG ; Get the page address (if any)
$CALL M%GPAG ; No, get one
MOVEM S1,CURPAG ; Save it
MOVE S1,FILVER ; Get the version index
$CALL @REDEQT(S1) ; And call correct routine
JUMPF MAIN.1 ; Couldn't, try the next
MOVE P2,S1 ; Get the pointer to the FD's
MOVE S1,CURPAG ; Save the page address for later send
MOVE S2,QSRVER ; Get QUASAR's version
$CALL @WRTEQT(S2) ; And send the request
JUMPF MAIN.1 ; Punt if bad
MOVE P3,S1 ; Get the pointer for writing the FD's
MAIN.2: MOVEI S1,FPFDLN ; Get the length of the FP/FD data
MOVEI S2,FPFDAT ; And the address
$CALL .ZCHNK ; Clear it
MOVE S1,P2 ; Get the pointer for the next FD
MOVE S2,FILVER ; Get the version
$CALL @REDFDT(S2) ; Read the FD
JUMPF MAIN.1 ; Error?
JUMPE S1,MAIN.3 ; All of the FD's finished?
MOVE P2,S1 ; Get the updated pointer
MOVE S1,P3 ; No, get the pointer for where to write
MOVE S2,QSRVER ; Get QUASAR's version
$CALL @WRTFDT(S2) ; Write it
JUMPF MAIN.1 ; Couldn't
MOVE P3,S1 ; Get the updated pointer
JRST MAIN.2 ; Try again
; Here when we have run out of FD's
MAIN.3: MOVE S1,P3 ; Get the last pointer
MOVE S2,QSRVER ; And the version of QUASAR
$CALL @ENDFDT(S2) ; End the request
MAIN.1: AOBJN P4,MAIN.0 ; Loop for all entries in the index
AOBJN P1,MAIN ; And all indicies
$TEXT (,<All jobs converted>)
MOVE S1,FILIFN ; Get the IFN
$CALL F%REL ; Release the file
$CALL I%EXIT ; And exit
JRST .-1 ; Shouldn't reall get here
; Here on a read error
FILERR: $FATAL <Error reading ^F/FILFD/ - ^E/S1/>
SUBTTL REDBLK - Read a block
; This routine will read a block from the file
;call:
; MOVE S1,IFN for file
; MOVE S2,[XWD -num words,address]
; $CALL REDBLK
; False return if error
; True return if successful
;
REDBLK: $SAVE <P1> ; Save P1
MOVE P1,S2 ; Get the pointer
REDB.1: $CALL F%IBYT ; Get a word
$RETIF ; Punt if bad
MOVEM S2,(P1) ; Store it
AOBJN P1,REDB.1 ; Loop for all of the block
$RETT ; And return
SUBTTL Tables
; Table of file version numbers to convert to GALAXY version index
QVRTBL: EXP %%.QV4## ; Version of QSRMAC for release 4.1
EXP %%.Q37## ; Version for releae 5.1
EXP %%.Q40## ; Version of release 5.1
EXP %%.Q41## ; Version of release 5.1
QVRLEN==.-QVRTBL
REDEQT: EXP REDQV4## ; Read a version 4.1 EQ
EXP REDQ37## ; Read a version 5.1 EQ
EXP REDQ40## ; Read a version 5.1 EQ
EXP REDQ41## ; Read a version 5.1 EQ
WRTEQT: EXP WRTQV4## ; Send a version 4.1 EQ
EXP WRTQ37## ; Send a version 5.1 EQ
EXP WRTQ40## ; Send a version 5.1 EQ
EXP WRTQ41## ; Send a version 5.1 EQ
REDFDT: EXP RFDQV4## ; Read version 2 FP/FD
EXP RFDQ37## ; Read version 5.1 FP/FD
EXP RFDQ40## ; Read version 5.1 FP/FD
EXP RFDQ41## ; Read version 5.1 FP/FD
WRTFDT: EXP WFDQV4## ; Write version 2 FP/FD
EXP WFDQ37## ; Write version 5.1 FP/FD
EXP WFDQ40## ; Write version 5.1 FP/FD
EXP WFDQ41## ; Write version 5.1 FP/FD
ENDFDT: EXP ENDQV4## ; End version 2 FD list
EXP ENDQ37## ; End version 5.1 FD list
EXP ENDQ40## ; End version 5.1 FD list
EXP ENDQ41## ; End version 5.1 FD list
SUBTTL Storage
PDL: BLOCK PDLLEN ; Stack
FILIFN: BLOCK 1 ; IFN for QSRMS1.QSR
QSRVER: BLOCK 1 ; Version of QUASAR running
FILVER: BLOCK 1 ; Version of file
CURPAG::BLOCK 1 ; Address of page for building new EQ
IDXBLK: BLOCK IDXSIZ ; Block for storing the index
IDXENT==IDXBLK+6 ; First real entry
EQBUFF::BLOCK PAGSIZ ; EQ block buffer
MXEQSZ==.-EQBUFF ; Max size of EQ block read in
DATA:!
ROBAT:: BLOCK 1 ; Requested attributes
ROBTY:: BLOCK 1 ; Object type
ROBND:: BLOCK 1 ; Requested node
ROBUA:: BLOCK 1 ; User attributes
EQITN:: BLOCK 1 ; Internal task name
EQRDV:: BLOCK 1 ; Request device (INP, LPT, ...)
EQJOB:: BLOCK 1 ; Job name
EQSEQ:: BLOCK 1 ; External sequence number
EQDSN:: BLOCK 1 ; Default station number
EQPRV:: BLOCK 1 ; Creator was priveleged
EQSPL:: BLOCK 1 ; Request contains spooled files
EQPRI:: BLOCK 1 ; External priority
EQPRO:: BLOCK 1 ; Request protection
EQNUM:: BLOCK 1 ; Number of files
EQAFT:: BLOCK 1 ; After param
EQNRS:: BLOCK 1 ; Non-restartable bit
EQDEP:: BLOCK 1 ; Dependency count
EQUNI:: BLOCK 1 ; Uniqueness
EQOUT:: BLOCK 1 ; /OUTPUT: value
EQFRM:: BLOCK 1 ; Forms type
EQNBL:: BLOCK 1 ; Number of blocks in request
EQPGS:: BLOCK 1 ; Page limit (output)
EQCOR:: BLOCK 1 ; Core limit (pages)
EQTIM:: BLOCK 1 ; Time limit (seconds)
EQLPT:: BLOCK 1 ; Page limit (input)
EQCDP:: BLOCK 1 ; Card limit (input)
EQPTP:: BLOCK 1 ; Tape limit (input)
EQPLT:: BLOCK 1 ; Plotter limit (input)
EQNOT:: BLOCK 2 ; /NOTE value
EQACT:: BLOCK 12 ; Account string
EQBOX:: BLOCK 12 ; Box name
EQCST:: BLOCK ^D10 ; Customer word
EQUSR:: BLOCK 10 ; User name
EQOID:: BLOCK 1 ; Owner PPN
EQOWN:: BLOCK 2 ; Owner SIXBIT user name
EQSCN:: BLOCK 1 ; /SCAN should be set on login
EQPAT:: BLOCK 6 ; Default path for login
DATSIZ==.-DATA
; FP data
FPFDAT:!
FPFFF:: BLOCK 1 ; File format
FPFPF:: BLOCK 1 ; Paper format
FPFSP:: BLOCK 1 ; Spacing code
FPDEL:: BLOCK 1 ; Delete flag
FPFLG:: BLOCK 1 ; Log file flag
FPNFH:: BLOCK 1 ; No headers flag
FPSPL:: BLOCK 1 ; Spooled file flag
FPIGN:: BLOCK 1 ; Ignore flag
FPFCY:: BLOCK 1 ; Copy count
FPFST:: BLOCK 1 ; Starting point info
FPFR1:: BLOCK 1 ; Report word 1
FPFR2:: BLOCK 1 ; Report word 2
; FD info
FDSTR:: BLOCK 1 ; Structure
FDNAM:: BLOCK 1 ; File name
FDEXT:: BLOCK 1 ; Extension
FDPPN:: BLOCK 1 ; PPN
FDPAT:: BLOCK 5 ; Path
FPFDLN==.-FPFDAT ; Length of FP/FD data
SUBTTL A7TOA8 - Convert 7 bit ASCII to 8bit ASCII
;+
;.HL1 A7TOA8
;Support routine to convert 7bit ASCII to 8-bit ASCII. This routine does
;nothing fancy.
;
; Usage:
; S1/ Source address
; S2/ Destination
; $CALL A7TOA8
; (Return)
;
;-
A7TOA8::HRLI S1,(POINT 7) ; Build the byte pointers
HRLI S2,(POINT 8) ; . . .
$SAVE <P1> ; Save a register
A728.0: ILDB P1,S1 ; Get a character
IDPB P1,S2 ; Store it
JUMPN P1,A728.0 ; Loop until done
$RET ; Return to the caller
SUBTTL A8TOA7 - Convert 8-bit ASCII to 7-bit ASCII
;+
;.HL1 A8TOA7
;This routine will convert 8-bit ASCII to 7-bit ASCII. It will assume
;that the strings are ASCIZ strings.
;
; Usage:
; S1/ Source pointer
; S2/ Destination pointer
; $CALL A8TOA7
; (Return)
;
;-
A8TOA7::$SAVE <P1> ; Save a register
HRLI S1,(POINT 8) ; Build the byte pointers
HRLI S2,(POINT 7) ; . . .
A827.0: ILDB P1,S1 ; Get a character
IDPB P1,S2 ; Store it
JUMPN P1,A827.0 ; Loop until done
$RET ; Return to the caller
SUBTTL End of QSRCVT
END QSRCVT ; End of program