Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_1of2_bb-x128c-sb
-
10,7/galaxy/nebula/chrfrm.mac
There are 2 other files named chrfrm.mac in the archive. Click here to see a list.
TITLE CHRFRM - Characteristics and Forms File Handler for DQS - V2
SUBTTL Joseph A. Dziedzic /JAD
;
;
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 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, ORNMAC, QSRMAC
PROLOG (CHRFRM)
FRMEDT==2 ;EDIT LEVEL
ENTRY CNVCHR ;FOR LIBRARY SEARCH
ENTRY CNVFRM ;DITTO
SUBTTL Revision History
COMMENT \
1 Created module so NEBULA and QUASAR could each perform characteristics
and forms type translation/verification.
14-Jul-86 GCO 10438 /JAD
2 Allow unique abbreviations for characteristics; invent new error code
ACT (Ambiguous Characteristics Type).
23-Jul-86 GCO 10445 /JAD
\; END OF COMMENT
SUBTTL Global Error Codes
DEFINE ERRORS,<
ERR CAC,<Can't access characteristics type file>
ERR CAF,<Can't access forms type file>
ERR UCT,<Unknown characteristics type>
ERR ACT,<Ambiguous characteristics type abbreviation>
ERR UFT,<Unknown forms type>
ERR IFC,<Illegal format in characteristics type>
>; END DEFINE ERRORS
DEFINE ERR(CODE,TEXT),<
IF1,<IFDEF CF'CODE'$,<PRINTX ?Multiply defined error 'CODE'>>
XP CF'CODE'$,ZZ
ZZ==ZZ+1
>; END DEFINE ERR
ZZ==1 ;START AT 1
ERRORS ;GENERATE ERROR CODES
SUBTTL Miscellaney
CHRLEN==4 ;LENGTH OF CHARACTERISTICS BITMAP
SUBTTL Characteristics and forms type list entry formats
.ORG 0
CT.COD:!BLOCK 1 ;CHARACTERISTICS TYPE VALUE (BINARY)
CT.NAM:!BLOCK CHRSIZ ;ASCII CHARACTERISTIC NAME
CT.SIZ:! ;SIZE OF AN ENTRY
.ORG
.ORG 0
FT.COD:!BLOCK 1 ;FORMS TYPE VALUE (BINARY)
FT.NAM:!BLOCK FRMSIZ ;ASCII FORMS NAME
FT.SIZ:! ;SIZE OF AN ENTRY
.ORG
SUBTTL Convert characteristics type
;Routine to convert the characteristics type to a bitmap.
;Call:
; S1/ Address of characteristics type string
;Return:
; FALSE if conversion failed with:
; S1/ Error code (CFxxx$)
; TRUE if conversion succeded with:
; S1/ Address of 4-word characteristics bitmap
CNVCHR::PUSHJ P,.SAVE1## ;SAVE P1
MOVE P1,S1 ;SAVE THE ADDRESS
TLNN P1,-1 ;LET THEM SPECIFY A BYTE POINTER
HRLI P1,(POINT 7) ;IT'S ASCII
MOVEI S1,CHRLEN ;LENGTH
MOVEI S2,CHRBUF ;ADDRESS
PUSHJ P,.ZCHNK ;MAKE SURE IT'S ZEROED
PUSHJ P,CHKCHR ;MAKE SURE WE HAVE A CURRENT FILE
JRST CNVC.3 ;CAN'T ACCESS FILE
ILDB S1,P1 ;GET FIRST BYTE
JUMPE S1,CNVC.X ;NOTHING TO CONVERT IF STARTS WITH NULL
CAIN S1,"(" ;MULTIPLE CHARACTERISTICS TYPES?
JRST CNVC.1 ;YES
MOVNI S1,1 ;BACK UP ONE BYTE
ADJBP S1,P1 ;ADJUST IT
MOVE P1,S1 ;RESET THE BYTE POINTER
PUSHJ P,FNDCHR ;HANDLE ONE FIELD
$RETF ;NO MATCH, RETURN ERROR FROM FNDCHR
PUSHJ P,CHRBIT ;SET THE APPROPRIATE BIT
LDB S1,P1 ;GET BREAK CHARACTER
JUMPN S1,CNVC.2 ;MUST BE NULL HERE
MOVEI S1,CHRBUF ;POINT AT THE BITMAP
$RETT ;SUCCESS RETURN
CNVC.1: PUSHJ P,FNDCHR ;HANDLE ONE
$RETF ;NO MATCH, RETURN ERROR FROM FNDCHR
PUSHJ P,CHRBIT ;SET THE APPROPRIATE BIT
LDB S1,P1 ;GET BREAK CHARACTER
CAIN S1,"," ;MORE TO COME?
JRST CNVC.1 ;YES
CAIE S1,")" ;ONLY OTHER LEGAL FIELD
JUMPN S1,CNVC.2 ;WELL, STILL ALLOW NUL
CNVC.X: MOVEI S1,CHRBUF ;POINT AT THE BITMAP
$RETT ;SUCCESS RETURN
CNVC.2: SKIPA S1,[CFIFC$] ;GET ERROR CODE
CNVC.3: MOVX S1,CFCAC$ ;GET ERROR CODE
$RETF ;RETURN AN ERROR
;Set the appropriate bit in CHRBUF based on the characteristics type
;code supplied in S1.
CHRBIT: PUSHJ P,.SAVET## ;FREE UP THE "T" AC'S
MOVE T1,S1 ;COPY HERE
IDIVI T1,^D32 ;DETERMINE WORD IN BITMAP AND INDEX IN BETTBL
MOVE T3,BETTBL(T2) ;GET THE -11 BIT
IORM T3,CHRBUF(T1) ;LIGHT IT
POPJ P, ;RETURN
;Table of funny PDP-11 style bits (blech)
BETTBL: ZZ==1B8
REPEAT 4,<
REPEAT 8,<EXP <ZZ==ZZ_1>>
ZZ==ZZ_-^D16
>
SUBTTL Find characteristics type
;Routine to find a matching characteristics type. Call with
;byte pointer to characteristics string in P1.
;Returns:
; SKIP with:
; S1/ Encoded characteristics value
; P1/ Updated byte pointer
; NON-SKIP if no match with:
; S1/ Error code (CFxxx$)
FNDCHR: MOVX S1,CHRSIZ ;LENGTH OF BUFFER
MOVEI S2,TMPBUF ;TEMPORARY TEXT BUFFER
PUSHJ P,.ZCHNK ;ZERO IT
$SAVE <T1,T2> ;SAVE THE ACS WE TRASH
MOVE T1,[POINT 7,TMPBUF] ;SET UP A BYTE POINTER
SETZ T2, ;NO MATCHES YET
FNDC.1: ILDB S1,P1 ;GET A BYTE
CAIL S1,"a" ;CONVERT LOWER CASE
CAILE S1,"z" ; TO UPPER
SKIPA ;NOT LOWER CASE
SUBI S1,"a"-"A" ;LOWER CASE, MAKE IT UPPER
CAIL S1,"A" ;SEE IF ALPHABETIC
CAILE S1,"Z" ;...
SKIPA ;NOPE
JRST FNDC.2 ;YES
CAIL S1,"0" ;CHECK DIGITS
CAILE S1,"9" ;...
SKIPA ;NOPE
JRST FNDC.2 ;YES
CAIE S1,"_" ;LAST ONE
JRST FNDC.3 ;END OF THIS STRING
FNDC.2: IDPB S1,T1 ;STUFF THE CHARACTER
JRST FNDC.1 ;KEEP CHECKING
FNDC.3: MOVE S1,CHRLST ;GET THE LIST HANDLE
$CALL L%FIRST ;POSITION TO FIRST ENTRY
FNDC.4: JUMPF FNDC.7 ;RETURN IF AT END
MOVE T1,S2 ;POINT AT THE ENTRY
HRROI S1,TMPBUF ;ADDRESS OF TEST STRING
HRROI S2,CT.NAM(T1) ;ADDRESS OF BASE STRING
PUSHJ P,S%SCMP ;COMPARE THEM
JUMPF FNDC.6 ;NO MATCH
JUMPE S1,FNDC.5 ;GO IF EXACT MATCH
TXNN S1,SC%SUB ;TEST STRING A SUBSET OF BASE STRING?
JRST FNDC.6 ;NO
JUMPN T2,FNDC.8 ;GO IF MULTIPLE MATCHES (AMBIGUOUS)
MOVE T2,T1 ;SAVE THE POINTER TO THE ABBREVIATION
JRST FNDC.6 ;TRY FOR OTHERS
FNDC.5: MOVE S1,CT.COD(T1) ;GET THE CODE
JRST .POPJ1 ;SKIP RETURN
FNDC.6: MOVE S1,CHRLST ;GET THE LIST HANDLE
$CALL L%NEXT ;POSITION TO NEXT ENTRY
JRST FNDC.4 ;LOOP FOR MORE
FNDC.7: SKIPE T1,T2 ;DID WE FIND A UNIQUE ABBREVIATION?
JRST FNDC.5 ;YES, RETURN THAT
SKIPA S1,[CFUCT$] ;NO, UNKNOWN CHARACTERISTICS TYPE
FNDC.8: MOVX S1,CFACT$ ;AMBIGUOUS CHARACTERISTICS TYPE
POPJ P, ;RETURN
SUBTTL Convert long forms name
;Routine to convert the long forms name to a binary code.
;Call:
; S1/ Address of forms name string
;Return:
; FALSE if conversion failed with:
; S1/ Error code (CFxxx$)
; TRUE if conversion succeded with:
; S1/ Encoded binary value
CNVFRM::PUSHJ P,.SAVE1## ;SAVE P1
MOVE P1,S1 ;SAVE THE ADDRESS
TLNN P1,-1 ;LET THEM SPECIFY A BYTE POINTER
HRLI P1,(POINT 7) ;IT'S ASCII
PUSHJ P,CHKFRM ;MAKE SURE WE HAVE A CURRENT FILE
JRST CNVF.1 ;CAN'T ACCESS FILE
PUSHJ P,FNDFRM ;FIND FORMS TYPE, RETURN CODE IN S1
JRST CNVF.2 ;UNKNOWN
$RETT ;SUCCESS
CNVF.1: SKIPA S1,[CFCAF$] ;GET ERROR CODE AND SKIP
CNVF.2: MOVX S1,CFUFT$ ;GET ERROR CODE
$RETF ;RETURN AN ERROR
SUBTTL Find forms type
;Routine to find a forms type matching that of the current request.
;Call:
; P1/ Address of forms type string
;Returns:
; SKIP with:
; S1/ Encoded forms value
; NON-SKIP if no match
FNDFRM: $SAVE <T1> ;SAVE AN AC TO TRASH
MOVE S1,FRMLST ;GET THE LIST HANDLE
$CALL L%FIRST ;POSITION TO FIRST ENTRY
FNDF.1: JUMPF .POPJ ;RETURN IF NO MATCH
MOVE T1,S2 ;POINT AT THE ENTRY
HRROI S1,FT.NAM(T1) ;ADDRESS OF STRING
MOVE S2,P1 ;COPY POINTER TO FORMS TYPE STRING
$CALL S%SCMP ;COMPARE THE STRINGS
JUMPN S1,FNDF.2 ;ONLY ALLOW EXACT MATCH
MOVE S1,FT.COD(T1) ;GET FORMS TYPE
JRST .POPJ1 ;SKIP RETURN
FNDF.2: MOVE S1,FRMLST ;GET THE LIST HANDLE
$CALL L%NEXT ;POSITION TO NEXT ENTRY
JRST FNDF.1 ;LOOP FOR MORE
SUBTTL Check characteristics type list
;Routine to check that the characteristics type list is current. If the
;file is newer than our last glance we will build a new list.
;Return:
; SKIP if successful (list exists)
; NON-SKIP if error (no list exists)
CHKCHR: MOVEI S1,CHRFD ;GET ADDRESS OF FD
MOVEM S1,FTYFOB+FOB.FD
MOVEI S1,FOB.SZ ;SIZE OF FILE OPEN BLOCK
MOVEI S2,FTYFOB ;ADDRESS OF IT
$CALL F%IOPN ;OPEN FOR INPUT
JUMPF CHKC.2 ;CAN'T ACCESS FILE
AOS (P) ;SUCCESS FROM THIS POINT ON
MOVEM S1,FCFIFN ;SAVE IFN FOR LATER
MOVX S2,FI.CRE ;NEED CREATION DATE/TIME
$CALL F%INFO ;ASK FOR FILE INFO
CAMN S1,CHRUDT ;FILE CHANGED?
PJRST RELFCF ;NO, RELEASE FILE AND RETURN
MOVEM S1,CHRUDT ;UPDATE THE CREATION DATE/TIME
SKIPE S1,CHRLST ;GET LIST HANDLE OF EXISTING LIST
$CALL L%DLST ;DELETE THE LIST
$CALL L%CLST ;CREATE A NEW LIST
MOVEM S1,CHRLST ;SAVE IT'S HANDLE
$SAVE <T1> ;SAVE THE AC WE TRASH
CHKC.1: PUSHJ P,REDFCF ;READ A CHARACTERISTICS TYPE FROM THE FILE
JRST RELFCF ;END OF FILE
MOVE T1,S1 ;SAVE THE CHARACTERISTICS VALUE
MOVE S1,CHRLST ;GET LIST HANDLE
MOVEI S2,CT.SIZ ;LENGTH OF AN ENTRY
$CALL L%CENT ;CREATE THE ENTRY
JUMPF S..CCE ;GO IF ERROR
MOVEM T1,CT.COD(S2) ;SAVE CHARACTERISTICS CODE
MOVSI T1,FCFTMP ;FROM HERE
HRRI T1,CT.NAM(S2) ;TO HERE
BLT T1,CT.NAM+CHRSIZ-1(S2) ;COPY CHARACTERISTICS TYPE
JRST CHKC.1 ;LOOP FOR MORE
CHKC.2: $WTO (<Cannot access characteristics type file ^F/FTYFD/>,,,<$WTFLG(WT.SJI)>)
$RETF ;ERROR
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:
; SKIP if successful (list exists)
; NON-SKIP if error (no list exists)
CHKFRM: MOVEI S1,FTYFD ;GET ADDRESS OF FD
MOVEM S1,FTYFOB+FOB.FD
MOVEI S1,FOB.SZ ;SIZE OF FILE OPEN BLOCK
MOVEI S2,FTYFOB ;ADDRESS OF IT
$CALL F%IOPN ;OPEN FOR INPUT
JUMPF CHKF.2 ;CAN'T ACCESS FILE
AOS (P) ;SUCCESS FROM THIS POINT ON
MOVEM S1,FCFIFN ;SAVE IFN FOR LATER
MOVX S2,FI.CRE ;NEED CREATION DATE/TIME
$CALL F%INFO ;ASK FOR FILE INFO
CAMN S1,FRMUDT ;FILE CHANGED?
PJRST RELFCF ;NO, RELEASE FILE AND RETURN
MOVEM S1,FRMUDT ;UPDATE THE CREATION DATE/TIME
SKIPE S1,FRMLST ;GET LIST HANDLE OF EXISTING LIST
$CALL L%DLST ;DELETE THE LIST
$CALL L%CLST ;CREATE A NEW LIST
MOVEM S1,FRMLST ;SAVE IT'S HANDLE
$SAVE <T1> ;SAVE THE AC WE TRASH
CHKF.1: PUSHJ P,REDFCF ;READ A FORMS TYPE FROM THE FILE
JRST RELFCF ;END OF FILE
MOVE T1,S1 ;SAVE THE FORMS VALUE
MOVE S1,FRMLST ;GET LIST HANDLE
MOVEI S2,FT.SIZ ;LENGTH OF AN ENTRY
$CALL L%CENT ;CREATE THE ENTRY
SKIPT ;DID IT SUCCEED?
PUSHJ P,S..CCE## ;NO
MOVEM T1,FT.COD(S2) ;SAVE ENCODED NAME
MOVSI T1,FCFTMP ;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.2: $WTO (<Cannot access forms type file ^F/FTYFD/>,,,<$WTFLG(WT.SJI)>)
$RETF ;RETURN
SUBTTL Release forms/characteristics file
;Routine to release the forms/characteristics file if it is opne.
RELFCF: SKIPE S1,FCFIFN ;GET IFN, SKIP IF NOT OPEN
$CALL F%REL ;RELEASE THE FILE
SETZM FCFIFN ;FORGET ABOUT IT
$RETT ;RETURN
SUBTTL Read a line from forms/characteristics type file
;Routine to read one line from the forms/characteristics type file.
;Return:
; SKIP with:
; S1/ Encoded value
; FCFTMP/ ASCIZ name
; NON-SKIP if format error, EOF, etc.
REDFCF: MOVEI S1,FRMSIZ ;SIZE OF AREA
MOVEI S2,FCFTMP ;ADDRESS
$CALL .ZCHNK ;ZERO IT
$SAVE <T1> ;WE STEP ON THIS AC
REDF.0: MOVE S1,FCFIFN ;GET THE IFN
$CALL F%IBYT ;GET FIRST CHARACTER
JUMPF .POPJ ;SHOULDN'T BE EOF HERE
CAXE S2,"%" ;THE SPECIAL CHARACTER?
JRST [PUSHJ P,REDF.X ;SKIP THIS LINE
POPJ P, ;EOF?
JRST REDF.0] ;TRY AGAIN
$CALL F%IBYT ;GET NEXT BYTE
JUMPF .POPJ ;SHOULDN'T BE EOF HERE
CAXE S2,.CHTAB ;TAB?
CAXN S2," " ;SPACE?
JRST .-4 ;KEEP LOOKING FOR START OF FORMS NAME
MOVX T2,<FRMSIZ*5>-1 ;MAXIMUM NUMBER OF BYTES
SKIPA T1,[POINT 7,FCFTMP] ;POINTER TO STORE IT
REDF.1: $CALL F%IBYT ;GET NEXT INPUT BYTE
JUMPF .POPJ ;SHOULDN'T BE EOF HERE
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
JUMPF .POPJ ;SHOULDN'T BE EOF HERE
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
JUMPF .POPJ ;SHOULDN'T BE EOF HERE
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
JFCL ;EOF?
MOVE S1,T1 ;RETURN FORMS NUMBER IN S1
JRST .POPJ1 ;ALL DONE
REDF.X: $CALL F%IBYT ;GET A BYTE
JUMPF .POPJ ;EOF
CAXE S2,.CHLFD ;END OF LINE FEED?
JRST REDF.X ;NO, KEEP LOOKING
JRST .POPJ1 ;SKIP RETURN
SUBTTL Error Text Generation
DEFINE ERR(CODE,TEXT),<
''CODE'',,[ASCIZ |TEXT|]
>; END DEFINE ERR
CFERRT::0 ;NO ERROR 0
ERRORS ;GENERATE THE ERROR TEXT TABLE
SUBTTL File spec blocks and data storage
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
CHRFD: $BUILD (FDMSIZ) ;SHORT FILESPEC BLOCK
$SET (.FDLEN,FD.LEN,FDMSIZ) ;LENGTH
$SET (.FDSTR,,'SYS ') ;DEVICE
$SET (.FDNAM,,'CHARTY') ;NAME
$SET (.FDEXT,,'DAT ') ;EXTENSION
$EOB
FTYFOB: $BUILD (FOB.SZ) ;FILE OPEN BLOCK
$SET (FOB.CW,FB.BSZ,7) ;BYTE SIZE (ASCII)
$EOB
FCFIFN: BLOCK 1 ;IFN FOR FORMS/CHAR TYPE FILE
FCFTMP: BLOCK FRMSIZ ;TEMPORARY STORAGE FOR FORMS/CHAR NAME
FRMUDT: BLOCK 1 ;CREATION DATE/TIME OF FORMS TYPE FILE
CHRUDT: BLOCK 1 ;DITTO FOR CHARACTERISTICS FILE
FRMLST: BLOCK 1 ;LIST NAME FOR FORMS TYPE LIST
CHRLST: BLOCK 1 ;DITTO FOR CHARACTERISTICS FILE
CHRBUF: BLOCK CHRLEN ;CHARACTERISTICS BITMAP BUILT HERE
TMPBUF: BLOCK 30 ;TEMPORARY BUFFER
END ;THE END