Trailing-Edge
-
PDP-10 Archives
-
BB-FP64A-SB_1986
-
10,7/galaxy/lptdqs.mac
There are 7 other files named lptdqs.mac in the archive. Click here to see a list.
TITLE LPTDQS - Distributed Queue System driver for LPTSPL-10
SUBTTL Joseph A. Dziedzic 12-SEP-85
;
;
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
;
SEARCH GLXMAC ;SEARCH GALAXY PARAMETERS
SEARCH QSRMAC ;SEARCH QUASAR PARAMETERS
SEARCH ORNMAC ;SEARCH ORION/OPR PARAMETERS
SEARCH LPTMAC ;Search LPTSPL parameters
PROLOG(LPTDQS)
.TEXT "/LOCALS /SEGMENT:LOW DQS/EXCLUDE:XFUNCT"
IF2,<PRINTX Assembling GALAXY-10 LPTDQS>
.DIRECT FLBLST
SALL ;SUPPRESS MACRO EXPANSIONS
ENTRY LPTDQS ;LOAD IF LIBRARY SEARCH
;LPTDQS VERSION INFORMATION
LDQEDT==2 ;EDIT LEVEL (LPTDQS)
SUBTTL Table of Contents
SUBTTL Revision History
COMMENT |
1 Create this module to implement DQS support.
GCO 10228 3-Jun-85 /JAD
2 Update copyright statements. 12-SEP-85 /LEO
[End of Revision History]
|
SUBTTL Local Symbols
TRYTIM==^D60 ;SECONDS TO WAIT BETWEEN CONNECT TRIES
SUBTTL Tables -- Forms type entry format
PHASE 0
FT.COD:!BLOCK 1 ;SIXBIT CODE FOR FORMS ('NORMxx')
FT.NAM:!BLOCK FRMSIZ ;ASCII FORMS NAME
FT.SIZ:! ;SIZE OF AN ENTRY
DEPHASE
SUBTTL Tables -- Forms type file descriptor
FTYFD: $BUILD (FDMSIZ) ;SHORT FILESPEC BLOCK
$SET (.FDLEN,FD.LEN,FDMSIZ) ;LENGTH
$SET (.FDSTR,,'SYS ') ;DEVICE
$SET (.FDNAM,,'FORMST') ;NAME
$SET (.FDEXT,,'DAT ') ;EXTENSION
$EOB
FTYFOB: $BUILD (FOB.SZ) ;FILE OPEN BLOCK
$SET (FOB.FD,,FTYFD) ;ADDRESS OF FD
$SET (FOB.CW,FB.BSZ,7) ;BYTE SIZE (ASCII)
$EOB
$DATA FTYIFN,1 ;IFN FOR FORMS TYPE FILE
$DATA FTYUDT,1 ;CREATION DATE/TIME OF FORMS TYPE FILE
$DATA FTYLST,1 ;LIST NAME FOR FORMS TYPE LIST
$DATA FTYTMP,FRMSIZ ;TEMPORARY STORAGE FOR FORMS NAME
SUBTTL Tables -- Function dispatch table
;This table contains the addresses of the DQS specific functions
;which will be called by LPTSPL at the required times.
LPTDQS::DEVDSP (DQS,<Xerox 8700>)
OUTDIE==:LPTDIE## ;HACK FOR BLISS LIBRARY
J$LFCT==J$DWDS ;FAIRNESS COUNTER
DJMLST==1B35 ;DJM LOST CONNECTION
SUBTTL Miscellaneous Data Storage
WTOLEN==^D80 ;LENGTH OF WTO BUFFER
WTOBUF: BLOCK WTOLEN ;THE BUFFER
WTOPTR: BLOCK 1 ;POINTER INTO BUFFER
WTOCNT: BLOCK 1 ;COUNT OF CHARACTERS IN BUFFER
SUBTTL DQSINX - DQS/STREAM INITIALIZATION
DQSINX: JUMPN M,INIT.1 ;CHECK FOR LPTSPL INITIALIZATION
PUSHJ P,WTOINI ;INTIALIZE LOCAL WTO BUFFER
PUSHJ P,G$INIT## ;FIREUP DQS LIBRARY
$RETT ;AND RETURN
INIT.1: LOAD T1,SUP.FL(M),SUFSRV ;GET THE SERVER FLAG
JUMPE T1,INIT.2 ;NOT A DQS PRINTER
SKIPE SUP.ST(M) ;ALTERNATE DEVICE?
JRST INIT.2 ;YES--CAN'T HANDLE THAT
MOVE S1,STREAM## ;GET STREAM NUMBER
MOVE S1,JOBOBA##(S1) ;AND THE OBJECT BLOCK
MOVE S1,OBJ.ND(S1) ;GET STATION NUMBER
MOVX S2,DN.FLK ;KNOWN NODE
PUSHJ P,LPTDCN## ;MUST BE DECNET
JUMPF INIT.2 ;ELSE RETURN
MOVEI T1,4 ;SETUP UUO AC
MOVE T2,[DN.FLE!<.DNLNN,,3>] ;FLAGS, FUNCTION, AND LENGTH
MOVEI T3,1 ;RETURN ONE NODE
SETZ T4, ;IT WILL GO HERE
DNET. T1, ;READ EXECUTOR NODE
JRST INIT.4 ;CAN'T
CAMN S1,T4 ;SPOOLING TO SELF?
JRST INIT.3 ;CAN'T DO THAT
SETZM J$LION(J) ;NO I/O INDEX FOR THIS BEAST
MOVE T1,['X8700 '] ;UNIT TYPE IDENTIFIER
MOVEM T1,J$LTYP(J) ;SAVE FOR QUASAR
SETOM J$LLCL(J) ;SAY WE SUPPORT LOWER CASE
MOVSI T1,LPTDQS ;BUILD A BLT POINTER
HRRI T1,J$$DEV(J) ; TO THE INITIALIZATION VECTOR
BLT T1,J$$DND(J) ;COPY OUR VECTOR
SETZM J$POSF(J) ;XEROX 8700 DOESN'T POSITION
SETZM J$FFDF(J) ;XEROX 8700 DOESN'T LIKE FORM FEEDS
SETZM J$MNTF(J) ;XEROX 8700 DOESN'T SUPPORT MOUNTABLE FORMS
$RETT ;RETURN
INIT.2: MOVNI S1,1 ;-1 MEANS DEVICE NOT FOR US
$RETF ;RETURN
INIT.3: SKIPA S1,[%RSUNA] ;UNIT NOT AVAILABLE
INIT.4: MOVEI S1,%RSUDE ;UNIT WILL NEVER BE AVAILABLE
$RETF ;RETURN
SUBTTL DQSIPC - SPECIAL IPCF MESSAGE PROCESSING
DQSIPC: MOVNI S1,1 ;WE HAVE NO SPECIAL MESSAGES
$RETF ;RETURN
SUBTTL DQSSCD - SCHEDULER CALL
DQSSCD: $RETT ;DO NOTHING
SUBTTL DQSWAK - WAKEUP TIME CHECK
DQSWAK: $RETT ;RETURN
SUBTTL DQSOPX - OPEN DEVICE
;Routine called to OPEN the DQS printer.
DQSOPX: MOVE S1,STREAM## ;GET STREAM NUMBER
MOVE S1,JOBOBA##(S1) ;AND THE OBJECT BLOCK
MOVE S1,OBJ.ND(S1) ;COPY TARGET NODE
MOVX S2,DN.FLR ;REACHABLE
PUSHJ P,LPTDCN## ;CHECK STATUS
JUMPF OPEN.2 ;GIVE UP IF NOT AVAILABLE
MOVE S1,STREAM## ;GET OUR STREAM NUMBER
MOVE S1,JOBOBA##(S1) ;GET OUR OBJECT BLOCK ADDRESS
BCALL. (G$CHECKDQS##,<OBJ.ND(S1),OBJ.UN(S1)>) ;SEE IF DJM
TRNE S1,1 ;IS THERE A DJM SERVER THERE?
JRST OPEN.1 ;YES, OK TO PROCEED
MOVE S1,STREAM## ;GET OUR STREAM NUMBER AGAIN
$WTO (<Distributed Job Manager not running>,,@JOBOBA##(S1))
JRST OPEN.2 ;GIVE UP
OPEN.1: PUSHJ P,TRYCON ;TRY TO CONNECT
JUMPF OPEN.2 ;GIVE UP
MOVSI S1,(POINT 8,0) ;GET 8 BIT BYTE POINTER
MOVEM S1,J$LBTZ(J) ;SAVE IT FOR LATER
PUSHJ P,LPTRES## ;SETUP/RESET THE OUTPUT BUFFER POINTERS
MOVX S1,%RSUOK ;LOAD SUCCESS CODE
$RETT ;ALL DONE
OPEN.2: MOVX S1,%RSUNA ;GET ERROR CODE (TRY AGAIN LATER)
$RETT ;ALL DONE
SUBTTL DQSCLS - CLOSE
DQSCLS: $RETT ;DO NOTHING
SUBTTL DQSFVU - LOAD VFU
DQSVFU: $RETT ;DO NOTHING
SUBTTL DQSRAM - LOAD RAM
DQSRAM: $RETT ;DO NOTHING
SUBTTL DQSLER - FILE LOOKUP ERROR PROCESSING
DQSLER: $TEXT(<-1,,J$WTOR(J)>,<Can't access file ^F/@J$DFDA(J)/, ^E/[-1]/^0>)
MOVEI S1,J$WTOR(J) ;ADDRESS OF ERROR STRING
HRLI S1,(POINT 7) ;ASCII BYTE POINTER
BCALL. (G$ZDATA##,<S1>) ;SEND THE DATA
PUSHJ P,CHKDJM ;CHECK FOR LOST CONNECTION
PUSHJ P,DQSOUT ;FLUSH LAST BUFFER(S)
PUSHJ P,G$EOF## ;SEND END OF FILE
PUSHJ P,CHKDJM ;CHECK FOR LOST CONNECTION
$RETF ;RETURN
SUBTTL DQSIER - FILE INPUT ERROR PROCESSING
DQSIER: $TEXT (<-1,,J$WTOR(J)>,<Error reading input file;^E/[-1]/^0>)
MOVEI S1,J$WTOR(J) ;ADDRESS OF STRING
HRLI S1,(POINT 7) ;ASCII BYTE POINTER
BCALL. (G$ZDATA##,<S1>) ;SEND THE TEXT
PUSHJ P,CHKDJM ;CHECK FOR LOST CONNECTION
$RETF ;RETURN
SUBTTL DQSFLS - FLUSH JOB
DQSFLS: PUSHJ P,LPTDIE## ;RELEASE STUFF
PUSHJ P,G$DISCONNECT## ;DISCONNECT
MOVE S1,STREAM## ;GET OUR STREAM NUMBER
$WTO (<Lost DJM connection>,,@JOBOBA##(S1))
PUSHJ P,TRYCON ;TRY THE CONNECT AGAIN
$RET ;PASS ALONG TRUE/FALSE RETURN
SUBTTL DQSOUT - OUTPUT A BUFFER
DQSOUT: SKIPGE S1,J$LBCT(J) ;GET BYTES REMAINING IN BUFFER
SETZM S1 ;IF LESS,,MAKE IT ZERO
SUB S1,J$LIBC(J) ;CALC -BYTE COUNT IN BUFFER
JUMPGE S1,LPTRES## ;NOTHING TO PUT OUT,,RESET BUFR PTRS
MOVMS S1 ;MAKE COUNT POSITIVE
BCALL. (G$DATA##,<J$LIBP(J),S1>) ;SHIP THE DATA
TRNE S1,1 ;SUCCESSFUL RETURN?
JRST OUTP.1 ;YES, RESET BUFR PTRS AND RETURN
PUSHJ P,REQJOB ;REQUEUE DUE TO LOST CONNECTION
PUSHJ P,INPFEF## ;FORCE END OF FILE
$RETT ;QUIT
OUTP.1: PUSHJ P,LPTRES## ;RESET BUFFER POINTERS
AOS S1,J$LFCT(J) ;SEE IF TIME TO LET OTHER STREAMS RUN
CAIG S1,2 ;MAGIC NUMBER
$RETT ;NO, RETURN NOW
SETZM J$LFCT(J) ;YES, CLEAR FOR NEXT TIME AROUND
SETZM SLEEPT## ;NO SLEEP TIME WANTED
$DSCHD (0) ;LET OTHER STREAMS RUN
$RETT ;RETURN
SUBTTL DQSOER - OUTPUT ERROR PROCESSING
DQSOER: $RETT ;NEVER CALLED
SUBTTL DQSEOX - OUTPUT EOF PROCESSING
DQSEOX: $RETT ;DO NOTHING
SUBTTL DQSBJB - PER-REQUEST INITIALIZATION
;Routine to perform necessary initialization at the beginning of
;a request.
DQSBJB: PUSHJ P,.SAVE2## ;SAVE P1 AND P2
MOVSI S1,.EQCHK(J) ;START OF CHECKPOINT AREA
HRRI S1,.EQCHK+1(J) ;MAKE A BLT POINTER
SETZM .EQCHK(J) ;CLEAR FIRST WORD
BLT S1,.EQCHK+EQCKSZ-1(J) ;ZAP CHECKPOINT INFO
PUSHJ P,CNVFTY ;CONVERT LONG FORMS NAME
MOVE P1,S1 ;COPY SOMEWHERE SAFE
GETLIM S1,.EQLIM(J),NOT1 ;GET FIRST HALF OF NOTE
GETLIM S2,.EQLIM(J),NOT2 ;GET SECOND HALF OF NOTE
$TEXT (<-1,,J$PNOT(J)>,<^W6/S1/^W/S2/^0>) ;ASCII-IZE IT
$TEXT (<-1,,J$PUSR(J)>,<^W6/.EQOWN(J)/^W/.EQOWN+1(J)/^0>)
MOVEI P2,3 ;TIMES TO LOOP BEFORE GIVING UP
REQI.1: TXZE S,DJMLST ;DID WE LOSE CONNECTION TO THE DJM?
PUSHJ P,DQSFLS ;YES, RECONNECT
TXNE S,ABORT ;ABORTED?
$RETT ;YES, QUIT NOW
MOVEI T1,J$PUSR(J) ;ADDRESS OF USER NAME STRING
HRLI T1,(POINT 7) ;MAKE IT AN ASCII BYTE POINTER
LOAD T2,.EQSEQ(J),EQ.PRI ;PRIORITY
CAILE T2,4 ;IN RANGE?
MOVEI T2,4 ;NO, MAKE IT SO
SKIPN .EQCHR(J) ;CHARACTERISTICS SPECIFIED?
SKIPA T3,[[ASCIZ /LANDSCAPE/]] ;NO, LOAD ADDRESS OF DEFAULT STRING
MOVEI T3,.EQCHR(J) ;LOAD ADDRESS OF CHARACTERISTICS STRING
HRLI T3,(POINT 7) ;MAKE IT AN ASCII BYTE POINTER
MOVEI T4,J$PNOT(J) ;POINTER TO NOTE STRING
HRLI T4,(POINT 7) ;ASCII BYTE POINTER
BCALL. (G$CREATE##,<T1,.EQRID(J),.EQJOB(J),[1],T2,T3,P1,[0],<.EQSEQ(J),EQ.NOT>,.EQAFT(J),T4>)
TRNN S1,1 ;SUCCESSFUL RETURN FROM G$CREATE?
TXOA S,DJMLST ;NO, THEN LOST DJM CONNECTION
$RETT ;YES, RETURN
SETZM SLEEPT## ;NO SLEEP TIME WANTED
$DSCHD (0) ;LET OTHER STREAMS RUN
SOJGE P2,REQI.1 ;TRY AGAIN
PUSHJ P,REQJOB ;ELSE REQUEUE JOB
$RETT ;AND RETURN
SUBTTL DQSEJB - END OF JOB
DQSEJB: TXNE S,ABORT ;ABORTING?
$RETT ;DON'T COMMIT
PUSHJ P,G$END## ;DO A DQS END OF JOB/COMMIT
PUSHJ P,CHKDJM ;CHECK FOR LOST CONNECTION
$RETT ;DO NOTHING
SUBTTL DQSBFL - Begining of file processing
;Routine to perform per-file initialization.
DQSBFL: MOVE S1,.FPINF(E) ;GET FLAGS FOR FILE
TXNE S1,FP.REN ;IS IT /DISPOSE:RENAME?
JRST FILI.3 ;YES, PROCESS THAT
TXNN S1,FP.SPL ;IS IT A SPOOLED FILE?
JRST FILI.2 ;NO, CONTINUE ON
TXNN S1,FP.FLG ;IS IT ALSO A LOG FILE?
JRST FILI.1 ;NO, JUST A PLAIN SPOOLED FILE
$TEXT (<-1,,J$PFL1(J)>,<Batch Log File^0>) ;USE A DEFAULT
JRST FILI.5 ;CONTINUE
FILI.1: MOVE S1,J$DIFN(J) ;GET THE FILE'S IFN
MOVX S2,FI.SPL ;GET THE SPOOL NAME INFO CODE
$CALL F%INFO ;GET THE SPOOLED NAME
JUMPE S1,FILI.4 ;NOTHING
$TEXT (<-1,,J$PFL1(J)>,<^W/S1/^0>) ;GENERATE THE SPOOLED NAME
JRST FILI.5 ;CONTINUE
FILI.2: MOVE S1,J$DFDA(J) ;GET THE FD ADDRESS
$TEXT (<-1,,J$PFL1(J)>,<^W/.FDNAM(S1)/.^W3/.FDEXT(S1)/^0>)
JRST FILI.5 ;CONTINUE
FILI.3: $TEXT (<-1,,J$PFL1(J)>,<^W/.FPONM(E)/.^W3/.FPOXT(E)/^0>)
JRST FILI.5 ;CONTINUE
FILI.4: $TEXT (<-1,,J$PFL1(J)>,<Spooled Printer File^0>)
FILI.5: MOVEI T1,J$PFL1(J) ;ADDRESS OF FILE NAME STRING
HRLI T1,(POINT 7) ;ASCII BYTE POINTER
LOAD T2,.FPINF(E),FP.NFH ;GET NO HEADERS BIT
TRC T2,1 ;COMPLEMENT IT
BCALL. (G$FILESPEC##,<T1,<.FPINF(E),FP.FCY>,[0],T2,[1],[1],<.FPINF(E),FP.FSP>,[0],[0],[0]>)
PJRST CHKDJM ;CHECK FOR LOST CONNTECTION AND RETURN
SUBTTL DQSEFL - END OF FILE
DQSEFL: TXNE S,RQB+ABORT+DJMLST ;REQUEUE OR ABORTING?
$RETF ;YES, QUIT
PUSHJ P,@J$OUTP(J) ;FLUSH LAST BUFFER(S)
PUSHJ P,G$EOF## ;SEND END OF FILE
PUSHJ P,CHKDJM ;CHECK FOR LOST CONNECTION
$RETF ;NEVER ALLOW MORE THAN 1 COPY TO PRINT
SUBTTL DQSBAN - BANNER
DQSBAN: $RETF ;NO BANNERS
SUBTTL DQSWID - PAGE WIDTH CALCULATION
DQSWID: $RETT ;USE STANDARD WIDTH COMPUTATION
SUBTTL DQSHDR - HEADER
DQSHDR: $RETF ;NO HEADERS
SUBTTL DQSRUL - RULER
DQSRUL: $RETT ;DO NOTHING
SUBTTL DQSSHT - SHUTDOWN STREAM
;Routine called when a stream is shutdown.
DQSSHT: PUSHJ P,G$DISCONNECT## ;DISCONNECT FROM DJM
$RETT ;THAT'S ALL
SUBTTL DQSCHR - SPECIAL CHARACTER TRANSLATION
DQSCHR: $RETT ;DO NOTHING
SUBTTL DQSSTS - DEVICE STATUS MESSAGE
;Routine called to generate the status text for CHKPNT.
DQSSTS: MOVE S1,J$RFLN(J) ;GET RELATIVE FILE NUMBER
LOAD S2,.EQSPC(J),EQ.NUM ;GET TOTAL NUMBER OF FILES
SUBM S2,S1 ;GET NUMBER PROCESSED
ADDI S1,1 ;CORRECT IT
$TEXT (DEPBP##,<, transferring file ^D/S1/ of ^D/S2/^0>)
$RETT ;RETURN
SUBTTL Connect to DJM
;Routine to attempt to connect to the Distributed Job Manager.
TRYCON: PUSHJ P,G$CONNECT## ;DO THE CONNECT
TRNE S1,1 ;DID IT FAIL?
$RETT ;NO, RETURN
$DSCHD (TRYTIM) ;GO AWAY FOR A WHILE
TXNE S,ABORT ;WERE WE ABORTED?
$RETF ;YES, QUIT
JRST TRYCON ;NO, TRY AGAIN
SUBTTL Requeue job
; HERE TO CHECK FOR A LOST DJM NETWORK CONNECTION AND REQUEUE JOB
; (FROM BEGINING OF JOB) IF NECESSARY
CHKDJM: TXNN S,GOODBY ;JOB COMPLETED OR ON ITS WAY OUT?
TRNE S1,1 ;OR DJM FUNCTION SUCCEED?
$RETT ;YES TO EITHER
REQJOB: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
MOVE S1,STREAM## ;GET THE STREAM NUMBER
TXNN S,RQB ;BEEN HERE ONCE BEFORE?
$WTO (<Job requeued>,<Reason: network failure>,@JOBOBA(S1))
TXO S,RQB+ABORT+DJMLST ;LITE THE REQUEUE+ABORT BITS
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW##(S1) ;ARE WE WAITING FOR THE OPERATOR ???
$KWTOR (JOBWAC##(S1)) ;YES,,KILL THE WTOR
ANDCAM S2,JOBSTW##(S1) ;ZAP THE OPR WAIT BIT
SETZM J$RNPP(J) ;CLEAR CURRENT PAGE NUMBER
SETZM J$RNCP(J) ;CLEAR CURRENT COPY NUMBER
SETZM J$RNFP(J) ;CLEAR FILE COUNT
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
$RETF ;INDICATE LOST CONNECTION
SUBTTL Convert Long Forms Name
;Routine to convert the long forms name to the encoded value.
;Returns the encoded name in S1.
CNVFTY: PUSHJ P,CHKFTY ;MAKE SURE WE HAVE A CURRENT FILE
JUMPF CNVF.1 ;IF FAILURE, JUST USE DEFAULTS
PUSHJ P,FNDFTY ;FIND FORMS TYPE, RETURN CODE IN S1
$RETIT ;RETURN IF WE LIKE IT
MOVE S2,STREAM## ;GET OUR STREAM NUMBER
$WTO (<^T/0(S1)/>,<Default forms type being used>,@JOBOBA##(S2))
CNVF.1: MOVX S1,'NORM00' ;GET THE DEFAULT
$RETT ;RETURN
SUBTTL Find forms type
;Routine to find a forms type matching that of the current request.
;Returns:
; TRUE with:
; S1/ Encoded forms name
; FALSE if no match or ambiguous with:
; S1/ Address of ASCIZ error text
FNDFTY: PUSHJ P,.SAVE2## ;SAVE P1-P2
SETZ P1, ;CLEAR COUNT OF MATCHES
MOVE S1,FTYLST ;GET THE LIST HANDLE
$CALL L%FIRST ;POSITION TO FIRST ENTRY
JUMPF FNDF.3 ;RETURN IF NULL LIST
FNDF.1: MOVE P2,S2 ;POINT AT THE ENTRY
MOVEI S1,FT.NAM(P2) ;ADDRESS OF STRING
MOVEI S2,.EQFRM(J) ;ADDRESS OF FORMS TYPE IN EQ
PUSHJ P,STGCMP ;COMPARE THE STRINGS
JUMPF FNDF.2 ;JUMP IF NO MATCH
JUMPN P1,FNDF.4 ;AMBIGUOUS IF NOT FIRST MATCH
MOVE P1,P2 ;COPY POINTER TO MATCHING NAME
FNDF.2: MOVE S1,FTYLST ;GET THE LIST HANDLE
$CALL L%NEXT ;POSITION TO NEXT ENTRY
JUMPT FNDF.1 ;LOOP IF MORE TO CHECK
JUMPE P1,FNDF.5 ;ERROR IF NO MATCH WAS FOUND
MOVE S1,FT.COD(P1) ;GET ENCODED NAME
$RETT ;SUCCESS
FNDF.3: MOVEI S1,[ASCIZ /Null forms type list/] ;GET TEXT
JRST FNDF.6 ;RETURN
FNDF.4: MOVEI S1,[ASCIZ /Ambiguous forms type abbreviation/] ;GET TEXT
JRST FNDF.6 ;RETURN
FNDF.5: MOVEI S1,[ASCIZ /Unknown forms type/] ;GET TEXT
FNDF.6: $RETF ;RETURN FAILURE
SUBTTL Compare two strings
;Routine to compare two ASCIZ strings. Returns TRUE if match (partial
;match OK), FALSE if no match.
STGCMP: HRLI S1,(POINT 7) ;MAKE BYTE POINTERS
HRLI S2,(POINT 7) ;...
SCMP.1: ILDB T1,S1 ;GET A CHARACTER
JUMPE T1,.RETT ;RETURN IF FIRST STRING EXHAUSTED
CAIL T1,"a" ;CONVERT LOWER CASE TO UPPER
CAILE T1,"z" ;...
SKIPA ;...
SUBI T1,"a"-"A" ;...
ILDB T2,S2 ;GET A CHARACTER
JUMPE T2,.RETT ;RETURN IF SECOND STRING EXHAUSTED
CAIL T2,"a" ;CONVERT LOWER CASE TO UUPER
CAILE T2,"z" ;...
SKIPA ;...
SUBI T2,"a"-"A" ;...
CAMN T1,T2 ;MATCH SO FAR?
JRST SCMP.1 ;YES, KEEP LOOKING
$RETF ;NO, RETURN FALSE
SUBTTL Check forms type list
;Routine to check that the forms type list is current. If the forms
;type file is newer than our last glance we will build a new list.
;Return:
; TRUE if successful (list exists)
; FALSE if error (no list exists)
CHKFTY: MOVEI S1,FOB.SZ ;SIZE OF FILE OPEN BLOCK
MOVEI S2,FTYFOB ;ADDRESS OF IT
$CALL F%IOPN ;OPEN FOR INPUT
JUMPF CHKF.9 ;ERROR
MOVEM S1,FTYIFN ;SAVE IFN FOR LATER
MOVX S2,FI.CRE ;NEED CREATION DATE/TIME
$CALL F%INFO ;ASK FOR FILE INFO
CAMN S1,FTYUDT ;FILE CHANGED?
PJRST RELFTY ;NO, RELEASE FILE AND RETURN
MOVEM S1,FTYUDT ;UPDATE THE CREATION DATE/TIME
SKIPE S1,FTYLST ;GET LIST HANDLE OF EXISTING LIST
$CALL L%DLST ;DELETE THE LIST
$CALL L%CLST ;CREATE A NEW LIST
MOVEM S1,FTYLST ;SAVE IT'S HANDLE
CHKF.1: PUSHJ P,REDFTY ;READ A FORMS TYPE FROM THE FILE
JUMPF RELFTY ;GO IF END OF FILE
IDIVI S1,^D16 ;GET TWO HEX DIGITS
ADDI S1,'0' ;SIXBIT-IZE IT
CAILE S1,'9' ;PAST NUMERICS?
ADDI S1,'A'-'9'-1 ;YES, GO TO ALPHABETICS
ADDI S2,'0' ;SIXBIT-IZE IT
CAILE S2,'9' ;PAST NUMERICS?
ADDI S2,'A'-'9'-1 ;YES, GO TO ALPHABETICS
MOVX T1,'NORM ' ;STANDARD NAME
DPB S1,[POINT 6,T1,29] ;STORE LAST TWO CHARACTERS
DPB S2,[POINT 6,T1,35] ;...
MOVE S1,FTYLST ;GET LIST HANDLE
MOVEI S2,FT.SIZ ;LENGTH OF AN ENTRY
$CALL L%CENT ;CREATE THE ENTRY
SKIPT ;DID IT SUCCEED?
$STOP (CCE,Can't create list entry)
MOVEM T1,FT.COD(S2) ;SAVE ENCODED NAME
MOVSI T1,FTYTMP ;FROM HERE
HRRI T1,FT.NAM(S2) ;TO HERE
BLT T1,FT.NAM+FRMSIZ-1(S2) ;COPY FORMS NAME
JRST CHKF.1 ;LOOP FOR MORE
CHKF.9: MOVE S1,STREAM## ;GET OUR STREAM NUMBER
$WTO (<Cannot access forms type file ^F/FTYFD/>,<Default forms type being used>,@JOBOBA##(S1))
$RETF ;RETURN
SUBTTL Release forms file
;Routine to release the forms file if it is opne.
RELFTY: SKIPE S1,FTYIFN ;GET IFN, SKIP IF NOT OPEN
$CALL F%REL ;RELEASE THE FILE
SETZM FTYIFN ;FORGET ABOUT IT
$RETT ;RETURN
SUBTTL Read a line from forms type file
;Routine to read one line from the forms type file. Returns the
;forms name in FTYTMP, the forms number in S1 if TRUE, FALSE if
;end of file.
REDFTY: MOVEI S1,FRMSIZ ;SIZE OF AREA
MOVEI S2,FTYTMP ;ADDRESS
$CALL .ZCHNK ;ZERO IT
REDF.0: MOVE S1,FTYIFN ;GET THE IFN
$CALL F%IBYT ;GET FIRST CHARACTER
$RETIF ;IF ERROR
CAXE S2,"%" ;THE SPECIAL CHARACTER?
JRST [PUSHJ P,REDF.X ;SKIP THIS LINE
JRST REDF.0] ;TRY AGAIN
$CALL F%IBYT ;GET NEXT BYTE
$RETIF ;IF ERROR
CAXN S2," " ;SPACE?
JRST .-3 ;KEEP LOOKING FOR START OF FORMS NAME
MOVX T2,<FRMSIZ*5>-1 ;MAXIMUM NUMBER OF BYTES
SKIPA T1,[POINT 7,FTYTMP] ;POINTER TO STORE IT
REDF.1: $CALL F%IBYT ;GET NEXT INPUT BYTE
$RETIF ;IF ERROR
CAIL S2,"a" ;CONVERT LOWER CASE TO UPPER
CAILE S2,"z" ;...
SKIPA ;...
SUBI S2,"a"-"A" ;...
CAIL S2,"A" ;ALPHABETIC?
CAILE S2,"Z" ;...
SKIPA ;NO, KEEP CHECKING
JRST REDF.2 ;OK, PROCEED
CAIL S2,"0" ;NUMERIC?
CAILE S2,"9" ;...
CAIN S2,"_" ;OR AN UNDERSCORE?
SKIPA ;YES
JRST REDF.3 ;NO, NOW LOOK FOR FORMS NUMBER
REDF.2: SOSL T2 ;QUIT WHEN WE RUN OUT OF ROOM
IDPB S2,T1 ;STORE THE BYTE IN STRING
JRST REDF.1 ;KEEP LOOKING
REDF.3: $CALL F%IBYT ;GET A BYTE
$RETIF ;IF ERROR
CAIL S2,"0" ;FOUND A DIGIT?
CAILE S2,"9" ;...
JRST REDF.3 ;NO, KEEP LOOKING
TDZA T1,T1 ;START WITH ZERO
REDF.4: $CALL F%IBYT ;GET ANOTHER BYTE
$RETIF ;IF ERROR
CAIL S2,"0" ;FOUND A DIGIT?
CAILE S2,"9" ;...
JRST REDF.5 ;NO, DONE WITH FORMS NUMBER
IMULI T1,^D10 ;YES, OLD VALUE TIMES TEN
ADDI T1,-"0"(S2) ;ADD IN DIGIT JUST READ
JRST REDF.4 ;LOOP
REDF.5: PUSHJ P,REDF.X ;READ UNTIL END OF LINE
MOVE S1,T1 ;RETURN FORMS NUMBER IN S1
$RETT ;ALL DONE
REDF.X: $CALL F%IBYT ;GET A BYTE
$RETIF ;IF ERROR
CAXE S2,.CHLFD ;END OF LINE FEED?
JRST REDF.X ;NO, KEEP LOOKING
$RETT ;YES
SUBTTL Error Message Output from DQSLIB
;Routine called to output an error message (character by character)
;from the BLISS library DQSLIB. Character is down one word on the
;stack on entry.
TT$CHR::AOS S1,WTOCNT ;COUNT ANOTHER CHARACTER
CAIL S1,<WTOLEN*5> ;ROOM FOR MORE?
PUSHJ P,WTOFLS ;NO, FLUSH THE BUFFER
MOVE S1,-1(P) ;FETCH THE CHARACTER
IDPB S1,WTOPTR ;STORE IN LOCAL BUFFER
CAIE S1,.CHLFD ;END OF LINE?
$RETT ;RETURN SUCCESS
WTOFLS: SETZ S1, ;GRAB A ZERO
IDPB S1,WTOPTR ;STUFF IT
MOVE S1,STREAM## ;GET OUR STREAM NUMBER
$WTO (<Error from DQSLIB>,<^T/WTOBUF/>,@JOBOBA##(S1))
;FALL INTO WTOINI AND RETURN
;(Re-)initialize the local WTO buffer.
WTOINI: SETZM WTOCNT ;ZERO THE COUNT
MOVE S1,[POINT 7, WTOBUF] ;VIRGIN POINTER INTO BUFFER
MOVEM S1,WTOPTR ;SAVE IT
$RETT ;RETURN
SUBTTL Literal pool
DQSLIT: LIT
DQSEND::!END