Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64b-sb
-
10,7/galtol/qsrcvt.mac
There are 5 other files named qsrcvt.mac in the archive. Click here to see a list.
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