Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/getitm.mac
There are 21 other files named getitm.mac in the archive. Click here to see a list.
; UPD ID= 3571 on 6/9/81 at 11:53 AM by NIXON
TITLE GETITM FOR COBOL V12C
SUBTTL GET NEXT SOURCE WORD AL BLACKINGTON/CAM/SEB/DMN
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;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.
SEARCH P,UUOSYM
%%P==:%%P
MCS==:MCS
TCS==:TCS
DBMS==:DBMS
ENTRY GETITM ;GET NEXT WORD A DETERMINE TYPE
ENTRY GETKAR ;GET NEXT CHARACTER FOR A WORD OR NUMERIC LITERAL.
ENTRY GETCH ;GET NEXT CHARACTER FOR A NON-NUMERIC LITERAL.
ENTRY GETFCH ;GET VERY FIRST CHARACTER IN THE SOURCE FILE.
ENTRY GETWRD ;GET NEXT WORD OR LITERAL FROM SOURCE
ENTRY FINSKP ;COMPLETE SKIPPING OF PARAGRAPH
ENTRY SKPSRC ;READ ONE SOURCE CHARACTER
ENTRY PUTCRF ;PUT ITEM INTO CREF FILE
INTERN GETSRC ;[702]
INTERN GETLB9 ;[1023]
INTERN SKPPGF,END2
IFN ANS74,<
INTERN FLG.LI,FLG.HI,FLG.H,FLG.NS ;FIPS FLAGGER ROUTINES
>
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
;EDITS
;NAME DATE COMMENTS
;V12B***************
;JEH 10-APR-84 [1521] Allow [P,PN]'s and DEV:'s in COPY statements
;JEH 19-MAR-84 [1517] Fix splitting of line with copy replacing
;JEH 17-NOV-83 [1505] 68274: If '**** End of copy library text ****'
; inserted and 'COPY' follows, 68274 halts.
;JBB 11-NOV-83 [1504] Put conditional code around FINVOK so a build
; without DBMS doesn't fail.
;DMN 22-Apr-83 [1463] Fix COPY REPLACING when BY and == are not on same line.
;SMI 04-Mar-83 [1455] 68274 Fix conversion of statement after NOTE.
;SMI 04-Mar-83 [1454] 68274 Fix backup over period.
;DMN 10-Dec-82 [1445] 68274 removes period if last clause is turned into a comment.
;DMN 9-Dec-82 [1444] 68274 does not correctly convert /S format when comment column exists.
;DMN 7-Dec-82 [1440] COPY REPLACING loses terminal period if replacing a numeric literal.
;SMI 26-Oct-82 [1426] 68274 Make TALLY a COMP field.
;SMI 08-Oct-82 [1415] Generate statement before current line
; for 68274 converter.
;SMI 06-Oct-82 [1413] 68274 Does not handle DBMS correctly.
;SMI 17-SEP-82 [1406] COPY REPLACING doesn't work if continued in
; A margin.
;RLF 02-JUL-82 [1372] COPY REPLACING doesn't know == are
; missing after BY for pseudo-text.
;DMN 03-Jun-82 [1361] 68274 does not handle case of no CVT wanted.
;DMN 27-May-82 [1360] 68274 does not handle COPY REPLACING
; correctly.
;DMN 26-May-82 [1357] 68274 Converter gets wrong line buffer to
; use when replacing words.
;DMN 05-MAR-82 [1343] 68274 Converter does not convert NOTE into
; a comment
;RJD 23-Feb-82 [1342] Handle D in continuation column when
; scanning for end of literal
;JSM 1-Oct-81 [1316] Copy Repl gives spurious Fatal when Comment
; followed by Paragraph Name
;WTK 30-SEP-81 [1314] CONTIN. CHAR AFTER "(" GIVES BAD SUBSCRIPT
;PV/JM 24-SEP-81 [1310] Compiler forgets first of two LIB devices.
;DMN 13-JUL-81 [1304] 68274 Converter fails if very first word in a
; library has to be replaced by COBOL-74 syntax.
;V12A****************
;JSM 14-Apr-81 [1125] *** NOT INCLUDED, HAS BAD SIDE EFFECTS ***
; COPY REPLACING gives spurious warnings when numeric replacement
; precedes end of statement in DATA DIVISION.
;JEH 04-Mar-81 [1122] Save AC6 when opening second source file.
;JSM 24-Oct-80 [1065] With COPY REPLACING, check for end of library member.
;JSM 24-Oct-80 [1064] With COPY REPLACING don't split a line if the
; only input characters left are "." and line-feed.
;JSM 24-Oct-80 [1063] Special handling for paragraph names and
; 01 level numbers with COPY REPLACING.
;DAW 18-JUL-80 [1036] FIX PRINTING OF SPECIAL CHARS IN THE LISTING
;DMN 29-MAY-80 [1023] FIX VARIOUS PROBLEMS WITH PICTURES IN COPY REPLACING.
;DMN 20-MAY-80 [1022] FIX PROBLEM OF MISSING CHARACTER ON LISTING FILE IN COPY REPLACING.
;DMN 13-MAY-80 [1020] FIX LINE TOO LONG PROBLEM IN COPY REPLACING.
;DMN 25-APR-80 [1015] USE THE CORRECT RIGHT MARGIN ON COPY REPLACING.
;DMN 22-APR-80 [1013] FIX LOOP IF MISSING == ON COPY REPLACING.
;DMN 26-MAR-80 [1001] MAKE ALL "LITERAL" WORK IN COPY REPLACING.
;V12*****************
;DMN 21-AUG-79 [726] FIX COPY REPLACING WHEN MULTIPLE OF SIX CHARS.
;DMN 30-APR-79 [704] FIX MULTIPLE COPY REPLACING ORDERING BUG.
;DMN 30-APR-79 [702] MAKE GETSRC A GLOBAL SYMBOL FOR DATE-COMPILED.
;DMN 9-MAR-79 [657] FIX PROBLEM WITH LOOKAHEAD IN COPY REPLACING INTEGER.
;DMN 6-MAR-79 [655] CHECK FOR PREMATURE EOF ON LIBRARY FILE
;DMN 18-DEC-78 [620] STORE SEQ. NO. CORRECTLY FOR DATE-COMPILED PARAGRAPH.
;DMN 15-DEC-78 [617] *** NOT USED ***
;DMN 9-NOV-78 [***] FIX INFINITE LOOP IF TERMINAL == IS IN A-MARGIN
;DMN 19-SEP-78 [557] FIX VARIOUS COPY REPLACING BUGS
;V11*****************
;DMN REWROTE COPY VERB
;V10*****************
;EHM 10-JAN-77 [526] IGNORE EDITS PAGE MARKS SO CONTINUATION WORKS
;EHM 02-JUN-77 [477] DO BETTER RECOVERY WHEN LIBARY NOT FOUND
;MDL 20-APR-77 [470] BE MORE AWARE WHEN "DECIMAL-POINT IS COMMA"
;DPL 09-DEC-76 [453] MAKE /S WORK FOR DBMS
;SSC 3-5-75 PUT 6A EDIT %316 DIRECTLY INTO V10
;********************
; EDIT 367 FIX THE MISSING OF LISTING OF ".", "," OR ";" THAT IS IN A LIBARY
; EDIT 364 DBMS FIX - MAKE ONLY ONE CALL TO DBGETF BECAUSE ONLY ONE
; INVOKE STATEMENT ALLOWED.
; EDIT 354 FIX TO HANDLE SOURCE CHAR COUNTER.
; EDIT 352 "I/O TO UNASSIGN " PROBLEM WHILE ATTEMPTING TO READ LIBRARY
; FILE IF "COPY" IS LAST COBOL STATEMENT IN SOURCE FILE.
; EDIT 323 ALLOW "ALL" TO BE USED AS A DEVICE IN A "SELECT" STATEMENT
; EDIT 275 RECOVER PROPERLY UPON RETURN FROM LIBARY FILE
; EDIT 213 DO NOT ALLOW COPY WITHIN A LIBARY; IF LITERAL TOO LONG, GIVE ERROR MSG ONLY ONCE
; EDIT 156 FIXES COMMENT PROBLEM ON FIRST LINE OF A LIBRARY INPUT
; EDIT 150 RESET SEARCH SWITCH WASERC FOR SAVED ITEM
GETITM: TSWF FPERWD ;GET PERIOD AND LAST WORD?
JRST [PUSHJ PP,GETWRD ;YES, GET PERIOD
JRST GITM1A] ;BUT DON'T CHECK FOR REPLACING
TSWF FREGWD ;NO--REGET PREVIOUS WORD?
JRST GETWRD ;YES--DO SO, AND RETURN
SKIPE W2,SAVEWD+1 ;ANYTHING SAVED?
JRST GITM20 ;YES
PUSHJ PP,GETWRD ;GET NEXT WORD
GITM1C: TSWF FRLIB ;[557] READING FROM LIBRARY?
TSWF FCOPY ;YES, BUT REPLACING?
JRST GITM1A ;NO
SKIPE RPLCNT ;ANY REPLACEMENTS?
JRST RPLTST ;YES, SEE IF THIS IS ONE
GITM1A: TLNN W1,GWLIT ;LITERAL?
TLNN W1,GWRESV ;NO--RESERVED WORD?
JRST GTITM3 ;NO
LDB CT,GWVAL ;YES--FIGURATIVE CONSTANT?
CAIL CT,700
CAILE CT,707
JRST GTITM2 ;NO
CAIN CT,ALL. ;MAYBE--"ALL"?
JRST GITM30 ;YES
IFN ANS74,<
SKIPE FLGSW ;FIPS FLAGGER?
PUSHJ PP,GITM3B ;YES, SEE IF LEGAL FIG-CON
>
IFN ANS68,<
CAIN CT,TALLY ;NO--TALLY?
JRST GTITM5 ;YES
>
IFN FT68274,<
CAIN CT,TODAY
EWARNW E.775
>
MOVEI CT,FIGCN. ;IT IS A FIGURATIVE CONSTANT
TLO W1,GWFIGC
GTITM2: SETZM WASERC ;ASSUME IT WAS NOT 'SEARCH'
CAIN CT,SEARC. ;IS IT 'SEARCH'?
SETOM WASERC ;YES--SET FLAG
LDB TE,GWCP ;GET CHARACTER POSITION
SKIPN AMARFL ;[1316] FLAG ON FOR COPY REPL "LF" KLUDGE?
;[1316] TELL SQURL. USER-NAME IS IN A-MARGIN
CAIGE TE,^D12 ;IN A-MARGIN?
IORI CT,AMRGN. ;YES--SET FLAG
SETZM AMARFL ;[1316] TURN OFF FLAG FOR COPY REPL "LF" KLUDGE
MOVEM CT,ITEMCT
CAIE CT,COPY. ; [213] "COPY" ?
CAIN CT,COPY.+AMRGN. ; [213] POSSIBLY WITHIN A-MARGIN
CAIA ; [213] YES
POPJ PP, ;RETURN
TSWT FRLIB ; [213] ARE WE WITHN A LIBARY ROUTINE?
JRST CPYLIB ;GO HANDLE COPY
MOVEI DW,E.492 ; [213] COPY WITHIN A LIBARY ILLEGAL
PUSHJ PP,FATAL ; [213]
GITM2B: PUSHJ PP,GETWRD ; [213] GET NEXT WORD
HLRZM W1,TA ; [213] MOVE FOR TESTING
CAIE TA,PERWD ; [213] IF PERIOD
CAIN TA,ENDIT ; [213] OR END OF SOURCE
JRST GITM1A ; [213] DONE-GO ON
TSWT FCOPY!FRLIB ; [213] OR IF NO LONGER IN LIBARY
JRST GITM1A ; [213] DONE- GO ON
JRST GITM2B ; [213] KEEP SEARCHING
;NOT A RESERVED WORD
GTITM3: TLNE W1,GWLIT ;IS IT A LITERAL?
JRST GITM10 ;YES
SKIPE CREFSW ;IF WE ARE CREFFING,
PUSHJ PP,PTCRF0 ; WRITE OUT CREF ITEM
TLNE W1,GWNOT ;NO--IN NAMTAB?
JRST GITM3A ;NO
HRRZ CT,(TA) ;YES
JUMPN CT,GTITM4 ;DEFINED?
GITM3A:
IFN ANS74,<
SKIPE FLGSW ;FIPS FLAGGER?
PUSHJ PP,[LDB CT,[POINT 6,NAMWRD,5] ;YES, GET FIRST CHAR. OF NAME
CAIL CT,'A' ;SEE IF ALPHABETIC
CAILE CT,'Z'
PUSHJ PP,FLG.HI ;NO, FLAG IT
POPJ PP,]
>
MOVEI CT,USERN. ;NO
JRST GTITM2 ;RETURN
IFN ANS74,<
GITM3B: PUSH PP,CH ;GET AN ACC
MOVE CH,NAMWRD ;GET ACTUAL NAME
CAME CH,[SIXBIT /ZERO/]
CAMN CH,[SIXBIT /SPACE/]
JRST GITM3D ;THESE ARE LOW LEVEL
CAMN CH,[SIXBIT /QUOTE/]
JRST GITM3D ;SO IS THIS
CAME CH,[SIXBIT /HIGH-V/]
CAMN CH,[SIXBIT /LOW-VA/]
SKIPA CH,NAMWRD+1 ;THESE ARE POSSIBLE
JRST GITM3C ;NOTHING ELSE IS
CAME CH,[SIXBIT /ALUE/]
CAMN CH,[SIXBIT /LUE/]
JRST GITM3D ;THESE ARE LOW LEVEL
GITM3C: PUSHJ PP,FLG.HI ;WARN USER
GITM3D: POP PP,CH
POPJ PP,
>
;IT IS A DEFINED USER WORD
GTITM4: PUSH PP,TA
IFN ANS74,<
SKIPE FLGSW ;FIPS FLAGGER?
PUSHJ PP,[LDB CT,[POINT 6,NAMWRD,5] ;YES, GET FIRST CHAR. OF NAME
CAIL CT,'A' ;SEE IF ALPHABETIC
CAILE CT,'Z'
PUSHJ PP,FLG.HI ;NO, FLAG IT
POPJ PP,]
>
MOVE TA,0(TA) ;GET TABLE LINK
LDB CT,[POINT 3,TA,20] ;GET CODE
EXCH DT,0(PP) ;SAVE DT, DT_NAMTAB ADDRESS
JUMPE CT,GITM12 ;IF CODE ZERO, SPECIAL
PUSHJ PP,LNKSET ;GET TABLE ADDRESS INTO TA
GITM4B: EXCH TA,DT ;DT_TABLE ADDRESS, TA_NAMTAB ADDRESS
MOVE CT,CODTAB(CT)
CAIN CT,DATAN. ;DATAB?
JRST GITM4A ;YES
CAIN CT,MNEMO. ;NO--MNEMONIC?
JRST GTITM9 ;YES
GITM4A: POP PP,DT ;RESTORE DT
JRST GTITM2 ;RETURN
IFN ANS68,<;TALLY
GTITM5: MOVEI CT,DATAN. ;PRETEND IT'S A DATA-NAME
TLO W1,GWFIGC ;BUT TURN ON "FIG. CONST." ANYWAY
IFN FT68274,<
SETZM CVTTLY## ;SIGNAL TALLY IS REQUIRED
>
JRST GTITM2
>
;CODE TABLE FOR USER NAMES
CODTAB: FILEN. ;FILTAB
DATAN. ;DATAB
CONDI. ;CONTAB
0 ;INVALID
PRONM. ;PROTAB
EXTNA. ;EXTAB
0 ;INVALID
MNEMO. ;MNETAB
;MNEMONIC NAME
GTITM9: MOVE TE,1(DT) ;DEVICE-NAME?
TLNN TE,MTCONS
MOVEI CT,SPECN. ;NO
JRST GITM4A ;RETURN
;IT IS A LITERAL
GITM10: TLNE W1,GWNLIT ;NUMERIC?
JRST GITM11 ;YES
MOVEI CT,LITER. ;NO
JRST GTITM2
GITM11: MOVEI CT,INTGR.
TLNE W1,GWDP ;DECIMAL-POINT?
AOJA CT,GTITM2 ;YES
JRST GTITM2 ;NO--INTEGER
;ITEM IS CODE ZERO.
;IT IS EITHER A FILE-NAME OR A REPORT-NAME.
GITM12: MOVE TE,FILNXT ;GET SIZE OF
SUB TE,FILLOC ; FILTAB
CAILE TA,(TE) ;IS ITEM WITHIN FILTAB?
JRST GITM13 ;NO
ADD TA,FILLOC ;MAYBE--GET ABSOLUTE ADDRESS
LDB TE,[POINT 15,0(TA),17]; GET FILTAB'S NAMTAB LINK
HLRZ TD,DT ;GET RELATIVE NAMTAB ADDRESS
CAIN TE,(TD) ;IS IT SAME AS THIS ONE?
JRST GITM4B ;YES
GITM13:
IFN MCS!TCS,<
MOVE TA,(DT) ;GET TABLE LINK FROM NAMTAB
MOVE TE,CDNXT
SUB TE,CDLOC ;IS THIS WITHIN CDTAB?
CAILE TA,(TE)
JRST GTM13A ;NO
ADD TA,CDLOC
LDB TE,[POINT 15,0(TA),17]
HLRZ TD,DT
CAIN TE,(TD)
SKIPA CT,[CDNAM.] ;CD-NAME CODE
GTM13A:>
MOVEI CT,RPNAM. ;REPORT-NAME CODE
MOVE TA,DT ;TA_NAMTAB ADDRESS
JRST GITM4A
;SOMETHING WAS SAVED AT A PREVIOUS TIME, BY "FPERWD".
GITM20: MOVE W1,SAVEWD
MOVE CT,SAVEWD+2
MOVEM CT,ITEMCT
SETZM SAVEWD+1
LDB CP,GWCP
LDB LN,GWLN
TSWF FEOF ;END OF SOURCE?
JRST GITM21 ;YES
TLNE W1,GWLIT ;WAS IT A LITERAL?
POPJ PP, ;YES
TLZ W1,GWNOT ;NO--GO LOOK IN NAMTAB
PUSHJ PP,TRYNAM
TLOA W1,GWNOT
HRR W1,0(TA)
TRZ CT,AMRGN. ;[150] RESET A-MARGIN SW
JRST GTITM2 ;CHECK FOR SEARCH AND POSSIBLY RESET A-MARGIN SWITCH
GITM21: MOVSI W1,ENDIT ;RETURN AN "END OF PROG"
LDB CT,GWVAL
POPJ PP,
;THE WORD "ALL" WAS SEEN
GITM30: MOVE TA,PHASEN ; [323] GET CURRENT PHASE
CAIN TA,"B" ; [323] IF IN PHASE B (ENV DIVISION)
JRST GTITM2 ; [323] ALLOW IT- WE MAY BE IN SELECT
SKIPE WASERC ;WAS PREVIOUS WORD 'SEARCH'?
JRST GTITM2 ;YES--THEN NO LITERAL IS COMING
HRRZ TA,OPRTR+1 ;GET OPRTR CODE
IFN DBMS,<
CAIN TA,46 ; USING OPERATOR?
JRST GTITM2 ;YES, "ALL" IS OK HERE
CAIE TA,63 ;IS IT OPEN OR CLOSE?
CAIN TA,62
JRST GTITM2 ;YES, "ALL" IS OK HERE.
CAIN TA,122 ;"DELETE" COMMAND IS OK TOO.
JRST GTITM2
>
CAIN TA,UDELIM ;ALSO IN "UNSTRING"
JRST GTITM2
IFN ANS74,<
CAIN TA,66 ;ALSO USE FOR DEBUGGING IS OK
JRST GTITM2
SKIPE FLGSW ;FIPS FLAGGER?
CAIN TA,42 ;YES, BUT NOT FOR INSPECT
CAIA
PUSHJ PP,GITM3B ;FLAG ALL AS ILLEGAL
>
;[1001] ENTER HERE FROM COPY REPLACING TEST IF "ALL FLAG" IS ON
GITM34: PUSHJ PP,GETWRD ;[1001] GET NEXT WORD
TLNN W1,GWLIT ;LITERAL?
TLNN W1,GWRESV ;NO--IS NEW WORD RESERVED?
JRST GITM35 ;NO
LDB CT,GWVAL ;IS NEW WORD A FIG. CONST.?
CAIL CT,700
CAILE CT,707
JRST GITM33 ;NO--ERROR
CAIN CT,ALL. ;MAYBE--"ALL" AGAIN?
JRST GITM33 ;YES--ERROR
MOVEI CT,FIGCN. ;NO--IT IS A FIG. CONST.
TLOA W1,GWFIGC!GWALL ;[557]
GITM35: TLO W1,GWALL ;[557] NO--SET "ALL" FLAG
JRST GITM1C ;[557] RETURN TO SET UP "CT" AND CHECK REPLACING
;ERROR WITH "ALL"
GITM33: MOVEI DW,E.273
PUSHJ PP,FATAL
JRST GITM1A
;PUT ITEM ONTO CREF FILE
PUTCRF: SKIPN CREFSW ;IF NO CREF FILE,
POPJ PP, ; FORGET IT
PTCRF0: MOVE TE,[POINT 6,NAMWRD]
PTCRF1: MOVE TD,[POINT 6,CH]
PTCRF2: ILDB TC,TE
CAIN TC,':'
MOVEI TC,'-'
CAIN TC,';'
MOVEI TC,'.'
IDPB TC,TD
TLNE TD,770000
JRST PTCRF2
SOSG CRFBHO+2
PUSHJ PP,PTCRF9
IDPB CH,CRFBHO+1
CAME TE,[POINT 6,NAMWRD+4,35]
JRST PTCRF1
MOVE CH,W2
TLZ CH,377774
SOSG CRFBHO+2
PUSHJ PP,PTCRF9
IDPB CH,CRFBHO+1
POPJ PP,
PTCRF9: OUT CRF,
POPJ PP,
MOVEI CH,CRFDEV
JRST DEVDED
;SCAN THE NEXT WORD.
;SET UP WORD DESCRIPTORS.
GETWRD: SETZM SAVECH
TSWFZ FPERWD; ;RETURN A PERIOD AND A WORD?
JRST TESTWD ;YES
TSWFZ FREGWD; ;NO--RETURN SAME WORD?
JRST REGWRD ;YES
TSWFZ FGTPER; ;RETURN A PERIOD?
JRST SETPER ;YES
TSWFZ FGTMIN; ;NO--RETURN A "-"?
JRST SETMIN ;YES
SETZM SAVEWD+1 ;INSURE NOTHING SAVED
SETZM NAMWRD ;CLEAR NAMWRD
MOVE TA,[XWD NAMWRD,NAMWRD+1]
BLT TA,NAMWRD+4
TSWF FRTST ;SEARCHING FOR REPLACEMENT TEXT
SETZM L2BH0 ;YES, CLEAR SO WE KNOW IF GETKAR SAVED LAST BLANK
SETZM R3BH0 ;...
SWOFF FLETTR!FALIT ;TURN OFF "ALPHA" FLAGS
IFN FT68274,<
SETZM CVTRWM ;THIS IS A NEW WORD NOW
>
JRST GTWD1B
;SCAN THE NEXT WORD (CONT'D).
;INITIALIZE.
GETWD1: TSWTZ FNEEDS ;TURN OFF "SPACE NEEDED"
JRST GTWD1B
IFN BIS,<
DMOVEM LN,SAVBLN
>
IFE BIS,<
MOVEM LN,SAVBLN
MOVEM CP,SAVBCP
>
GTWD1B: TSWF FEOF; ;END-OF-FILE?
JRST SETEND ;YES
TSWFZ FECOPY ;ANY LIBRARY TO FINISH UP?
PUSHJ PP,ENDCPY ;YES--DO SO
GTWD1Z: PUSHJ PP,GETCH ;[1314] GET NEXT CHARACTER
CAIE CH,"-" ;[1314] MAKE SURE WE ARE NOT
JRST GTWD1Y ;[1314] LOOKING AT A
CAIN CP,7 ;[1314] CONTINUATION CHARACTER
JRST GTWD1Z ;[1314]
GTWD1Y: TSWF FRTST ;[557] JUST DOING REPLACEMENT TEST?
JRST [SKIPGE LIBBH+2 ;[557] YES, BUT IS LIBRARY DONE?
POPJ PP, ;[557] YES, JUST GIVE UP
JRST .+1] ;[557] NO
CAIE CH," "
CAIN CH,$HT
JRST GETWD1
IFN BIS,<
DMOVEM LN,WORDLN
>
IFE BIS,<
MOVEM LN,WORDLN
MOVEM CP,WORDCP
>
SWOFF FNEEDS;
MOVE TE,SAVBLN
JUMPE TE,GTWD1C
MOVEM TE,BLNKLN
MOVE TE,SAVBCP
MOVEM TE,BLNKCP
GTWD1C: MOVE CT,INPTCP
MOVEM CT,INPTST
SETZB CT,LC ;CLEAR COUNTERS
SETZM SAVBLN
IFN BIS,<
DMOVE PB,[POINT 7,LITVAL
POINT 6,NAMWRD]
>
IFE BIS,<
MOVE PB,[POINT 7,LITVAL]
MOVE PA,[POINT 6,NAMWRD]
>
SETZB W1,W2
SETZM NOCONT ;SET "CONTINUATIONS LEGAL" INDICATION
TSWF FCOPY ;ARE WE COPYING
SKIPN EOLKAR ;YES--END-OF-LINE TO GO OUT?
JRST GETWD2 ;NO
SWON FREGCH ;YES--SET "REGET CHARACTER"
MOVE CH,EOLKAR
PUSHJ PP,PUTCPY
PUSHJ PP,GETSRC
;FIRST NON-BLANK CHARACTER SEEN
GETWD2: CAIL CH,141 ;CONVERT LC TO UC
CAILE CH,172
JRST .+2 ;NOT LC
TRZ CH,40
CAIG CH,"Z" ;LETTER?
CAIGE CH,"A"
JRST GETWD5 ;NO
TLNE W1,GWLIT ;YES--IS THIS A LITERAL?
JRST GTWD5A ;YES--ERROR
GETWD3: SWON FLETTR; ;NO--SET FLETTR
GTWD3A: CAIGE CT,^D30 ;30 CHARACTERS YET?
AOJA CT,GTWD3B ;NO--INCREMENT AND JUMP
MOVEI DW,E.55 ;YES
CAIN CT,^D30 ;HAVE WE PUT OUT DIAG?
PUSHJ PP,WARN ;NO--PUT IT OUT
AOJA CT,GETWD4
GTWD3B: IDPB CH,PB
CAIN CH,"-" ;IS IT "-"?
MOVEI CH,":" ;YES--SUBSTITUTE ":"
SUBI CH,40 ;CONVERT TO SIXBIT
IDPB CH,PA ;STASH IT
GETWD4: PUSHJ PP,GETKAR ;GET NEXT CHARACTER
JRST GETWD2
GETWD5: CAIG CH,"9" ;NOT LETTER--DIGIT?
CAIGE CH,"0"
JRST GTWD10 ;NO
GTWD5B: AOJA LC,GTWD3A ;YES--STASH IT
GTWD5A: MOVEI DW,E.76
PUSHJ PP,FATAL
JRST GETWD4
;TRY FOR NON-NUMERIC LITERAL
GETWD6: CAIN CH,$QT ;QUOTE?
JRST GTWD6A
CAIE CH,"'"
JRST GTWD11 ;NO
GTWD6A: JUMPE CT,GTWD6C ;YES--ANYTHING SEEN?
SWON FREGCH; ;YES--SET "REGET CHARACTER"
JRST ENDWRD ;FINISH UP
GTWD6C: TLO W1,GWLIT ;TURN ON "LITERAL" FLAG
SWON FLETTR!FALIT; ;TURN ON "ALPHA" FLAGS
MOVEM CH,TERMQ ;SAVE DELIMITER
GETWD7: PUSHJ PP,GETCH ;GET NEXT CHARACTER
MOVE TE,SRCCOL ;COLUMN 7?
CAIN TE,7
JRST GETWD9 ;YES
CAMN CH,TERMQ ;NO--CLOSING QUOTE?
JRST GETWD8 ;YES
GTWD7A: CAIGE CT,^D120 ; [213] NO--TOO BIG?
AOJA CT,GTWD7B ;NO--INCREMENT AND JUMP
MOVEI DW,E.56 ;YES
CAIN CT,^D120 ;HAVE WE PUT OUT DIAG?
PUSHJ PP,FATAL ;NO--PUT IT OUT
AOJA CT,GETWD7 ; [213] COUNT UP OVERSIZED LITERAL
GTWD7B: CAIGE CH,140
CAIGE CH,40
TLO W1,GWASCI
IDPB CH,PB
JRST GETWD7
;CLOSING QUOTE FOUND
GETWD8:
IFN ANS74,<
PUSHJ PP,GETCH ;LOOK AHEAD
MOVE TE,SRCCOL ;COLUMN 7?
CAIN TE,7
GTWD8X: CAIE CH,"-" ;HYPHEN?
JRST GTWD8A ;NO
GTWD8Z: PUSHJ PP,GETCH ;GET NEXT CHARACTER
MOVE TE,SRCCOL ;COLUMN 7 AGAIN?
CAIN TE,7
JRST GTWD8X ;YES
CAIE CH,$HT ;NO--TAB?
CAIN CH," " ;NO--SPACE?
JRST GTWD8Z ;YES--LOOP
CAMN CH,TERMQ ;FIRST CHAR A QUOTE
JRST GETWD8 ;YES, GET RID OF IT [SEE NC215]
GTWD8A: CAMN CH,TERMQ ;IS IT 2 CONSECUTIVE QUOTES?
JRST GTWD7A ;YES, PASS ONE
SWON FREGCH ;NO, SET REGET CHAR
MOVE CH,TERMQ ;JUST INCASE
>
CAILE CT,^D120 ; [213] LIMIT LITERAL SIZE
MOVEI CT,^D120 ; [213] TO 120 CHARS
SWOFF FALIT ;CLOSING QUOTE SEEN
IFN BIS,<
DMOVEM LN,SAVBLN ;UPDATE PTRS TO END OF LITERAL
>
IFE BIS,<
MOVEM LN,SAVBLN ;UPDATE PTRS TO END OF LITERAL
MOVEM CP,SAVBCP
>
PUSHJ PP,GTWD18
JRST ENDLIT
;CONTINUATION COLUMN WHEN SCANNING NON-NUMERIC LITERAL
GETWD9: CAIE CH," " ;SPACE?
JRST GTWD9B ;NO
IFN BIS,<
DMOVE LN,WORDLN
>
IFE BIS,<
MOVE LN,WORDLN
MOVE CP,WORDCP
>
MOVEI DW,E.70 ;YES--ERROR
GTWD9A: PUSHJ PP,FATAL
JRST ENDWRD
GTWD9B: CAIN CH,"-" ;HYPHEN?
JRST GTWD9C ;YES
MOVEI DW,E.73 ;NO--ERROR
JRST GTWD9A ;QUIT
GTWD9C: PUSHJ PP,GETCH ;GET NEXT CHARACTER
MOVE TE,SRCCOL ;COLUMN 7 AGAIN?
CAIN TE,7
JRST GETWD9 ;YES
CAIE CH,$HT ;NO--TAB?
CAIN CH," " ;NO--SPACE?
JRST GTWD9C ;YES--LOOP
CAMN CH,TERMQ ;NO--QUOTE?
JRST GETWD7 ;YES--EVERYTHING OK
PUSH PP,CH
MOVEI DW,E.71 ;NO--WARN HIM
PUSHJ PP,WARN
POP PP,CH
JRST GTWD7A ;GO STASH IT
;TRY A SPACE OR TAB
GTWD10: CAIE CH," "
CAIN CH,$HT
JRST ENDWRD ;YES--IT IS A SPACE OR A TAB
IFN BIS,<
DMOVEM LN,SAVLN1 ;SAVE LINE NUMBER AND CHARACTER POSITION
>
IFE BIS,<
MOVEM LN,SAVLN1 ;SAVE LINE NUMBER AND
MOVEM CP,SAVCP1 ; CHARACTER POSITION
>
MOVEM CH,SAVECH ; AND CHARACTER
;TRY A HYPHEN
CAIE CH,"-" ;HYPHEN?
JRST GETWD6 ;NO
JUMPE CT,GTW10C ;YES--FIRST CHARACTER?
PUSHJ PP,GETKAR ;NO--GET NEXT ONE
CAIN CH," " ;SPACE?
JRST GTW10A ;YES
SWON FREGCH; ;NO--SET "REGET CHARACTER"
TLNE W1,GWSIGN!GWDP ;IS IT A SIGNED LITERAL?
JRST GTW10D ;YES--ERROR
MOVEI CH,"-" ;GET HYPHEN BACK
TLO W1,GWHYF ;TURN ON "THERE IS A HYPHEN"
JRST GETWD3
;SPACE AFTER "-"
GTW10A: TSWT FARITH ;EXPRESSION?
JRST GW10AA ;NO
SWON FGTMIN; ;YES--SET "REGET MINUS"
JRST ENDWRD
GW10AA:
IFN BIS,<
DMOVE LN,SAVLN1
>
IFE BIS,<
MOVE LN,SAVLN1
MOVE CP,SAVCP1
>
MOVEI DW,E.54 ;NOT EXPRESSION--ERROR
PUSHJ PP,FATAL
JRST ENDWRD
;INPUT CHARACTER IS A HYPHEN (CONT'D)
;WORD STARTED WITH A HYPHEN
;HAS TO BE A LITERAL
GTW10C: IDPB CH,PB
TLO W1,GWLIT!GWSIGN
AOJA CT,GETWD4
;IMPROPER LITERAL--SIGN AFTER EITHER SIGN OR DECIMAL POINT
GTW10D:
IFN BIS,<
DMOVE LN,SAVLN1
>
IFE BIS,<
MOVE LN,SAVLN1
MOVE CP,SAVCP1
>
MOVEI DW,E.76
PUSHJ PP,FATAL
JRST GETWD4
;TRY A PERIOD
GTWD11: CAIE CH,"." ;PERIOD?
JRST GTWD12 ;NO
TSWT FLETTR; ;ANY LETTERS SO FAR?
CAME CH,DCPNT. ;NO--ALSO DECIMAL POINT?
JRST GTW11C ;NO
SKIPGE RPLBH+0 ;SEARCHING FOR REPLACEMENTS?
PUSHJ PP,SVPKAR ;YES, SAVE LOC OF PERIOD
SKIPE TERSCN ;[657] SHOULD WE TERMINATE SCAN NOW?
JRST [CAME CH,TERSCN ;[657] MAKE SURE ITS WHAT WE EXPECTED
JRST .+1 ;[657] SOME SORT OF ERROR
MOVEI CH," " ;[657] RETURN A SPACE
SETZM TERSCN ;[657] ONLY DO IT ONCE
JRST .+2] ;[657] BUT DON'T READ NEXT CHARACTER
PUSHJ PP,GETKAR ;YES
JUMPE CT,GTW11H ;WAS DECIMAL POINT THE FIRST CHARACTER?
CAIG CH,"9" ;NO--IS THIS A DIGIT?
CAIGE CH,"0"
JRST GTW11B ;NO
GTW11A: TLOE W1,GWDP ;YES--SET "DECIMAL-POINT" INDICATION
JRST GTW11G ;ALREADY SET--ERROR
TLO W1,GWLIT
MOVEI TC,"."
IDPB TC,PB ;STASH PERIOD
SETZM SAVECH
AOJA CT,GTWD5B ;KICK UP COUNT--GO TO LITERAL
GTW11B: SWON FGTPER;
CAIE CH," " ;IS IT A SPACE?
JRST GTW11F ;NO--ERROR
TSWF FRLIB ;[657] READING FROM LIBRARY?
TSWF FCOPY ;[657] YES, BUT REPLACING?
JRST GTW11D ;[657] NO NEED FOR SPECIAL CHECK
SKIPE RPLCNT ;[657] ANY POSSIBILITY OF REPLACEMENTS?
TSWT FRTST ;[657] YES, BUT ARE WE ON THE REAL READ PASS
JRST GTW11D ;[657] NO NEED FOR SPECIAL CHECK
MOVEI CP,"." ;[657] YES
MOVEM CP,TERSCN ;[657] SET FLAG TO STOP ON READ SCAN
JRST GTW11D ;[657] AND CONTINUE
GTW11C: SWON FGTPER!FNEEDS; ;SET "GET A PERIOD" AND "SPACE NEEDED"
GTW11D:
IFN BIS,<
DMOVE LN,SAVLN1
>
IFE BIS,<
MOVE LN,SAVLN1
MOVE CP,SAVCP1
>
JUMPN CT,ENDWRD ;ANYTHING SO FAR?
JRST GETWRD
;FIRST CHARACTER WAS DECIMAL POINT
GTW11H: CAIE CH," " ;WAS IT FOLLOWED BY A SPACE?
JRST GTW11J ;NO--MUST BE A LITERAL
SWON FGTPER; ;YES--WARN HIM
JRST GTW11D
GTW11J: TLO W1,GWLIT!GWDP
SWON FREGCH;
MOVEI CH,"."
IDPB CH,PB
SETZM SAVECH
AOJA CT,GETWD4
GTW11F: JUMPN CT,GTW11E ;ANYTHING BEFORE THE PERIOD?
SWON FNEEDS; ;NO--SET "SPACE REQUIRED"
JRST GTW11D
GTW11E: MOVEI DW,E.76
PUSHJ PP,FATAL
JRST GTW11D
;TWO DECIMAL POINTS IN LITERAL
GTW11G: PUSH PP,CH
MOVEI DW,E.77
IFN BIS,<
DMOVE LN,SAVLN1
>
IFE BIS,<
MOVE LN,SAVLN1
MOVE CP,SAVCP1
>
PUSHJ PP,FATAL
POP PP,CH
JRST GTWD3A
;TRY COMMA AND SEMI-COLON
GTWD12: CAIE CH,"," ;IS IT A COMMA?
JRST GTW12B ;NO
CAME CH,DCPNT. ;YES--ALSO DECIMAL POINT?
JRST GTW12C ;NO
TSWF FLETTR ;[470] YES, ALL DIGITS SO FAR?
JRST GTW12C ;[470] NO, MUST BE LITERAL OR DATA NAME
PUSHJ PP,GETKAR ;YES--LOOK AT NEXT CHARACTER
CAIG CH,"9" ;DIGIT?
CAIGE CH,"0"
JRST GTW12D
JRST GTW11A ;YES--TREAT AS DECIMAL POINT
GTW12B: CAIE CH,";" ;SEMI-COLON?
JRST GTWD13 ;NO
GTW12C:
IFN ANS74,<
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.HI ;YES, TEST AT HIGH-INTERMEDIATE LEVEL
>
PUSHJ PP,GETKAR
GTW12D: CAIE CH," "
SWON FREGCH;
JRST GTW11D
;TRY PLUS
GTWD13: CAIE CH,"+" ;NO--IS IT "+"?
JRST GTWD14 ;NO
JUMPE CT,GTW10C ;YES--FIRST CHARACTER?
MOVEI DW,E.620 ;PROBABLY AN ERROR
PUSHJ PP,WARN
MOVEI CH,"+" ;RELOAD CHARACTER
SWON FREGCH;
JRST ENDWRD
;TRY SPECIAL CHARACTERS
GTWD14: JUMPE CT,GTWD15 ;FIRST CHARACTER?
SWON FREGCH; ;NO--SET "REGET CHARACTER"
JRST ENDWRD
GTWD15: CAIE CH,"*" ;CHECK FOR "*"
JRST GTW15A ;NO
MOVSI W1,MULWD ;YES--IS NEXT "*" ALSO?
PUSHJ PP,GETKAR
CAIN CH,"*"
JRST GTW15D ;YES--IT'S "**"
SWON FREGCH; ;NO
CAIN CH," " ;IS NEXT CHARACTER SPACE?
JRST SETPN0 ;YES
JRST GTW17A ;NO
GTW15D: MOVSI W1,EXPWD
JRST GTW17A
GTW15A: MOVEI W1,0
CAIN CH,"-"
MOVSI W1,MINWD
CAIN CH,"+"
MOVSI W1,PLUSWD
CAIN CH,"("
MOVSI W1,LPARWD
JUMPN W1,SETPN0
MOVE TA,PUNPTR
GTW15B: HRRZ TB,0(TA)
CAMN CH,TB
JRST GTWD17
AOBJN TA,GTW15B
;BAD CHARACTER
MOVEI DW,E.57 ;PUT OUT DIAG
PUSHJ PP,FATAL
JUMPE CT,GETWRD ;ANTHING SO FAR?
JRST ENDWRD ;YES--FINISH UP
;A SPECIAL CHARACTER WAS SEEN. CHECK FOR FOLLOWING PUNCTUATION.
GTWD17: HLLZ W1,0(TA)
GTW17A: PUSHJ PP,SETPN0
PUSH PP,LN
PUSH PP,CP
PUSHJ PP,GTWD18
POP PP,CP
POP PP,LN
POPJ PP,
GTWD18: SETZM SAVECH
PUSHJ PP,GETKAR ;GET NEXT CHARACTER
CAIN CH," " ;SPACE?
POPJ PP, ;YES
CAIN CH,"." ;NO--PERIOD?
SWON FGTPER!FNEEDS ;YES--SET FLAGS
CAIE CH,";" ;SEMICOLON OR
CAIN CH,"," ;COMMA?
SWON FNEEDS ;YES--SET "SPACE NEEDED"
TSWT FNEEDS ;ANY PUNCTUATION SEEN?
JRST REGLST ;NO, CHARACTER NOT PUNCTUATION--GET IT NEXT TIME
MOVEM CH,SAVECH ;YES--SAVE IT
IFN BIS,<
DMOVEM LN,SAVLN1 ;SAVE LOCATION
>
IFE BIS,<
MOVEM LN,SAVLN1 ;SAVE
MOVEM CP,SAVCP1 ; LOCATION
>
POPJ PP,
;RETURN A PERIOD
TESTWD: TSWTZ FREGWD; ;ALSO "REGET WORD"?
JRST TSTWD1 ;NO--SIMPLY RETURN A PERIOD
IFN BIS,<
DMOVEM W1,SAVEWD ;SAVE THAT WORD
>
IFE BIS,<
MOVEM W1,SAVEWD ;SAVE THAT WORD
MOVEM W2,SAVEWD+1
>
MOVE CT,ITEMCT
MOVEM CT,SAVEWD+2
TSTWD1: MOVSI W1,PERWD
POPJ PP,
;PUNCTUATION OF SOME KIND
SETPN0:
IFN ANS74,<
IFN BIS,<
DMOVE LN,SAVLN1
>
IFE BIS,<
MOVE LN,SAVLN1
MOVE CP,SAVCP1
>
SKIPE FLGSW ;FIPS FLAGGER?
CAIN CH,"." ;YES, BUT PERIOD IS LEGAL
JRST SETPN2 ;NO
CAIE CH,"(" ;LEFT PAREN IS LEGAL
CAIN CH,")" ;SO IS RIGHT PAREN
JRST SETPN2
PUSHJ PP,FLG.HI ;FLAG ALL OTHERS BELOW HIGH-INTERMEDIATE LEVEL
>
SETPN1:
IFN BIS,<
DMOVE LN,SAVLN1
>
IFE BIS,<
MOVE LN,SAVLN1
MOVE CP,SAVCP1
>
SETPN2: DPB LN,GWLN
DPB CP,GWCP
IFN BIS,<
DMOVEM LN,WORDLN
>
IFE BIS,<
MOVEM LN,WORDLN
MOVEM CP,WORDCP
>
POPJ PP, ;RETURN
SETPLS: MOVSI W1,PLUSWD ;PLUS
MOVEI CH,"+"
JRST SETPN0
SETMIN: MOVSI W1,MINWD ;MINUS
MOVEI CH,"-"
JRST SETPN0
SETPER: MOVSI W1,PERWD ;PERIOD
MOVEI CH,"."
JRST SETPN1
;END-OF-FILE HAD BEEN SEEN BEFORE
SETEND: MOVSI W1,ENDIT
MOVE LN,SAVELN
MOVEI CP,7
JRST SETPN2
;REGET SAME WORD
REGWRD: MOVE CT,ITEMCT
TLNE W1,GWLIT ;LITERAL?
POPJ PP, ;YES--RETURN
TLZ W1,GWNOT
PUSHJ PP,TRYNAM ;NO--GET NAMTAB ENTRY
TLOA W1,GWNOT ;THERE ISN'T ONE
HRR W1,0(TA)
POPJ PP,
;WORD HAS BEEN SCANNED
ENDWRD: TLNE W1,GWLIT ;LITERAL?
JRST ENDLIT ;YES
TSWF FLETTR; ;NO--ALL DIGITS?
JRST ENDWR0 ;NO
CAIG CT,^D18 ;YES, BUT IS IT TOO BIG
JRST ENDLIT ;NO
SWON FLETTR ;YES, MAKE IT A USER-NAME
ENDWR0:
IFN FT68274,<
PUSHJ PP,CVT74 ;SEE IF ITS A NEW COBOL-74 RESERVED WORD
>
PUSHJ PP,TRYNAM ;FIND WORD IN NAMTAB
JRST ENDWD2 ;NOT FOUND
MOVE TB,0(TA) ;GET FLAG WORD
LDB TD,NAMVAL ;GET RESERVED WORD VALUE OR CPYTAB POINTER
TLNN TB,NAMRSV/1000000; RESERVED WORD?
JRST ENDWD4 ;NO
DPB TD,GWVAL ;YES--SET VALUE IN W1
TLO W1,GWRESV ;SET "RESERVED" FLAG
ENDWD4: HRR W1,TB ;GET TABLE ADDRESS
HLRZ TB,TA ;SET NAMTAB POINTER
DPB TB,GWNAMP
ENDWD1:
IFN BIS,<
DMOVE LN,WORDLN ;SET "LN" & "CP"
>
IFE BIS,<
MOVE LN,WORDLN ;SET "LN"
MOVE CP,WORDCP ;SET "CP"
>
DPB LN,GWLN
DPB CP,GWCP
POPJ PP, ;RETURN
ENDWD2: TLO W1,GWNOT
JRST ENDWD1
;LITERAL HAS BEEN SCANNED
ENDLIT: TLO W1,GWLIT ;SET "LITERAL" FLAG
IFN FT68274,<
PUSHJ PP,CVTSBP ;SAVE POINTER TO CVT LINE BUFFER
>
PUSH PP,CT
PUSH PP,CT+1 ;GET 2 ACCS
JUMPE CT,[SETZM LITVAL ;NUL LITERAL SO CLEAR VALUE
JRST ENDL1B]
IDIVI CT,5 ;GET NO. OF WORDS
JUMPE CT+1,ENDL1B ;NO REMAINDER
MOVE CT+1,[BYTE (7) 177
BYTE (7) 177,177
BYTE (7) 177,177,177
BYTE (7) 177,177,177,177]-1(CT+1)
ANDM CT+1,LITVAL(CT)
ENDL1B: POP PP,CT+1
POP PP,CT
TSWT FLETTR; ;NON-NUMERIC?
JRST ENDL2 ;NO
ENDL1: DPB CT,GWVAL ;SET SIZE
JRST ENDWD1
ENDL2: JUMPE LC,ENDL3 ;ANY SIZE?
TLO W1,GWNLIT ;YES--SET "NUMERIC" FLAG
CAIG LC,^D18 ;TOO BIG?
JRST ENDL1
MOVEI DW,E.56 ;YES--PUT OUT DIAG
PUSHJ PP,FATAL
MOVEI CT,^D18 ;REDUCE SIZE
JRST ENDL1
ENDL3: LDB CH,[POINT 7,LITVAL,6];NO SIZE--IS IT "+"?
CAIE CH,"+"
JRST SETMIN ;NO--MUST BE "-"
JRST SETPLS ;YES
;GET A CHARACTER FOR A WORD OR NUMERIC LITERAL.
;IF A SPACE IS SEEN, THE REMAINDER OF THE LINE IS SCANNED. IF NOTHING
; IS LEFT ON THE LINE, THE CONTINUATION COLUMN OF THE NEXT LINE
; IS CHECKED. IF HYPHEN, THAT LINE IS SCANNED UNTIL A NON-BLANK
; CHARACTER IS FOUND.
;IF THERE IS NO CONTINUATION, AND A SPACE IS FOUND, THE SPACE IS RETURNED.
;IF THERE IS A CONTINUATION, THE FIRST NON-SPACE ON THE LINE IS RETURNED.
GETKAR: PUSHJ PP,GETK9
CAIN TE,7 ;IS IT CONTINUATION COLUMN?
JRST GETK2 ;YES
CAIE CH," "
JRST GETK4A
IFN BIS,<
DMOVEM LN,SAVBLN ;SAVE LOCATION OF THE BLANK
>
IFE BIS,<
MOVEM LN,SAVBLN ;SAVE LOCATION OF THE BLANK
MOVEM CP,SAVBCP
>
TSWF FRTST ;SEARCHING FOR REPLACEMENT MATCH?
PUSHJ PP,SVLKAR ;YES
SKIPGE RPLBH+0 ;SPECIAL IF READING SRC FOR REPLACEMENT
JRST SVSKAR ;YES
GETK1: PUSHJ PP,GETK9 ;YES--GET NEXT CHARACTER
CAIN TE,7 ;IS IT CONTINUATION COLUMN?
JRST GETK2 ;YES
CAIN CH," " ;NO--IS IT SPACE?
JRST GETK1 ;YES--CONTINUE SCANNING
MOVEI CH," " ;RETURN A SPACE
REGLST: SWON FREGCH; ;NO--SET "REGET CHARACTER" FLAG
POPJ PP,
SVSKAR: MOVE CH,SRCBH+1 ;SAVE BYTE PTR AND COUNT
MOVEM CH,R3BH1
MOVE CH,SRCBH+2
MOVEM CH,R3BH2
MOVE CH,SRCBFC
MOVEM CH,R3BH0 ;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
MOVE CH,SAVECP
MOVEM CH,R3CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R3CPI ;INPUT CHAR. POS.
JRST GETK1 ;NOW GO ON
SVPKAR: MOVE CH,SRCBH+1 ;SAVE BYTE PTR AND COUNT
MOVEM CH,R4BH1
MOVE CH,SRCBH+2
MOVEM CH,R4BH2
MOVE CH,SRCBFC
MOVEM CH,R4BH0 ;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
MOVE CH,SAVECP
MOVEM CH,R4CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R4CPI ;INPUT CHAR. POS.
POPJ PP,
SVLKAR: MOVE CH,RPLBLK
MOVEM CH,L2BH0 ;SAVE CURRENT LIBRARY BLOCK #
MOVE CH,LIBBH+1
ADD CH,[070000,,0]
SKIPGE CH
SUB CH,[430000,,1]
MOVEM CH,L2BH1 ;BACKUP OVER THIS CHAR AND SAVE BYTE PTR.
MOVE CH,LIBBH+2
ADDI CH,1
MOVEM CH,L2BH2 ;CHAR. COUNT
MOVE CH,SAVECP
MOVEM CH,L2CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,L2CPI ;INPUT CHAR. POS.
POPJ PP,
;GET A CHARACTER FOR WORD OR NUMERIC LITERAL (CONT'D).
;CONTINUATION COLUMN SEEN.
GETK2: CAIN CH," " ;IS CONTINUATION COLUMN A SPACE?
JRST GETK6 ;YES--RETURN
IFN ANS74,< ;[1342] IS CONTINUATION COLUMN
CAIE CH,"D" ;[1342] A DEBUG LINE?
CAIN CH,"d" ;[1342]
SKIPA ;[1342]
JRST GETK2A ;[1342] NO--CHECK FOR HYPHEN
MOVEI CH," " ;[1342] REPLACE WITH A SPACE
JRST GETK6 ;[1342] RETURN
> ;[1342] END OF CHECK FOR DEBUG LINE
GETK2A: ;[1342]
CAIE CH,"-" ;IS CONTINUATION COLUMN A HYPHEN?
JRST GETK5 ;NO--ERROR
IFN ANS74,<
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.HI ;YES, TEST AT HIGH-INTERMEDIATE LEVEL
>
GETK4: PUSHJ PP,GETK9 ;YES--SCAN THIS NEW LINE
CAIN TE,7 ;CONTINUATION COLUMN AGAIN?
JRST GETK2 ;YES
CAIN CH," " ;NO--STIL SPACE?
JRST GETK4 ;YES--LOOP
SETZM SAVBLN ;NO--CLEAR "SAVBLN"
GETK4A: SETZM NOCONT
POPJ PP, ;RETURN
GETK5: MOVEI DW,E.73 ;CONTINUATION NOT SPACE OR HYPHEN
PUSHJ PP,FATAL
MOVEI CH," "
GETK6: SETOM NOCONT
POPJ PP,
GETK9: PUSHJ PP,GETCH
MOVE TE,SRCCOL ;REMEMBER SOURCE COLUMN
TSWF FEOF;
POPJ PP,
CAIN CH,$HT
MOVEI CH," "
CAIL CH,140
SUBI CH,40
POPJ PP,
;GET THE NEXT CHARACTER FROM THE SOURCE LINE, EVEN IF SPACE.
GETCH: MOVE CP,SAVECP ;RESET CHARACTER POSITION
TSWF FREGCH; ;RE-GET SAME CHARACTER?
JRST GETCH5 ;YES
AOS CH,INPTCP
TSWF FSEQ; ;SEQUENCED INPUT?
JRST GETCH3 ;YES
CAIGE CP,CPMAXN ;NO, TOO MANY CHARACTERS?
JRST GETCH5 ;NO
;END OF SOURCE LINE--TOO MANY CHARACTERS
MOVE LN,SAVELN
MOVEI DW,E.82
TSWT FNOCPY ;NO ERROR IF NOT LISTING
PUSHJ PP,FATAL
MOVE CP,SAVECP
GETCH1: PUSHJ PP,GETSRC ;GET NEXT ONE
CAIE CH,$LF ;END OF LINE?
CAIN CH,$FF
JRST FINLIN ;YES
JRST GETCH1 ;NO--LOOP
;SEQUENCED INPUT
GETCH3: CAIGE CH,^D73 ;NO--COLUMN 72 BEEN PASSED YET?
JRST GETCH5 ;NO
GETCH7: CAIE CP,^D81 ;Yes, but are we outside the comment area?
JRST GETCH8 ;Not for the first time
MOVEI DW,E.82
TSWT FNOCPY ;Yes, but no error if not listing
PUSHJ PP,FATAL
GETCH8: PUSHJ PP,GETSRC ;IGNORE REST OF LINE
CAIE CH,$LF
CAIN CH,$FF
JRST FINLIN
JRST GETCH7
;STILL SOME SOURCE ON THIS LINE
GETCH5: PUSHJ PP,GETSRC ;GET NEXT CHARACTER
CAIE CH,$LF ;END OF LINE?
CAIN CH,$FF
;[D1316] JRST FINLIN ;YES
;[1316] AT THIS POINT, WE HAVE THE LF AND WE HAVE TO DECIDE WHETHER TO
;[1316] TO PUT IT ON THE LISTING. IT GOES ON LISTING IF THE FOLLOWING
;[1316] FIVE SWITCHES HAVE THE APPROPRIATE SETTINGS: FCOPY - OFF,
;[1316] FRLIB - ON, FNOCPY - ON, FRTST - ON, NOCONT - ON. (CONTINUATIONS
;[1316] ARE FORTUITOUSLY DISALLOWED FOR * COMMENT LINES.)
;[1316] OTHERWISE FINLIN WILL BE ALLOWED TO BEHAVE AS BEFORE.
;[1316]
JRST [SKIPN NOCONT ;[1316] CONTIN'S DISALLOWED?
JRST FINLIN ;[1316] NO
TSWF FRLIB ;[1316] READING LIB FILE?
TSWF FCOPY ;[1316] COPY REPL IN PROGRESS?
JRST FINLIN ;[1316]
TSWF FRTST ;[1316] TESTING FOR REPL MATCH?
TSWT FNOCPY ;[1316] NOT PUTTING LF TO LISTING?
JRST FINLIN ;[1316]
SWOFF FNOCPY ;[1316] FORCE IT TO LISTING
SWON FNCOFF ;[1316] NOTE THAT WE FORCED IT
JRST FINLIN] ;[1316] GO FORCE IT
;[1316]
GETCH6: MOVE TE,INPTCP ;[354] SAVE SOURCE COLUMN
MOVEM TE,SRCCOL ; [354]
CAIN CH,$HT ;IS IT A TAB?
JRST GTCH10 ;YES
;CHARACTER OK--LEAVE
GETCH9: MOVE LN,SAVELN ;GET CURRENT LINE
POPJ PP, ;LEAVE
;INPUT CHARACTER WAS TAB--BUMP INPTCP
GTCH10: MOVE CH,INPTCP
ADDI CH,1 ;IT ALWAYS POINTS AT PREVIOUS CHARACTER
IORI CH,7
SUBI CH,1
MOVEM CH,INPTCP
MOVEI CH,$HT
JRST GETCH9
;END OF SOURCE LINE--PRINTER CONTROL HAS BEEN SEEN
FINLIN: TSWT FNOCPY ;IGNORE EOL IF NOT COPYING TO CPYFIL
MOVEM CH,EOLKAR
PUSHJ PP,PUTCIF
;[1316] IF WE FORCED THE LF TO THE LISTING, WE HAVE TO RESET FNOCPY SO
;[1316] THAT IT WON'T CAUSE PROBLEMS BEFORE WE GET TO GETSQ9
;[1316]
TSWFZ FNCOFF ;[1316] DID WE FORCE LF TO LISTING?
SWON FNOCPY ;[1316] YES, ALSO RESET FNOCPY
;[1316]
TSWT FRLIB ;READING LIBRARY?
TSWT FEOF ;NO--END OF INPUT?
JRST GETSEQ ;NO--START NEW LINE
;END OF SOURCE
MOVEI CH," " ;RETURN A SPACE
MOVEI CP,7 ; FOR COLUMN 7
AOS SAVELN ;KICK UP LINE COUNT
JRST GETCH9 ;LEAVE
;PARAGRAPH HAS BEEN DELETED AND FIRST CHARACTER OF NEXT PARAGRAPH NAME SEEN.
;PUT OUT THAT FIRST CHARACTER.
FINSKP: SWOFF FNOCPY;
MOVEI CH,$LF
PUSHJ PP,PUTCPY
TSWF FEOF;
POPJ PP,
FINSK3: MOVEI CH,1(CP)
CAML CH,INPTCP
JRST FINSK4
MOVEI CH," "
PUSHJ PP,PUTCPY
JRST FINSK3
FINSK4: SWON FREGCH; ;TURN ON "REGET CHARACTER"
IFN DBMS,<
SKIPN FINVOK
JRST .+3
LDB CH,DBBUFH+1
SKIPA
>
LDB CH,SRCBH+1 ;PUT OUT LAST CHARACTER
JRST PUTCPY ; AND RETURN
;GET THE VERY FIRST CHARACTER FROM THE SOURCE FILE
GETFCH: SETZM SAVELN ;SET LINE COUNT TO ZERO
SETOM NOCONT
MOVEI CH,$FF
PUSHJ PP,PUTFEL
SETZM EOLKAR
SETZM SEQIN
IFN FT68274,<
PUSHJ PP,CVTICL ;INITIALIZE CONVERSION LINE BUFFER
JRST GETSQ1
>
;START A NEW SOURCE LINE
GETSEQ:
IFN FT68274,<
PUSHJ PP,CVTOAL ;OUTPUT A LINE TO CVT FILE
GETSQ1:>
SETZM SAVECP ;STARTING AT COLUMN 1
TSWF FSEQ ;SEQUENCED INPUT?
JRST GETSQ7 ;YES
PUSHJ PP,GETSRC ;GET A CHARACTER
CAIN CH,$LF ;[526] END OF
JRST GETSQ4 ;YES
CAIN CH,$FF ;[526] FORM FEED ON FIRST CHAR SPECIAL
JRST GTSQ6B ;[526] IGNORE SO CONTINUATION WORKS
IFN DBMS,<
SKIPE FINVOK
SKIPA TD,@DBBUFH+1
>
MOVE TD,@SRCBH+1 ;NO--IS IT
TSWF FRLIB ;READING FROM LIBRARY?
MOVE TD,@LIBBH+1 ;YES
TRNN TD,1 ; A SEQUENCE NUMBER?
JRST GETSQ9 ;NO
CAMN TD,[<ASCII/ />+1] ;[526] IS THIS AN EDITS PAGE MARK
JRST GETSQ6 ;[526] YES HANDLE SEPARATELY
IFN FT68274,<
MOVEM TD,CVTLBF ;STORE SEQ NUMBER (I.E. BIT 35)
>
MOVEI TD,6 ;[526] NO REGULAR SEQUENCE NUMBER
JRST GETSQ8
GETSQ2: CAIE CH,"-" ;CONTINUATION?
JRST GETSQ3 ;NO
IFN ANS74!FT68274,<
SKIPE NOIDHY## ;ARE THEY ALLOWED HERE
JRST [MOVEI DW,E.700 ;NOT IN ID, GIVE ERROR
IFE FT68274,<
PUSHJ PP,FATAL
>
IFN FT68274,<
PUSHJ PP,WARN
>
MOVEI CH,"-" ;PUT HYPHEN BACK
JRST GETSQ5] ;AND CONTINUE
>
SKIPN NOCONT ;YES--ARE THEY LEGAL?
JRST GETSQ5 ;YES
MOVE LN,SAVELN ;NO--
MOVEI DW,E.279 ; PUT OUT
PUSHJ PP,FATAL ; DIAG
MOVEI CH," " ;REPLACE WITH SPACE
GETSQ3: CAIE CH," " ;SPACE OR
CAIN CH,$HT ; TAB?
JRST GETSQ5 ;YES
CAIN CH,"*" ;NO--COMMENT?
JRST GTSQ10 ;YES
CAIN CH,"/" ;SLASH
JRST GTSQ13 ;YES
IFN ANS74,<
TSWF FSEQ ;SEQUENCED INPUT?
JRST GTSQ3A ;YES
CAIE CH,"\" ;LOOK FOR \D
JRST GETSQ4 ;NOT
PUSHJ PP,GETSRC ;GET NEXT CHARACTER
GTSQ3A: CAIE CH,"D" ;DEBUG
CAIN CH,"d"
JRST GTSQ14 ;YES
>
GETSQ4:
MOVE CH,RPLFLG ;GET DEFERED FLAGS ALSO
TSWT FEOF!FECOPY ;END OF FILE OR END OF COPY?
TLNE CH,(FECOPY) ;REALLY FINISHED WITH LIBRARY ITSELF?
CAIA ;YES, DON'T REGET LAST CHAR.
SWON FREGCH ;NO--REGET LATER
GTSQ4A: MOVEI CH," " ;REPLACE WITH SPACE
GETSQ5: MOVEI CP,7 ;RESET CP AND
MOVEM CP,INPTCP ; INPUT COLUMN NUMBER
TSWTZ FNCOFF ;WAS FNOCPY TURNED OFF AT FINLIN?
JRST GETCH6 ;NO
SWON FNOCPY ;YES, TURN IT BACK ON NOW
SWON FNEEDS ;ALSO REQUEST A DUMMY PERIOD
JRST GETCH6 ;LEAVE
; [526]COME HERE TO HANDLE EDITS PAGE MARKS
GETSQ6: MOVEI TD,7 ;[526] 5 BLANKS CR FF (GETSRC GOBBLES NULS)
GTSQ6A: PUSHJ PP,GETSRC ;[526] GET THE NEXT CHARACTER
CAIE CH,$FF ;[526] DID WE GET THE FORM FEED YET?
SOJG TD,GTSQ6A ;[526] NO LOOP BACK FOR MORE
GTSQ6B: PUSHJ PP,PUTCPY ;[526] PUT OUT THE FORM FEED
JRST GETSEQ ;[526] GO BACK FOR NEXT LINE
;START A NEW SOURCE LINE (CONT'D)
;SEQUENCED INPUT -- COPY COLUMNS 1-6, GET COLUMN 7
GETSQ7: MOVEI TD,7
GETSQ8: SETOM SEQIN
GTSQ8A: PUSHJ PP,GETSRC
CAIE CH,$LF
CAIN CH,$FF
JRST GETSQ4
SOJG TD,GTSQ8A
JRST GETSQ2
;PUT OUT 6 SPACES IN PLACE OF SEQUENCE NUMBER
;[1316] HERE WE HAVE TO DO THE SAME RAIN DANCE AS AT GETCH5 ABOVE. THIS
;[1316] TIME THE OBJECTIVE IS TO GET THE SIX SPACES IN FRONT OF THE NEW
;[1316] LINE ONTO THE LISTING. ALSO, NOT SURPRISINGLY, WE HAVE TO HOLD
;[1316] OFF ON PUTTING THE FIRST CHARACTER OF THE USER NAME TO THE LISTING
;[1316] IN SITUATIONS WHERE THE FIVE CONDITIONS ARE MET.
;[1316]
;[D1316] GETSQ9: TSWF FNOCPY ;IGNORE IF NOT OUTPUTING TO CPYFIL
;[1316]
GETSQ9: ;[M1316]
SKIPN NOCONT ;[1316] CONTIN'S DISALLOWED?
JRST GTSQ9A ;[1316] NO
TSWF FRLIB ;[1316] READING LIB FILE?
TSWF FCOPY ;[1316] COPY REPL IN PROGRESS?
JRST GTSQ9A ;[1316]
TSWF FRTST ;[1316] TESTING FOR REPL MATCH?
TSWT FNOCPY ;[1316] NOT PUTTING SPACES TO LISTING?
JRST GTSQ9A ;[1316]
SWOFF FNOCPY ;[1316] FORCE THEM TO LISTING
SWON FNCOFF ;[1316] NOTE THAT WE FORCED THEM
GTSQ9A: ;[1316]
TSWF FNOCPY ;[M1316] IGNORE IF NOT PUTTING OUT TO CPYFIL
JRST GETSQ2
MOVE TE,CH ;SAVE CH
MOVEI CH," " ;REPLACE THAT SOURCE CHARACTER
DPB CH,CPYBHO+1 ; WITH SPACE
MOVEI TD,5
;[1316] IF WE ARE FORCING SPACES TO LISTING, PUT IN TWO MORE TO TIDY IT UP.
TSWF FNCOFF ;[1316]
ADDI TD,2 ;[1316]
;[1316]
PUSHJ PP,PUTCPY
SOJG TD,.-1
MOVE CH,TE ;RESTORE CH
;[1316] IF WE ARE FORCING SPACES TO LISTING, SUPPRESS FIRST CHARACTER OF
;[1316] USER NAME FOR NOW. IT WILL GET ONTO LISTING LATER.
TSWT FNCOFF ;[1316]
;[1316]
PUSHJ PP,PUTCPY
;[1316] NOW WE SET SWITCH TO INDICATE USER NAME IS IN A-MARGIN, AND THEN
;[1316] RESTORE FNOCPY AND FNCOFF SWITCHES.
TSWF FNCOFF ;[1316] ARE WE FORCING SPACES TO LISTING?
SETOM AMARFL ;[1316] SET A-MARGIN FLAG FOR KLUDGE
TSWFZ FNCOFF ;[1316] CLEAR THIS FLAG, IF SET
SWON FNOCPY ;[1316] AND RE-SET THIS ONE, IF NECESSARY
;[1316]
JRST GETSQ2
;"/" IN COLUMN 7
GTSQ13: LDB CH,$LFPTR ;SEE IF LINE TERMINATOR WAS FF
CAIE CH,$FF ; IF SO LEAVE IT ALONE
MOVEI CH,$VT ;OTHERWISE REPLACE LF BY VT TO SIGNAL "/" IN COL 7.
DPB CH,$LFPTR ;IN BUFFER
MOVEI CH,"/" ;PUT SLASH BACK
JRST GTSQ10 ;AND MAKE A COMMENT
;HERE WITH D IN COLUMN 7
IFN ANS74,<
GTSQ14: SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.LI ;YES, TEST AT LOW-INTERMEDIATE LEVEL
GTSQ15: SKIPN DEBSW ;DEBUG ON?
TSWF FRTST ;NO, BUT ARE WE JUST DOING REPLACEMENT CHECK?
JRST GTSQ4A ;YES, COMPILE THIS LINE
;NO, JUST MAKE A COMMENT
>
;"*" IN COLUMN 7
GTSQ10: SETOM NOCONT
GTSQ11: PUSHJ PP,GETSRC
CAIE CH,$LF
CAIN CH,$FF
JRST GETSQ4
JRST GTSQ11
;GET A CHARACTER FROM THE SOURCE FILE BUFFER
GETSRC: TSWF FECOPY;
JRST GTBLNK
TSWF FRLIB ;DO WE READ LIBFIL?
JRST GETLIB
TSWF FEOF; ;END OF FILE?
JRST GTBLNK ;YES
SKIPN SRCDEV ;[352] ANY MORE IN SOURCE FILES?
JRST GTSR3A ;[352] NO MORE SOURCE ANYWHERE
IFN DBMS,<
SKIPE FINVOK ;ARE WE IN INVOKE?
JRST IN.GET
>
TSWFZ FREGCH; ;REGET PREVIOUS CHARACTER?
JRST REGETS ;YES
SOSG SRCBH+2
JRST GETSR3
GETSR0: ILDB CH,SRCBH+1
GETSL:
IFN FT68274,<
JUMPE CH,GETSL0 ;IGNORE NULS
TSWF FNOCPY ;[1360] ARE WE IN COPY REPLACING?
JRST GETSL0 ;[1360] YES, DON'T OUTPUT TWICE
SOSGE CVTBFC## ;MAKE SURE THERE IS ROOM IN LINE BUFFER
JRST [OUTSTR [ASCIZ /68274 - source line too long to convert/]
JRST GETSL0]
IDPB CH,CVTBFP## ;STORE CURRENT CHARACTER
GETSL0:>
CAIGE CH,40 ;CONTROL CHARACTER?
JRST GETSR2 ;YES
CAIL CH,140 ;NO--SIXBIT CHARACTER?
JRST GETSR1
JRST PUTCIF
;REGET PREVIOUS CHARACTER
REGETS: LDB CH,SRCBH+1
POPJ PP,
;SPECIAL CHARACTER PROCESSING
;CHARACTERS ABOVE CODE 137
;[1036] RUBOUT GETS CONVERTED TO SPACE, ALL OTHERS GET PRINTED
GETSR1: CAIE CH,177 ;[1036] SKIP IF RUBOUT
JRST PUTCIF ;[1036] NO, JUST PUT IN CPY FILE AS IS
GTSR1B: PUSH PP,CH ;SAVE CHARACTER
MOVEI CH," " ;PUT SPACE IN CPYFIL
GTSR1D: PUSHJ PP,PUTCIF
POP PP,CH ;RESTORE CHARACTER
POPJ PP, ;RETURN
IFN DBMS,<
IN.GET: TSWFZ FREGCH ;REGET CHARACTER?
JRST DB.GET ;YES
SOSGE DBBUFH+2 ;MORE CHARACTERS?
JRST IN.INP ;NO, GET ANOTHER BUFFER
IN.GT2: ILDB CH,DBBUFH+1 ;GET CHARACTER
JRST GETSL ;RETURN AS NORMAL
IN.INP: IN DBCHAN,
JRST IN.GT2 ;INPUT OK
GETSTS DBCHAN,CH ;INPUT ERROR
TRNN CH,IO.ERR ;ERRORS?
JRST IN.EOF ;NO, END-OF-FILE
MOVEI CH,DBDEV ;YES, SET UP FOR ABORT
MOVSI TA,'DSK'
MOVEM TA,DBDEV
JRST DEVDED
IN.EOF: SETZM FINVOK ;CLEAR INVOKE FLAG
IFN FT68274,< ;[1413]
SETZM CVTPLF ;[1413] DISREGARD PREVIOUS LINE
> ;[1413]
SETZM DBBLCK ;[316]
RENAME DBCHAN,DBBLCK ;[316]
CLOSE DBCHAN, ;NOT REALLY NECESSARY
RELEASE DBCHAN,
MOVEI CH,$LF ;RETURN LINE-FEED
SKIPE DBONLY ;[453] WAS /S ON BEFORE?
SWON FSEQ ;[453] YES--TURN IT BACK ON
SETZM DBONLY ;[453] AND TURN THIS OFF
POPJ PP, ;RETURN LIKE NOTHING HAPPENED!!
DB.GET: LDB CH,DBBUFH+1
POPJ PP,
>
;SPECIAL CHARACTER PROCESSING (CONT'D)
;CHARACTERS BELOW CODE 040
GETSR2: JUMPE CH,GETSRC ;IGNORE NULLS
CAIE CH,$CR ; AND CARRIAGE-RETURNS
CAIN CH,$CZ ; AND END-FILES
JRST GETSRC
CAIE CH,$HT ;TAB?
JRST GTSR2B ;NO
MOVEI CH," " ;YES--REPLACE WITH SPACE
PUSHJ PP,GTSR2D
MOVEI CH,$HT
JRST PUTCIF
GTSR2B: CAIE CH,$LF ;LINE-FEED?
CAIN CH,$FF ;NO--FORM-FEED?
POPJ PP, ;YES--RETURN
CAIG CH,$DC4 ;NO--OTHER PRINTER CONTROL?
CAIGE CH,$DLE
CAIN CH,$VT
JRST GTSR2C
PUSH PP,CH ;YES
MOVEI CH,"^"
PUSHJ PP,PUTCIF
MOVE CH,(PP)
ADDI CH,100
JRST GTSR1D
GTSR2C: MOVEI CH,$LF ;YES--FORCE LINE-FEED
GTSR2D: TSWF FRLIB;
POPJ PP, ;[557] IF FROM LIBRARY DON'T DO ANYTHING SPECIAL
IFN DBMS,<
SKIPN FINVOK
JRST GTSR2F
DPB CH,DBBUFH+1
POPJ PP,
GTSR2F:>
DPB CH,SRCBH+1 ;RESTORE FOR POSSIBLE REGET
POPJ PP, ;RETURN
;NEW BUFFER REQUIRED
GETSR3: SKIPL RPLBH+0 ;NEED TO SAVE CURRENT BUFFER?
JRST GTSR3X ;NO
PUSH PP,TA
PUSH PP,TB ;SAVE ACCS
PUSH PP,TC
PUSH PP,TD ;DEFINITELY NEEDS TO BE SAVED
PUSH PP,TE
MOVE TA,RPLNXT ;GET REL LOC OF COUNT
ADD TA,CPYLOC ;FIX
MOVE TB,RPLBH+2 ;GET CHAR. COUNT
ADDM TB,(TA) ;ADD TO WHATS ALREADY THERE
HRRZ TA,SRCBH+1
HRRZ TB,RPLBH+1
SUBI TA,-1(TB) ;GET SIZE IN WORDS
PUSH PP,TA
HRLI TA,CD.CPY
PUSHJ PP,GETENT
HRL TA,RPLBH+1 ;FORM BLT PTR
POP PP,TB
ADDI TB,(TA) ;END OF BLT
BLT TA,-1(TB) ;COPY ALL WE NEED
POP PP,TE
POP PP,TD
POP PP,TC
POP PP,TB
POP PP,TA
GTSR3X: SKIPN SRCDEV ;[352] ANY MORE SOURCE FILE CHARS??
JRST GTSR3A ;[352] NO CLOSE EVERYTHING OUT, WE ARE DONE.
AOS SRCBFC ;INCREMENT BUFFER COUNT
IN SRC, ;FILL BUFFER
JRST [SKIPL RPLBH+0
JRST GETSR0
MOVE CH,SRCBH+1
ADD CH,[440000,,1] ;ADVANCE TO NEXT WORD
MOVEM CH,RPLBH+1
MOVE CH,SRCBH+2
MOVEM CH,RPLBH+2
JRST GETSR0]
GETSTS SRC,CH ;ERROR--SEE IF END-FILE
TRNE CH,IO.ERR
JRST GETSR4 ;NO
RELEASE SRC, ;RELEASE THIS DEVICE
PUSH PP,I1 ;[1122]
PUSHJ PP,STINFL ;SET UP NEXT SOURCE FILE
POP PP,I1 ;[1122]
SKIPE SRCDEV ;WAS THERE ANY?
JRST GETSR3 ;YES
;NO MORE SOURCE
SKIPE LIBDEV ;[352] ANY LIBRARY DEVICE?
JRST [SWOFF FCOPY ;[352] YES TURN OFF COPY
JRST GTSR3B] ;[352] RETURN LF TO KEEP LIB DEVICE OPEN.
GTSR3A: SWON FEOF; ;SET "END-FILE" SWITCH
RELEASE LIB,
SKIPE CREFSW
CLOSE CRF,
GTSR3B: MOVEI CH,7 ;[352]
MOVEM CH,SRCCOL
;RETURN A LINE-FEED
GTBLNK: MOVEI CH,$LF
POPJ PP,
;ERROR ON SOURCE DEVICE
GETSR4: MOVEI CH,SRCDEV
JRST DEVDED
;SYNTAX SCANNER HAS DETECTED AN ERROR AND IS SKIPPING PAST DATA.
;GET NEXT SOURCE CHARACTER.
SKPSRC: TSWFZ FGTPER;
JRST SKPSR6
TSWFZ FGTMIN;
JRST SKPSR8
TSWF FCOPY ;ARE WE COPYING?
JRST SKPSR3 ;YES
TSWF FECOPY ;HAS COPY JUST FINISHED?
JRST SKPSR5 ;YES, CLEAN UP
PUSHJ PP,GETCH ;NO--GET A CHARACTER
SKPSR1: CAIN CH,$HT ;CHANGE TAB TO SPACE
MOVEI CH," "
CAIN CH," "
SWOFF FNEEDS;
SKPSR2: TSWF FNOCPY;
MOVE CP,SRCCOL
POPJ PP,
SKPSR3: MOVE CH,INPTCP
TSWF FREGCH;
SUBI CH,1
CAMLE CH,SAVECP
JRST SKPSR9
TSWFZ FECOPY ;SHOULD WE CLEAN UP LIBRARY?
JRST SKPSR5 ;YES
SKIPE CH,EOLKAR ;NO--ANY LINE TO TERMINATE?
PUSHJ PP,PUTCPY ;YES--DO SO
PUSHJ PP,GETCH ;GET A CHARACTER
TSWFZ FECOPY ;DONE WITH LIBRARY NOW?
JRST SKPSR5 ;YES
SKIPN EOLKAR
JRST SKPSR4
PUSH PP,CH
MOVE CH,EOLKAR
PUSHJ PP,PUTCPY
POP PP,CH
SKPSR4: PUSHJ PP,PUTCPY
JRST SKPSR1
SKPSR5: PUSHJ PP,ENDCPY
JRST SKPSRC
SKPSR6: MOVEI CH,"."
JRST SKPSR2
SKPSR8: MOVEI CH,"-"
TSWF FCOPY;
PUSHJ PP,PUTCPY
JRST SKPSR2
SKPSR9: MOVEI CH," "
PUSHJ PP,PUTCPY
JRST SKPSR3
SUBTTL COPY VERB
COMMENT \
THE NEW FORMAT OF THE CPYTAB IS AS FOLLOWS:
0 ;ALWAYS 0
NEXT REPLACEMENT ,, LENGTH OF THIS REPLACEMENT
TYPE (LHS W1) ,, FLAG + SIZE IN WORDS
TEXT SIXBIT FOR NAMES, ASCII FOR LITERALS
...
BYTE POINTER (LHS) ,, CHARACTER COUNT
BYTE (9) SAVECP(BEFORE), INPTCP(BEFORE), SAVECP(AFTER), INPTCP(AFTER)
REPLACEMENT TEXT IN ASCII
...
NEXT BLOCK
\
CONTF==1B18 ;REPLACEMENT TEST IS CONTINUED
;EITHER QUALIFIED OR PSEUDO-TEXT
CPYLIB: SWOFF FRTST ;MAKE SURE ITS OFF
SETZM CURCPY ;RESET CPYTAB POINTERS
SETZM RPLCNT ;CLEAR READ COUNT
SETZM RPLLOC ;CLEAR POINTER TO PSEUDO-TEST
SETZM RPLNXT ;AND CURRENT POINTER
IFN ANS74,<
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.LI ;YES, TEST AT LOW-INTERMEDIATE LEVEL
>
IFN FT68274,<
PUSHJ PP,CVTCTC ;TURN COPY INTO COMMENT
>
MOVE TA,CPYLOC
MOVEM TA,CPYNXT
MOVEM W2,CPYW2 ;SAVE POSITION OF 'COPY' IN SOURCE
PUSHJ PP,GETITM ;GET LIBRARY-NAME
TLNE W1,GWLIT ;LITERAL?
JRST CPE285 ;YES, ERROR
MOVE TA,NAMWRD ;STORE 1ST 6 CHARS OF NAME
MOVEM TA,LIBNAM
HLRZ TA,NAMWRD+1 ;STORE 7TH & 8TH CHARS
ANDI TA,777700
HRLZM TA,LIBNAM+1
MOVE TA,NAMWRD+1 ;GET SECOND WORD AGAIN
TLZ TA,777700 ;AND CHECK FOR MORE THAN 8 CHARS.
JUMPE TA,CPLB0 ;ITS OK, 8 OR LESS
EWARNW E.649 ;TOO MANY, WARN USER
CPLB0: PUSHJ PP,GETITM ;GET NEXT ITEM OF SOURCE
CAIN TYPE,PRIOD. ;PERIOD?
JRST CPLB99 ;ENDED WITH PERIOD --- SET UP COPY & GO TO IT
CAIE TYPE,IN. ;NO, IS IT IN OR OF?
JRST CPLB1 ;NO
IFN ANS74,<
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.H ;YES, TEST AT HIGH LEVEL
>
PUSHJ PP,GETITM ;GET LIBRARY FILE NAME
TLNN W1,GWLIT ;LITERAL?
JRST CPLB55 ;NO
LDB TA,GWVAL ;GET LITERAL SIZE
MOVE TB,[POINT 7,LITVAL]
MOVE TC,[POINT 6,NAMWRD]
CPLB51: ILDB TD,TB
CAIN TD,":" ;TEST FOR DEVICE
JRST CPLB58 ;FOUND ONE
CAIN TD,"." ;TEST FOR EXTENSION
JRST CPLB59 ;FOUND ONE TO FOLLOW
CAIN TD,"[" ;[PPN]?
JRST CPLB53 ;YES
CAIL TD,141 ;IS IT LOWER CASE?
CAILE TD,172 ;...
JRST .+2 ;NO
TRZA TD,100 ;CONVERT LOWER CASE TO SIXBIT
SUBI TD,40 ;CONVERT UPPER CASE TO SIXBIT
IDPB TD,TC
CPLB52: SOJG TA,CPLB51 ;PUT LITERAL IN NAMWRD
CPLB55: HRRZ TB,NAMWRD+1 ;TEST FOR TOO MANY CHARACTERS
SKIPE TB
EWARNW E.650 ;TOO MANY, WARN USER
MOVE TA,NAMWRD ;GET FILE NAME
HLLZ TB,NAMWRD+1 ;AND EXTENSION
SKIPN TB
MOVSI TB,'LIB' ;IF NULL USE DEFAULT
CAME TA,LIBHDR ;NAME MATCH WHAT WE CURRENTLY HAVE?
JRST CPLB56 ;NO
SKIPN TC,NAMWRD+2 ;[1521] AND DEVICE?
MOVSI TC,'DSK' ;[1521] OR 'DSK:' DEFAULT
CAME TC,LIBDEV ;[1521]
JRST CPLB56 ;[1521] NO
SKIPN TC,NAMWRD+3 ;[1521] GET PPN IF THERE IS ONE
MOVE TC,MYPPN ;[1521]
CAME TC,LIBPP## ;[1521] STILL MATCHING?
JRST CPLB56 ;[1521] NO
CAMN TB,LIBHDR+1 ;[1521] AND EXTENSION
JRST CPLB0 ;[1521] ALL MATCH, USE CURRENT FILE
HLRZ TC,LIBHDR+1
CAMN TB,[SIXBIT /LIB/]
JUMPE TC,CPLB0 ;'LIB' CAN MATCH NULL
CPLB56: MOVEM TA,LIBHDR ;STORE NEW FILE NAME
MOVEM TB,LIBHDR+1 ;AND EXTENSION
MOVE TC,NAMWRD+2 ;[1521] GET THE DEVICE
MOVEM TC,LIBDEV ;[1521]
MOVE TC,NAMWRD+3 ;[1521] AND THE P,PPN
MOVEM TC,LIBPP ;[1521]
MOVEI TC,IOSRCS ;GET START OF LIST
CPLB57: ;[M1310]
HLLZ TD,DEVEXT(TC) ;[1310] GET FILE EXTENSION BY ITSELF
SKIPN TD ;[1310] NULL EXTENSION?
MOVSI TD,'LIB' ;[1310] YES, ALLOW 'LIB' TO MATCH NULL
CAMN TA,DEVFIL(TC) ;SEE IF FILE NAME MATCH
CAME TB,TD ;[M1310] AND EXTENSION
JRST CPLB77 ;NO
MOVE TD,DEVSW(TC) ;GET SWITCHES
SOJN TD,CPLB77 ;JUMP IF NOT LIBRARY
MOVE TC,DEVDEV(TC) ;GET DEVICE
JRST CPLB88 ;NOW OPEN IT
CPLB58: MOVE TC,NAMWRD ;GET DEVICE NAME
MOVEM TC,NAMWRD+2 ;STORE IN SAFE PLACE
SETZM NAMWRD ;CLEAR OUT DEVICE
SETZM NAMWRD+3 ;[1521] AND [PPN] STORAGE AREA
SKIPA TC,[POINT 6,NAMWRD]
CPLB59: MOVE TC,[POINT 6,NAMWRD+1]
JRST CPLB52 ;CONTINUE WITH THE SCAN
CPLB53: SOJLE TA,CPLB5X ;ERROR
PUSHJ PP,CPLBPP ;GET LHS
SKIPN TC
HLRZ TC,MYPPN## ;GET DEFAULT
HRLZM TC,NAMWRD+3 ;[1521] SAVE
CAIE TD,"," ;MUST BE COMMA
JRST CPLB5X ;ERROR
PUSHJ PP,CPLBPP ;GET RHS
SKIPN TC
HRRZ TC,MYPPN
HRRM TC,NAMWRD+3 ;[1521] SAVE IT
CAIN TD,"]" ;DID IT END CORRECTLY?
JRST CPLB55 ;YES
IFE TOPS20,<
CAIE TD,"," ;SFD?
JRST CPLB5X ;NO
MOVE TD,[LIBPTH+.PTSFD,,LIBPTH+.PTSFD+1]
SETZM LIBPTH+.PTSFD
BLT TD,LIBPTH+.PTSFD+6 ;CLEAN IT OUT
MOVEI TD,LIBPTH## ;SETUP SFD BLOCK POINTER
EXCH TD,LIBPP
MOVEM TD,LIBPTH+.PTPPN
MOVE TC,[POINT 6,LIBPTH+.PTSFD]
CPLBP2: SOJL TA,CPLB5X
ILDB TD,TB
CAIN TD,"," ;END OF THIS FIELD?
JRST CPLBP3 ;YES
CAIN TD,"]" ;END OF SFD?
JRST CPLB55 ;YES
CAIL TD,141 ;IS IT LOWER CASE?
CAILE TD,172 ;...
JRST .+2 ;NO
TRZA TD,100 ;CONVERT LOWER CASE TO SIXBIT
SUBI TD,40 ;CONVERT UPPER CASE TO SIXBIT
IDPB TD,TC
JRST CPLBP2
CPLBP3: HRLI TC,(POINT 6,) ;START AGAIN
AOJA TC,CPLBP2 ;ON NEXT WORD
>
CPLB5X: OUTSTR [ASCIZ /%Illegal file speciffication for /]
PUSHJ PP,STLB30
OUTSTR [ASCIZ / - continuing
/]
JRST CPLB55 ;AND CONTINUE
CPLBPP: SETZ TC,
CPLBP1: SOJL TA,CPLB5X ;ERROR IF WE RUN OUT OF DIGITS
ILDB TD,TB
CAIL TD,"0" ;TEST FOR DIGIT (RADIX 8)
CAILE TD,"7"
POPJ PP, ;NO, RETURN
LSH TC,3
IORI TC,-"0"(TD) ;BUILT NUMBER
JRST CPLBP1
CPLB77: ADDI TC,DEVSIZ ;INCREMENT TO NEXT
CAIGE TC,SRCEND ;ALL DONE?
JRST CPLB57 ;NOT YET
SKIPN TC,NAMWRD+2 ;DID USER SUPPLY A DEVICE?
MOVSI TC,'DSK' ;NO, ASSUME DSK
CPLB88: MOVEM TC,LIBDEV ;SET IT UP
MOVEM TC,LIBDV## ;SAVE FOR ERROR MESSAGE
CLOSE LIB, ;INCASE ITS OPEN
MOVSI TA,(1B0) ;VIRGIN RING BIT
IORM TA,LIBBH ;WHAT WE WANT IT TO BE
PUSH PP,LIBBH ;SAVE BUFFER HEADER
MOVEI TA,700
HRLZM TA,LIBBH+1 ;SETUP NO POINTER
PUSH PP,DA
PUSH PP,DC
PUSH PP,I0
PUSH PP,I1
PUSH PP,I2
PUSH PP,I3
PUSH PP,I4
MOVEI DA,LIBDEV
SETZ I1,
MOVEI I3,DEVBH(DA)
MOVEI DC,LIB
PUSHJ PP,OPENIT
LOOKUP LIB,I1
SETZM LIBDEV ;FAILED
POP PP,I4
POP PP,I3
POP PP,I2
POP PP,I1
POP PP,I0
POP PP,DC
POP PP,DA
POP PP,LIBBH
JRST CPLB0 ;SEE WHATS NEXT
CPLB1: CAIE TYPE,REPLA. ;IS IT 'REPLACING'?
JRST CPE286 ;NO, ERROR
IFN ANS74,<
SKIPE FLGSW## ;ARE WE CHECKING FIPS LEVEL?
PUSHJ PP,FLG.H ;YES, TEST AT HIGH LEVEL
>
CPLB2: AOS RPLCNT ;COUNT ONE MORE
MOVE TA,[CD.CPY,,1] ;GET 1 WORD FOR HEADER
PUSHJ PP,GETENT
SKIPN TB,RPLLOC ;FIRST TIME
JRST .+3
ADD TB,CPYLOC ;GET ADDRESS
HLRM TA,(TB) ;LINK IN
HLRZM TA,RPLLOC ;ADVANCE POINTER
PUSHJ PP,GETITM ;GET ITEM AFTER 'REPLACING'
; TLNE W1,GWRESV ;[1406] RESERVED WORD?
CAIE TYPE,EQUAL. ;[1406] IS ITEM AN '=' ?
CAIN TYPE,EQUAL.+AMRGN. ;[1406] POSSIBLY IN A-MARGIN
SKIPA ;[1406] YES, CONTINUE
JRST CPLB21 ;NO
CAIE CH,"=" ;LOOK AHEAD AND CHECK NEXT DELIMITER FOR ==
JRST CPLB21 ;ITS NOT
PUSHJ PP,GETITM ;GET RID OF ==
CAIE TYPE,EQUAL.+AMRGN. ;[1406]
CAIN TYPE,EQUAL.
JRST CPLB20
EWARNW E.605 ;[557] '==' PSEUDO-TEXT DELIMITERS INCORRECT
JRST CPYERR ;[557]
CPLB19: PUSHJ PP,PSTWRI ;WRITE ITEM
CPLB20: CAIN TYPE,PIC. ;PICTURE IS SPECIAL
PUSHJ PP,PSTPIC
PUSHJ PP,GETITM ;GET NEXT ITEM
CAIE TYPE,ENDIT. ;[1372] IS THIS THE END-OF-
CAIN TYPE,ENDIT.+AMRGN. ;[1372] FILE?
JRST CPB36A ;[1372] YES, SOMETHING IS WRONG.
TLNE W1,GWRESV ;RESERVED
CAIE TYPE,EQUAL. ;=
JRST CPLB19 ;NO
CAIE CH,"=" ;==
JRST CPLB19 ;NO
PUSHJ PP,GETITM ;YES, GET IT
HRRZ TA,CPYLOC
ADD TA,RPLNXW ;GET START OF LAST BLOCK
MOVEI TB,CONTF
ANDCAM TB,(TA) ;LAST ONE IS NOT CONTINUED
PUSHJ PP,GETITM ;GET NEXT ITEM
CAIN TYPE,BY. ;BETTER BE BY
JRST CPLB27 ;DONE
CPE124: EWARNW E.124 ;''BY' EXPECTED'
JRST CPYERR ;SKIP TO NEXT PARAGRAPH
;HERE IF NOT PSEUDO-TEXT
CPLB21: TLNE W1,GWLIT ;LITERAL
JRST CPLB22 ;YES
MOVSI TA,-5 ;MAX. WORD SIZE
SKIPE NAMWRD(TA) ;COUNT NO. OF WORDS
AOBJN TA,.-1 ; WITH THIS LOOP
AOJA TA,CPLB23 ;SIZE + 1 FOR COUNT
CPLB22: LDB TB,GWVAL ;GET LIT COUNT
ADDI TB,4
IDIVI TB,5
MOVEI TA,1(TB) ;GET SIZE + 1 FOR COUNT
CPLB23: HRRI W1,-1(TA) ;SIZE
HRLI TA,CD.CPY
PUSHJ PP,GETENT ;GET SPACE
MOVEM W1,0(TA) ;STORE FLAG ,, SIZE
HLRZM TA,RPLNXW ;INCASE WE NEED TO QUALIFY IT
HRLI TB,NAMWRD
TLNE W1,GWLIT
HRLI TB,LITVAL ;EITHER NAME OR LIT
HRRI TB,1(TA) ;BLT PTR
ADDI TA,(W1)
BLT TB,(TA) ;COPY IT
PUSHJ PP,GETITM ;WHAT'S NEXT
CAIN TYPE,BY. ;THE WORD 'BY'?
JRST CPLB27 ;YES
CAIE TYPE,IN. ;IN OR OF?
JRST CPE124 ;NOT THERE, TOO BAD
MOVE TA,RPLNXW ;GET LAST SUB-ITEM
ADD TA,CPYLOC
MOVEI TB,CONTF ;FLAG
IORM TB,(TA) ;MARK IT
PUSHJ PP,GETITM ;GET QUALIFYING NAME
JRST CPLB21 ;TRY AGAIN
CPLB27: MOVE TA,[CD.CPY,,2]
PUSHJ PP,GETENT ;GET SPACE FOR BYTE POINTER
HLRZM TA,RPLNXT ;SAVE INDEX
IFE TOPS20,<
MOVE CH,SRCBH+1 ;GET SOURCE BYTE POINTER
ADD CH,[070000,,0] ;BACKUP BYTE POINTER
SKIPGE CH ;OK, IN SAME WORD
SUB CH,[430000,,1] ;BACKUP TO NEXT WORD
>
IFN TOPS20,<
SETO CH,
ADJBP CH,SRCBH+1 ;BACKUP 1 BYTE
>
HLLZM CH,(TA) ;INITIAL PTR,,COUNT
MOVEM CH,RPLBH+1 ;SAVE IT
MOVE CH,SRCBH+2
ADDI CH,1 ;BACKUP COUNT ALSO
MOVEM CH,RPLBH+2 ;SAVE IT
MOVE CH,SAVECP
SUBI CH,1 ;POINT TO THIS NOT NEXT
MOVEM CH,R1CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
SUBI CH,1 ;POINT TO THIS NOT NEXT
MOVEM CH,R1CPI ;INPUT CHAR. POS.
SETOM RPLBH+0 ;SET FLAG FOR GETSR3
PUSHJ PP,GETITM ;NEXT ITEM
TLNE W1,GWRESV
CAIE TYPE,EQUAL. ;LOOK FOR =
JRST CPLB40 ;NO
CAIE CH,"=" ;LOOK FOR PSEUDO-TEXT
JRST CPLB40 ;NO, NEEDS ==
MOVE CH,SAVECP
MOVEM CH,R1CPO ;OUTPUT CHAR. POS.
MOVE CH,SAVELN ;[1013] SAVE LINE # ALSO
MOVEM CH,R1LNO## ;[1013] IN CASE MISSING ENDING ==
MOVE CH,INPTCP
MOVEM CH,R1CPI ;INPUT CHAR. POS.
PUSHJ PP,GETITM ;GET RID OF ==
PUSHJ PP,GETITM ;GET NEXT
TLNE W1,GWRESV
CAIE TYPE,EQUAL. ;LOOK FOR =
JRST CPLB34 ;NO
CAIE CH,"=" ;LOOK FOR PSEUDO-TEXT END
JRST CPLB34 ;NO, NEEDS ==
;NOW WE HAVE NULL REPLACEMENT
MOVE CH,R1CPO ;MAKE BEFORE
MOVEM CH,R2CPO ;= AFTER
MOVE CH,R1CPI
MOVEM CH,R2CPI
MOVE CH,RPLBH+2 ;GET PREV. COUNT
PUSH PP,SRCBH+2 ;SAVE CURRENT
MOVEM CH,SRCBH+2 ;SO WE CAN SAVE NO WORDS
PUSHJ PP,CPYSRC ;JUST SETUP HEADERS
POP PP,SRCBH+2 ;GET CHAR COUNT BACK
PUSHJ PP,GETITM ;BYPASS ==
PUSHJ PP,GETITM ;GET WHAT FOLLOWS
JRST CPLB45 ;AND CONTINUE
CPLB33: PUSHJ PP,GETITM ;GET NEXT
CPLB34: TLNN W1,GWRESV ;[***] IS IT A RESERVED WORD?
JRST CPLB33 ;[***] NO, SO IT CANNOT BE ==
CAIE TYPE,ENDIT. ;[1013] END-OF-FILE?
CAIN TYPE,ENDIT.+AMRGN. ;[1013]
JRST CPLB36 ;[1013] YES, GIVE ERROR
CAIE TYPE,EQUAL. ;LOOK FOR =
CAIN TYPE,EQUAL.+AMRGN. ;[***] POSSIBLY IN A-MARGIN
CAIE CH,"=" ;LOOK FOR PSEUDO-TEXT END
JRST CPLB33 ;NO, NEEDS ==
MOVE CH,SAVECP
MOVEM CH,R2CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R2CPI ;INPUT CHAR. POS.
MOVEI TB,2
ADDM TB,SRCBH+2 ;DON'T COUNT ==
PUSHJ PP,CPYSRC ;COPY UP TO ==
MOVNI TB,2
ADDM TB,SRCBH+2
MOVE TA,RPLNXT ;ALSO REMOVE FIRST ==
ADD TA,CPYLOC
HLLZ TB,(TA)
HRRI TB,2(TA) ;FORM BYTE PTR
SETZ TC,
CPLB35: ILDB CH,TB ;[1463] MAKE SURE WE ARE POSITIONED AT FIRST "="
DPB TC,TB ;[1463] CLEAR CHAR IN ANY CASE
CAIE CH,"=" ;[1463] GOT THERE YET?
JRST CPLB35 ;[1463] NO
IDPB TC,TB ;[1463] YES, REPLACE 2ND = BY NULL
PUSHJ PP,GETITM ;BYPASS ==
PUSHJ PP,GETITM ;GET WHAT FOLLOWS ==
JRST CPLB45
CPLB36:
IFN BIS,<
DMOVE LN,R1LNO ;[1013] GET LN & CP OF INITIAL ==
>
IFE BIS,<
MOVE LN,R1LNO ;[1013] GET LINE NUMBER
MOVE CP,R1CPO ;[1013] AND CP OF INITIAL ==
>
CPB36A: MOVEI DW,E.633 ;[1372][1013] TELL USER ABOUT MISSING ==
JRST FATAL ;[1013]
CPLB37: AOSA PARCNT ;COUNT ONE MORE "("
CPLB38: SOS PARCNT ;COUNT ONE LESS ")"
JRST CPLB40
CPLB39: PUSHJ PP,GETITM ;GET NEXT ITEM
CPLB40: SKIPE R3BH0 ;DID WE GET TO GETKAR?
JRST CPLB46 ;YES, JUST USE UP TO FIRST SPACE
MOVE CH,SRCBH+1 ;SAVE BYTE PTR AND COUNT
MOVEM CH,R2BH1
MOVE CH,SRCBH+2
MOVEM CH,R2BH2
MOVE CH,SRCBFC
MOVEM CH,R2BH0 ;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
MOVE CH,SAVECP
MOVEM CH,R2CPO ;OUTPUT CHAR. POS.
MOVE CH,INPTCP
MOVEM CH,R2CPI ;INPUT CHAR. POS.
CPLB41: PUSHJ PP,GETITM ;GET NEXT ITEM
CAIN TYPE,LPREN. ;SUBSCRIPTED?
JRST CPLB37 ;YES
CAIN TYPE,RPREN. ;")"
JRST CPLB38 ;YES, COUNT DOWN
SKIPE PARCNT ;IN SIDE PARENS?
JRST CPLB40 ;YES
CAIN TYPE,IN. ;QUALIFIED?
JRST CPLB39 ;GET QUALIFIER
MOVE TB,SRCBFC
CAME TB,R2BH0 ;DID SRC CHANGE BUFFERS?
JRST CPLB50 ;YES, ITS ALREADY STORED
PUSH PP,SRCBH+1 ;SAVE CURRENT BYTE PTR AND COUNT
PUSH PP,SRCBH+2
MOVE TB,R2BH1
MOVEM TB,SRCBH+1 ;REPLACE WITH ONE JUST AFTER ITEM
MOVE TB,R2BH2
MOVEM TB,SRCBH+2 ;SO WE DON'T COPY SPACES, COMMENTS ETC.
AOS SRCBH+2 ;REMOVE SPACE OR TERMINATOR
PUSHJ PP,CPYSRC ;COPY SOURCE
POP PP,SRCBH+2
POP PP,SRCBH+1
CPLB45: CAIE TYPE,PRIOD. ;[***] PERIOD?
CAIN TYPE,PRIOD.+AMRGN. ;[***] POSSIBLY IN A-MARGIN
JRST CPLB99 ;YES
SWON FREGWD ;REGET WORD AGAIN
JRST CPLB2 ;MUST BE ANOTHER REPLACING CLAUSE
CPLB46: MOVE CH,[R3BH0,,R2BH0] ;JUST USE UP TO FIRST SPACE
TSWF FGTPER ;DID WE ALSO SEE A PERIOD
HRLI CH,R4BH0 ;YES, BACKUP TO IT
BLT CH,R2CPI
JRST CPLB41
CPLB50: SETZM RPLBH+0 ;CLEAR COPY BUFFER FLAG
MOVE TA,RPLNXT ;GET REL LOC OF COUNT
ADD TA,CPYLOC ;FIX
HRRZ TB,0(TA) ;GET WHAT IT WAS
SUB TB,R2BH2 ;MINUS ORIGIN
SUBI TB,1 ;MINUS TERMINATOR
HRRM TB,0(TA) ;PUT BACK AS ALL WE NEED
MOVE TB,R1CPO ;SAVECP BEFORE
LSH TB,9
ADD TB,R1CPI ;INPTCP BEFORE
LSH TB,9
ADD TB,R2CPO ;SAVECP AFTER
LSH TB,9
ADD TB,R2CPI ;INPTCP AFTER
MOVEM TB,1(TA) ;SAVE POSITION COUNTS
JRST CPLB45
CPLB99: PUSHJ PP,SETLIB ;DONE, SET UP COPY & AND GET STARTED
MOVN TB,RPLCNT ;NO. OF POSSIBLE REPLACEMENTS
HRLZM TB,RPLCNT ;FORM AOBJN PTR
JUMPE TB,GETITM ;NO REPLACEMENTS POSSIBLE
SWON FRTST!FNOCPY ;SIGNAL TO MAKE REPLACEMENT CHECK
;AND DON'T LIST UNTIL CHECKED
MOVEI TB,1
MOVEM TB,RPLLOC ;POINT TO START
MOVEM TB,RPLNXT
ADDI TB,1 ;POINT TO FIRST WORD
MOVEM TB,RPLNXW
JRST GETITM ;GET FIRST ITEM FROM COPY AND RETURN
CPYSRC: SETZM RPLBH+0 ;CLEAR COPY BUFFER FLAG
MOVE TA,RPLNXT ;GET REL LOC OF COUNT
ADD TA,CPYLOC ;FIX
MOVE TB,RPLBH+2 ;GET CHAR. COUNT
SUB TB,SRCBH+2
ADDM TB,(TA) ;ADD TO WHATS ALREADY THERE
MOVE TB,R1CPO ;SAVECP BEFORE
LSH TB,9
ADD TB,R1CPI ;INPTCP BEFORE
LSH TB,9
ADD TB,R2CPO ;SAVECP AFTER
LSH TB,9
ADD TB,R2CPI ;INPTCP AFTER
MOVEM TB,1(TA) ;SAVE POSITION COUNTS
HRRZ TA,0(TA) ;GET CHAR. COUNT
JUMPE TA,CPOPJ ;RETURN IF 0
HRRZ TA,SRCBH+1
HRRZ TB,RPLBH+1
SUBI TA,-1(TB) ;GET SIZE IN WORDS
PUSH PP,TA
HRLI TA,CD.CPY
PUSHJ PP,GETENT
MOVE TC,TA
HRL TC,RPLBH+1 ;FORM BLT PTR
POP PP,TB
ADDI TB,(TA) ;END OF BLT
BLT TC,-1(TB) ;COPY ALL WE NEED
IFN BIS,<
DMOVE TC,SRCBH+1
DMOVEM TC,RPLBH+1
>
IFE BIS,<
MOVE TC,SRCBH+1
MOVE TB,SRCBH+2
MOVEM TC,RPLBH+1
MOVEM TB,RPLBH+2
>
POPJ PP,
PSTWRI: TLNE W1,GWLIT ;LITERAL?
JRST PSTWRL ;YES
MOVSI TB,-5 ;MAX. SIZE
SKIPE NAMWRD(TB) ;GET PART OF NAME
AOBJN TB,.-1 ;LOOP FOR REST OF NAME
AOJA TB,PSTWRW ;COUNT 1 FOR HEADER
PSTWRL: LDB TB,GWVAL ;GET LENGTH OF LIT
ADDI TB,4+5 ;ROUND UP
IDIVI TB,5 ;NO. OF WORDS
PSTWRW: HRRZ TA,TB
MOVE TB,W1
HRRI TB,CONTF-1(TA) ;SAVE WORD COUNT MINUS HEADER + FLAG
PUSH PP,TB
HRLI TA,CD.CPY
PUSHJ PP,GETENT ;GET SPACE FOR LITERAL OR PSEUDO-TEXT
POP PP,0(TA) ;STORE TYPE,,FLAG+WORD COUNT
HRRZ TB,CPYLOC
SUBI TA,(TB) ;GET REL ADDRESS
MOVEM TA,RPLNXW ;SO WE CAN FIXUP THE LAST
ADDI TA,(TB)
HRRZ TB,0(TA)
TRZ TB,CONTF ;GET LENGTH BACK
ADD TB,TA
EXCH TA,TB ;TB ORIGIN, TA END
ADDI TB,1
HRLI TB,NAMWRD ;FROM
TLNE W1,GWLIT
HRLI TB,LITVAL
SKIPE PICNXT ;[557] PIC TEXT?
HRLI TB,PICBUF ;YES
BLT TB,(TA) ;MOVE LITERAL
SETZM PICNXT ;[557] CLEAR PIC NEXT FLAG
POPJ PP,
PSTPIC: PUSHJ PP,PSCAN
SETOM PICNXT ;[557] MARK AS PIC TEXT
SETZ W1, ;[557] CLEAR FLAGS
TSWF FGTPER!FREGCH ;DID WE READ-AHEAD
DPB W1,PICPTR ;YES, REMOVE IT
MOVSI TB,-7
SKIPE PICBUF(TB)
AOBJN TB,.-1
AOJA TB,PSTWRW
;HERE TO SEE IF CURRENT ITEM SHOULD BE REPLACED
RPLTST: TSWF FRTST ;CHECKING THIS WORD
JRST PSTRD1 ;YES
HLRZ CT,W1
CAIN CT,GWRESV+PIC. ;IF THIS IS PICTURE
JRST GITM1A ;PASS DISCRIPTORS ALSO
SWON FRTST ;NO, BUT CHECK NEXT ONE
TSWTZ FREGCH!FGTPER ;DID WE LOOKAHEAD
JRST RPLTS1 ;[1022] NO, SO ALL OK
LDB CH,LIBBH+1 ;[1022] GET LAST CHAR READ IN CASE IT WAS LF
CAIE CH,$LF ;[1022] SO DON'T BACKUP CPYFIL (IT WASN'T WRITTEN)
PUSHJ PP,BKPCPY ;[1022] DELETE LAST CHARACTER OUTPUT TO CPYFIL
PUSHJ PP,BKPLIB ;[1022] BACKUP SOURCE IN LIBRARY BUFFER
IFN FT68274,<
PUSHJ PP,BKPCVT ;[1360] DELETE LAST CHARACTER OUTPUT TO CVT FILE
>
RPLTS1: PUSHJ PP,RPLSAV ;[1022] SAVE ITEMS NEEDED FOR REPLACEMENT TESTING
SWON FNOCPY ;TURN NO COPY BACK ON
JRST GITM1A ;RETURN AND PROCCESS WORD
RPLSAV: MOVE CT,RPLBLK
MOVEM CT,RPLBH+0 ;SAVE CURRENT BLOCK #
MOVE CT,LIBBH+1 ;GET BYTE PTR
MOVEM CT,RPLBH+1 ;SAVE IT
MOVE CT,LIBBH+2 ;AND COUNT
MOVEM CT,RPLBH+2
MOVE CP,INPTCP ;SAVE INPUT CHAR. POSITION
MOVEM CP,RPLICP
MOVE CP,SAVECP ;SAVE CHAR. POSITION
MOVEM CP,RPLCP
MOVE CT,RPLBLK ;YES
MOVEM CT,L1BH0 ;SAVE CURRENT LIBRARY BLOCK #
MOVE CT,LIBBH+1
MOVEM CT,L1BH1 ;BYTE POINTER
MOVE CT,LIBBH+2
MOVEM CT,L1BH2 ;CHAR. COUNT
MOVE CT,SAVECP
MOVEM CT,L1CPO ;OUTPUT CHAR. POS.
MOVE CT,INPTCP
MOVEM CT,L1CPI ;INPUT CHAR. POS.
POPJ PP,
PSTRD1: MOVE CT,RPLNXW ;GET NEXT WORD POINTER
ADD CT,CPYLOC ;PLUS BASE
MOVE TE,(CT) ;GET FLAGS & SIZE
TLNE W1,GWLIT ;LITERAL?
JRST PSTRD2 ;YES
TLNE TE,GWLIT ;NO, BUT IS TARGET?
JRST PSTRD8 ;YES, NO MATCH
TRNE TE,-1-CONTF ;IS SIZE 0
JRST PSTRD3 ;NO, OK UP TO NOW
XOR TE,W1 ;YES, SEE IF SAME (MUST BE "." "(" OR ")")
TLNN TE,-1 ;MATCH?
AOJA CT,PSTR3A ;YES, BYPASS W1 AND POINT TO BYTE PTR
JRST PSTRD8 ;NO
PSTRD2: XOR TE,W1 ;SAME SIZE & TYPE?
TLNE TE,-1^!GWALL ;[557] BUT ALLOW ALL IN EITHER LITERAL
JRST PSTRD8 ;NO
XOR TE,W1 ;YES, PUT SIZE BACK
PSTRD3: ANDI TE,37777 ;WORD SIZE ONLY
PUSH PP,TE ;[726] SAVE WORD COUNT
MOVN TE,TE
HRL CT,TE
ADDI CT,1 ;AOBJN PTR AT LAST
SKIPE PICNXT ;[557] PIC?
TROA W1,PICBUF ;YES
HRRI W1,NAMWRD
TLNE W1,GWLIT
HRRI W1,LITVAL ;FORM OTHER POINTER
MOVE TE,(CT) ;GET WORD
CAME TE,(W1) ;MATCH?
JRST PSTR8A ;[726] NO
ADDI W1,1 ;INCREMENT
AOBJN CT,.-4 ;LOOP
POP PP,TE ;[726] GET WORD COUNT BACK
CAIE TE,7 ;[726] CHECKED ALL WORDS?
TLNE W1,GWLIT ;[726] OR A LITERAL?
JRST PSTR3A ;[726] YES, THAT'S A MATCH
SKIPN PICNXT ;[726] IF PICTURE THEN 7 WORD MAX
CAIE TE,5 ;[726] 5 WORDS ONLY FOR DATA-ITEMS
TRNA ;[726] NO
JRST PSTR3A ;[726] ITS A MATCH
SKIPE (W1) ;[726] NEXT WORD ZERO?
JRST PSTRD8 ;[726] NO, NO MATCH THEN
PSTR3A: SETZM PICNXT ;[557] CLEAR PIC FOLLOWING FLAG
MOVE TE,INPTST ;GET START OF ITEM
SKIPN RPLCST ;FIRST TIME?
MOVEM TE,RPLCST ;SO WE KNOW IF IN A OR B MARGIN
MOVE TE,RPLNXW ;TOTAL MATCH
ADD TE,CPYLOC
MOVE TE,(TE) ;SEE IF MORE TO TEST
TRNN TE,CONTF
JRST PSTRD4 ;NO
SETZM L2BH0 ;INCASE WE DON'T GET TO GETKAR
HLRZ CT,TE
ANDI TE,377777 ;YES
ADDI TE,1 ;HEADER WORD ALSO
ADDM TE,RPLNXW ;INCREMENT POINTER
SETOM CPYRMW## ;[1023] SIGNAL WE ARE ABOUT TO READ MORE WORDS
CAIE CT,GWRESV+PIC. ;IS NEXT A PICTURE?
JRST GETITM ;NO
PUSHJ PP,PSCAN ;YES, GET IT
SETOM PICNXT ;[557] SIGNAL PICTURE
SETZ W1, ;[557] CLEAR FLAGS
TSWF FGTPER!FREGCH ;DID WE READ-AHEAD
DPB W1,PICPTR ;YES, REMOVE IT
JRST PSTRD1 ;TRY IT
PSTRD4: SWOFF FRTST!FECOPY ;[1023] TURN OFF END-OF-FILE SEEN AND REPLACEMENT TEST IN EFFECT
SKIPN NCPYSW ;OK TO OUTPUT TO CPYFIL NOW
SWOFF FNOCPY ;UNLESS FORBIDDEN AT A HIGHER LEVER
HLRZ TE,TE ;GET W1 STORED
CAIE TE,GWRESV.+PRIOD. ;WAS LAST MATCH FOR A PERIOD?
JRST PSTR4E ;NO
SWOFF FREGCH!FGTPER ;YES, WE WANT TO BYPASS IT
PUSHJ PP,SVLKAR ;GO SETUP WITH CURRENT VALUES
IBP L2BH1 ;BUT WE WANT NEXT CHAR
SOS L2BH2
AOS L2CPO ;AND FOR CHAR. POS
AOS L2CPI
PSTR4E: SETZM PADCNT ;ASSUME NO PADDING
MOVE TE,(CT) ;GET BYTE PTR & COUNT
HRRZM TE,RPLBH+2
HLLZM TE,RPLBH+1 ;STORE LHS OF POINTER
SKIPN TE,L2BH0 ;DID GETKAR SETUP FIRST SPACE
JRST [PUSHJ PP,SVLKAR ;NO, GO SETUP WITH CURRENT
JRST PSTR4A]
TSWT FGTPER ;YES, BUT DID WE SEE A PERIOD ALSO?
JRST PSTR4D ;NO
MOVE CH,L2BH1 ;GET BYTE PTR
ADD CH,[070000,,0]
SKIPGE CH
SUB CH,[430000,,1]
MOVEM CH,L2BH1 ;BACKUP 1 CHAR
AOS L2BH2
SOS L2CPO ;BACKUP CHAR. POS.
SOS L2CPI
PSTR4D: CAMN TE,RPLBLK ;YES, SAME BLOCK?
JRST PSTR4A ;YES
MOVEM TE,RPLBLK ;NO, SAVE WHAT IT WILL BE
USETI LIB,(TE)
IN LIB,
PSTR4A: SKIPA TE,L2BH1 ;OK
JRST GETLB9
MOVEM TE,LIBBH+1 ;SET BYTE PTR
MOVE TE,L2BH2
MOVEM TE,LIBBH+2 ;BYTE COUNT
MOVE CP,L1CPI ;GET FIRST CHAR.
CAIE CP,7 ;START OF NEW LINE?
JRST PSTR4F ;NO
MOVE CP,RPLCST ;YES, WHICH MARGIN?
CAIGE CP,^D12 ;"B"?
JRST PSTR4F ;NO
MOVEI CP,5
MOVEM CP,PADCNT
MOVEI CH," "
PUSHJ PP,PUTCPY ;OUTPUT 4 SPACES
SOSLE PADCNT
JRST .-3
MOVEI CP,^D12 ;RESET TO "B" MARGIN
MOVEM CP,L1CPI
MOVEM CP,L1CPO
PSTR4F: MOVE CP,L1CPI
MOVEM CP,INPTCP ;RESTORE INPUT PTR
MOVE CP,L1CPO
MOVEM CP,SAVECP ;RESTORE OUTPUT (SHOULD NOT HAVE CHANGED)
MOVE TD,1(CT) ;[1020] GET COUNTS
SETZ TE, ;[1020]
LSHC TE,9 ;[1020]
MOVEM TE,R1CPO ;[1020] SAVECP BEFORE
SETZ TE, ;[1020]
LSHC TE,9 ;[1020]
MOVEM TE,R1CPI ;[1020] INPTCP BEFORE
LSH TD,-9 ;[1020]
HLRZM TD,R2CPO ;[1020] SAVECP AFTER
LSH TD,-9 ;[1020]
ANDI TD,777 ;[1020]
MOVEM TD,R2CPI ;[1020] INPTCP AFTER
MOVE CP,R1CPO ;GET WHERE OUTPUT STARTS FOR REPLACEMENT
ADD CP,RPLBH+2 ;WHERE IT ENDS
CAIL CP,CPMAXN ;[1015] WOULD LINE BE TOO LONG?
JRST PSTR4C ;[1015] YES, START NEW ONE
TSWF FSEQ ;[1015] IF SEQUENCED INPUT WORRY ABOUT RIGHT MARGIN
CAIGE CP,^D73 ;[1015] ARE WE IN THE COMMENT FIELD?
SKIPA CP,SAVECP ;[1015] NO, WHERE WE ARE NOW
JRST PSTR4C ;YES, TOO BAD
ADD CP,RPLBH+2
CAIG CP,^D72 ;WILL THAT TAKE US INTO COMMENT FIELD?
JRST PSTRD5 ;NO, JUST REPLACE WHERE WE ARE
TSWF FSEQ ;[1015] IF NOT SEQUENCED THEN THE LINE IS LONGER
JRST PSTR4C ;[1015] SEQUENCED, TOO BAD
CAIGE CP,CPMAXN ;[1015] WOULD LINE STILL BE TOO LONG?
JRST PSTRD5 ;[1015] NO
PSTR4C: MOVE CP,R1CPO ;GET REPL. START
SUB CP,SAVECP ;GET DIFF BETWEEN LIBRARY AND REPLACEMENT
JUMPLE CP,[MOVEI CH,$LF ;THIS COULD BE A PROBLEM IF LINE IS LONG
PUSHJ PP,PUTCPY ;SO START NEW LINE
MOVE TE,R1CPI ;[557] RESET INPUT POINTER
MOVEM TE,INPTCP ;[557] SO WE KNOW IF IN COL 72 ETC.
JRST PSTR4C] ;AND PAD OUT TO WHERE REPLACEMENT TEXT IS
MOVEM CP,PADCNT ;STORE NO. OF PAD SPACES
PSTRD5: SKIPN TE,RPLBH+2 ;CHAR COUNT
JRST PSTRD6 ;JUST NULL
ADDI TE,5+4 ;+ 1 WORD + FUDGE FACTOR FOR SAFETY
IDIVI TE,5
ADDI CT,2 ;POINT TO TEXT
HRLI CT,PSTBUF
MOVS CT,CT ;BLT PTR
HRRM CT,RPLBH+1 ;COMPLETE BYTE POINTER
ADDI TE,(CT)
BLT CT,-1(TE) ;MOVE DATA TO SAFE PLACE
PSTRD6: SWON FCOPY ;SIGNAL REPLACING
SWOFF FREGCH!FGTPER ;NOT FOR REPLACEMENT
MOVE CP,INPTCP
MOVEM CP,RPLICP
MOVE CP,SAVECP
MOVEM CP,RPLCP ;SAVE CHAR. POSITIONS
MOVEI TE,2 ;[704] REINITIALIZE POINTER
MOVEM TE,RPLNXW ;[704] TO POINT TO FIRST AVAILABLE ITEM
SETZM TERSCN ;[657] CLEAR SINCE WE ARE NOT READING SAME SOURCE
JRST GETITM ;GO GET IT
PSTR8A: POP PP,TE ;[726] RESTORE STACK
PSTRD8: SETZM PICNXT ;[557] CLEAR PIC FOLLOWING FLAG
SETZM RPLCST ;CLEAR FIRST INPTST COUNTER
MOVE CT,RPLNXT ;GET BASE OF THIS TEST
ADD CT,CPYLOC ;FIX IN CORE
SKIPN CT,0(CT) ;GET OFFSET OF NEXT TEST
JRST PSTRD9 ;NO, MORE
MOVEM CT,RPLNXT ;POINT TO IT
ADDI CT,1 ;AND TO DATA ITEM
MOVEM CT,RPLNXW
SKIPN CPYRMW ;[1023] DID WE READ MULTIPLE WORDS?
JRST PSTRD1 ;[1023] NO,TRY AGAIN
TRNA ;[1023] YES, WE MUST BACKUP FIRST
PSTRD9: SETZM CPYRMW ;[1023] USE THIS TO SIGNAL FAILED TO FIND MATCH
MOVE TE,RPLBH+0 ;GET ORIGINAL BLOCK NUMBER
CAMN TE,RPLBLK ;SAME AS CURRENT?
JRST PSTR10 ;YES
MOVEM TE,RPLBLK ;THIS WILL SOON BE CURRENT
USETI LIB,(TE) ;NO, RESET ON OLD BLOCK
IN LIB,
PSTR10: SKIPA TE,RPLBH+1 ;OK, GET BYTE PTR
JRST GETLB9 ;ERROR
MOVEM TE,LIBBH+1 ;RESET IT
MOVE TE,RPLBH+2
MOVEM TE,LIBBH+2 ;SAME FOR COUNT
MOVE CP,RPLICP
MOVEM CP,INPTCP
MOVE CP,RPLCP ;RESTORE CP
MOVEM CP,SAVECP
SWOFF FREGCH!FREGWD!FGTPER!FECOPY ;[1023]
SKIPE CPYRMW ;[1023] ARE WE JUST RESTORING THE SOURCE?
JRST PSTR12 ;[1023] YES, THEN WE WILL TRY TO MATCH SOME MORE
SWOFF FNOCPY!FRTST ;[1023] NO, RESET FLAGS SO REAL READ TAKES PLACE
MOVE TE,RPLLOC ;POINT TO START
MOVEM TE,RPLNXT
ADDI TE,1 ;POINT TO FIRST WORD
MOVEM TE,RPLNXW
PSTR12: SETZM CPYRMW ;[1023] CLEAR COUNTER
JUMPN CP,PSTR11 ;[1001] OK IF IN MIDDLE OF LINE
PUSHJ PP,GETSEQ ;WORRY ABOUT SEQ NUMBER
SWON FREGCH ;REGET LAST CHAR
PSTR11: TLNE W1,GWALL ;[1001] WAS "ALL" SEEN BEFORE CURRENT ITEM?
JRST GITM34 ;[1001] YES, RESET FLAG AGAIN
JRST GETITM ;GET ITEM AGAIN
BKPLIB: AOS LIBBH+2 ;COUNT LAST CHAR
SOS INPTCP
MOVE TE,LIBBH+1
ADD TE,[070000,,0]
SKIPGE TE
SUB TE,[430000,,1]
MOVEM TE,LIBBH+1 ;BACKUP BYTE PTR
SOS CP,SAVECP ;BACKUP CPYFIL POSITION
POPJ PP,
BKPCPY: TSWF FNOCPY ;DID WE WRITE TO CPYFIL?
POPJ PP, ;NO
AOS CPYBHO+2 ;COUNT LAST CHAR
MOVE TE,CPYBHO+1
ADD TE,[070000,,0]
SKIPGE TE
SUB TE,[430000,,1]
MOVEM TE,CPYBHO+1 ;BACKUP BYTE PTR
POPJ PP,
IFN FT68274,<
BKPCVT: TSWF FNOCPY ;[1360] DID WE WRITE TO CVT FIEL?
POPJ PP, ;[1360] NO
AOS CVTBFC ;[1360] COUNT LAST CHAR
MOVE TE,CVTBFP ;[1360]
ADD TE,[070000,,0] ;[1360]
SKIPGE TE ;[1360]
SUB TE,[430000,,1] ;[1360]
MOVEM TE,CVTBFP ;[1360]
POPJ PP, ;[1360]
>
CPE285: EWARNW E.285 ;YES, ILLEGAL LIBRARY-NAME
JRST CPYERR ;SKIP REST OF PARAGRAPH
CPE286: EWARNW E.286 ;'COPY STATMENT MUST END WITH PERIOD'
; JRST CPYERR ;SKIP REST OF PARAGRAPH
CPYERR: PUSHJ PP,CLRCPY ;CLR CPYTAB AS IF COPY IS ALL FINISHED (IT IS)
SWOFF FNOCPY ;TURN OFF 'NO LISTING' FLAG
TRZ FGTPER ; DON'T GET PERIOD FROM GETITM
PUSHJ PP,SKPPGF ;SKIP TO END OF PARAGRAPH
PUSHJ PP,GETITM ;GET A SOURCE ITEM
SWON FREGWD ;SET REGET WORD BIT
POPJ PP,
;SKIP TO END OF PARAGRAPH
;THE TRICK IS TO FIND A CHARACTER IN THE A-FIELD THAT IS NOT
;EITHER A SPACE, TAB, OR HYPHEN
;(ASTERISKS ARE FILTERED OUT AT A MUCH EARLIER STAGE)
SKPPGF: PUSHJ PP,SKPSRC ;GET NEXT SOURCE CHAR.
CAIN CP,7 ;ALREADY AT COLUMN 7?
JRST ENDB ;YES, WHAT KIND OF CHAR.?
CAIGE CP,^D12 ;IN B-FIELD?
JRST ENDB.2 ;NO, MUST BE IN A-FIELD
ENDPAR: PUSHJ PP,SKPSRC ;GET CHARACTER
ENDB: TSWF FEOF ;END-OF-FILE?
JRST END2 ;EOF FOUND
CAIE CP,7 ;COLUMN 7?
JRST ENDPAR ;NO, GET TO NEXT LINE
CAIE CH," " ;YES, SPACE?
JRST ENDPAR ;NO, MUST BE A HYPHEN
ENDB.1: PUSHJ PP,SKPSRC ;GET CHARACTER
TSWF FEOF ;END-OF-FILE?
JRST END2 ;YES
CAIL CP,^D12 ;INTO B-FIELD YET?
JRST ENDB ;YES, SKIP REST OF LINE
ENDB.2: CAIN CH," " ;IS IT A SPACE?
JRST ENDB.1 ;YES
CAIL CH,"a" ;ABOVE LOWER CASE A?
MOVEI CH,-40(CH) ;YES MOVE IT INTO THE UPPER CASE SET.
CAIL CH,"A" ;IS IT ALPHABETIC?
CAILE CH,"Z"
JRST ENDB ;NOT A LETTER
END2: TRZ SW,FREGWD+FGTPER+FNEEDS ;CLR OTHER FLAGS
JRST REGLST ;REGET THE LAST CHARACTER
;GET A CHARACTER FROM THE LIBRARY FILE
GETLIB: TSWF FCOPY ;COPYING FROM REPLACEMENT BUFFER?
JRST GETCPY ;YES
TSWFZ FREGCH ;REGET A CHARACTER?
JRST REGETL ;YES
GETLB1: SOSG LIBBH+2 ;NO--GET NEXT CHARACTER
JRST GETLB4
GETLB2: IBP LIBBH+1
MOVE CH,@LIBBH+1 ;IS THIS A LINE-NUMBER WORD?
TRNN CH,1
JRST GETLB3 ;NO
JUMPL CH,GETLB5 ;END OF PROGRAM?
MOVNI CH,5 ;NO--JUMP OVER 5 CHARACTERS
ADDB CH,LIBBH+2
JUMPLE CH,GETLB1 ;JUMP IF BUFFER NOW EMPTY
AOS LIBBH+1 ;IT ISN'T--BUMP BYTE POINTER
GETLB3: LDB CH,LIBBH+1
JUMPE CH,GETLB1
IFN FT68274,<
CAIE CH,$LF ;THERE ARE NO CARRIAGE-RETURNS IN LIB FILE
CAIN CH,$FF ;SO CHECK FOR LINE-FEED & FORM-FEED
TSWF FNOCPY ;[1360] YES, BUT IGMORE IF JUST DOING
;[1360] REPLACEMENT CHECK
JRST GETSL ;NO
PUSH PP,CH ;YES, SAVE IT
LDB CH,CVTBFP ;GET LAST CHAR
CAIN CH,$CR ;JUST IN CASE IT WAS
JRST GETLB6 ;IT WAS
MOVEI CH,$CR
SOSL CVTBFC ;IF THIS FAILS SO WILL $LF
IDPB CH,CVTBFP ;STORE $CR
GETLB6: POP PP,CH ;RESTORE $LF OR $FF
>
JRST GETSL
GETLB4: AOS RPLBLK ;INCREMENT CURRENT BLOCK
IN LIB, ;GET ANOTHER BUFFER FULL
JRST GETLB2
GETSTS LIB,CH ;END-FILE?
TRNE CH,IO.ERR
JRST GETLB9 ;NO--TROUBLE
GETLB5: SETOM LIBBH+2 ;[557] FORCE COUNT FINISHED
TSWF FCOPY ;STILL DOING REPLACEMENTS
JRST [MOVSI CH,(FECOPY) ;YES
IORM CH,RPLFLG ;MARK IT FOR AFTER COPY
JRST GTBLNK] ;BUT WE STILL NEED LIBRARY
SWON FECOPY ;SET "CLEAN UP COPY" INDICATOR
TSWT FRTST ;[1023] JUST DOING REPLACEMENT CHECK?
SWOFF FRLIB
; SWOFF FPERWD ;[1125] TURN OFF FLAG TO RETURN NON-EXISTENT PERIOD
JRST GTBLNK
GETLB9: MOVEI CH,LIBDEV ;ERROR ON LIBRARY DEVICE
JRST DEVDED
REGETL: LDB CH,LIBBH+1
JUMPE CH,GETLB1
CAIN CH,177 ;[557] JUST INCASE WE READ END OF PROGRAM -1
MOVEI CH," " ;[557] YES, RETURN A SPACE TO AVOID ERROR
POPJ PP,
;GET A CHARACTER FROM THE REPLACEMENT BUFFER
GETCPY: TSWFZ FREGCH ;REGET A CHARACTER?
JRST REGETC ;YES
GETCP0: SOSGE PADCNT ;[557] PADDING NEEDED?
JRST GETCP1 ;[557] NO
MOVEI CH," " ;[557]
PUSHJ PP,PUTCPY ;[557] PAD WITH BLANKS
AOS INPTCP ;[557] COUNT AS INPUT CHARACTER
JRST GETCP0 ;[557]
GETCP1: SOSGE RPLBH+2 ;NO--GET NEXT CHARACTER
JRST GETCP4
IBP RPLBH+1
MOVE CH,@RPLBH+1 ;IS THIS A LINE-NUMBER WORD?
TRNN CH,1
JRST GETCP3 ;NO
MOVNI CH,5 ;JUMP OVER 5 CHARACTERS
ADDB CH,RPLBH+2
JUMPLE CH,GETCP1 ;JUMP IF BUFFER NOW EMPTY
AOS RPLBH+1 ;IT ISN'T--BUMP BYTE POINTER
GETCP3: LDB CH,RPLBH+1
JUMPE CH,GETCP1
JRST GETSL
REGETC: LDB CH,RPLBH+1
JUMPE CH,GETCP1
POPJ PP,
GETCP4: SWOFF FCOPY ;TURN OFF REPLACING REQUIRED
IOR SW,RPLFLG ;RESTORE OLD FLAGS
SETZM RPLFLG
TSWF FECOPY ;PREVIOUSLY SEEN END OF LIBRARY?
JRST GETCP5 ;YES
SWOFF FREGCH!FGTPER
;[1064] Check for "." and line-feed as only remaining characters in the
;[1064] input library member line before splitting the line in the output
;[1064] listing. We have to look ahead 2 characters.
IFN DEBUG,<
SKIPG LIBBH+2 ;Can we look ahead?
HALT . ;No, give error so I can fix it.
>
MOVE CH,LIBBH+1 ;[1064] Get byte pointer to library buffer.
ILDB CH,CH ;[1065] Look ahead to next character.
CAIE CH,"." ;[1064] Is it a "."?
JRST GTCP4L ;[1064] No, go on to check for split line.
IFN DEBUG,<
MOVE CH,LIBBH+2 ;Can we look ahead
SOSGE CH ;2 characters?
HALT . ;No, give error so I can fix it.
>
MOVE CH,LIBBH+1 ;[1064] Get byte pointer to library buffer again.
IBP CH ;[1064] Need to look 2 ahead now.
ILDB CH,CH ;[1064] Get the character 2 ahead.
CAIE CH,$LF ;[1517] [1064] Is the next char. a line-feed?
JRST GTCP4L ;[1517] No, go split the line
; JRST [TSWF FCLAS1 ;[1125] Yes, are we processing numeric literal?
; SWON FPERWD ;[1125] Yes, set flag to return non-existent period
; JRST GETLIB] ;[1125] [1064] Go pick up a "." for list.
MOVEI CH,"." ;[1440] STORE PERIOD SO WE WILL STOP SCAN
MOVEM CH,TERSCN ;[1440] ON PERIOD IN CASE OF NUMERIC LITERAL
JRST GETLIB ;[M1125] [1064] Yes, go pick up a "." for real.
;[1064] No, go to do split-line stuff
GTCP4L: MOVE CP,L2CPI ;GET NEXT CHAR. POS.
SUB CP,INPTCP ;SEE IF IT WILL FIT ON THIS LINE
JUMPL CP,GTCP4Z ;NO, START NEW LINE
JUMPE CP,GTCP4A ;NO PROBLEM
MOVEM CP,PADCNT ;SAFE PLACE FOR COUNT
MOVEI CH," "
PUSHJ PP,PUTCPY ;PAD WITH BLANKS
SOSLE PADCNT
JRST .-3
GTCP4A: MOVEI CH,"."
TSWF FGTPER ;NEED PERIOD?
PUSHJ PP,PUTCPY ;YES, SO PUT ON CPYFIL
LDB CH,LIBBH+1 ;GET LAST CHAR.
TSWF FREGCH ;NEED IT
PUSHJ PP,PUTCPY
MOVE CP,SAVECP
ADDI CP,1 ;INPUT IS 1 AHEAD STILL
MOVEM CP,INPTCP
JRST GETLIB ;GET NEXT CHAR. FROM LIBRARY
;[1065] We have to check for end of library copy member in COPY REPLACING,
;[1065] as well as in vanilla COPY, otherwise COPY REPLACING will overflow
;[1065] into the next available library copy member.
GTCP4Z: SKIPG LIBBH+2 ;Can we look ahead?
IFE DEBUG,<
JFCL ;No, ignore problem for now
>
IFN DEBUG,<
HALT . ;No, give error so I can fix it.
>
MOVE CH,LIBBH+1 ;[1065] Get byte pointer to library buffer.
ILDB CH,CH ;[1065] Look ahead to next character.
CAIN CH,177 ;[1065] From -1 terminator word?
JRST GETLB5 ;[1065] Yes, go put "." in output and clean up end of copy.
MOVEI CH,$LF ;START NEW LINE
PUSHJ PP,PUTCPY
SETZM INPTCP ;RESET INPUT POS.
AOS INPTCP ; TO 1
IFN FT68274,<
PUSHJ PP,CVTCRL ;[1360] ADD CR-LF TO CURRENT LINE
PUSHJ PP,CVTOAL ;[1360] AND OUTPUT IT
>
JRST GTCP4L ;TRY AGAIN
GETCP5: MOVEI CH,"." ;RETURN A PERIOD
TSWT FGTPER ;UNLESS PERIOD NOT NEEDED
MOVEI CH," " ;IN WHICH CASE RETURN SPACE
JRST PUTCIF ;PUT ON LISTING ALSO
;GET A LIBRARY PROGRAM.
;ENTER WITH CP SET TO PERIOD TERMINATING THE COPY CLAUSE,
; CPYW2 POINTING TO "COPY", AND PROGRAM-NAME IN LIBNAM.
SETLIB: SETZM REGKAR
TSWTZ FREGCH ;CHARACTER TO REGET?
JRST SETLB2 ;NO
SKIPN SRCDEV ;[352] ANY MORE SOURCE CHARS?
JRST SETLB2 ;[352] NO, NO CHAR TO REGET EVER.
LDB TE,SRCBH+1 ;YES--PICK IT UP
MOVEM TE,REGKAR
TSWT FSEQ ;SEQUENCED FILE?
JRST SETLB1 ;NO
MOVE CP,SAVECP ;GET CHAR. POS
CAILE CP,^D72 ;IN COMMENT FIELD
JRST SETLB2 ;YES, JUST LEAVE CHAR ALONE
SETLB1: MOVSI TE,7B<^D18+5>
ADDM TE,CPYBHO+1
AOS CPYBHO+2
SETLB2: MOVE CP,SAVECP
MOVEM CP,CPYCP ;SAVE CHARACTER POSITION
IFN FT68274,<
PUSHJ PP,CVTCRL ;ADD CR-LF TO CURRENT LINE
PUSHJ PP,CVTOAL ;OUTPUT LINE CONTAINING COPY VERB
PUSHJ PP,CVTDPL ;REALLY PUT IT OUT
MOVE TD,[POINT 7,CPLCV1] ;COPY MESSAGE
PUSHJ PP,CVTTPL ;TO PREVIOUS LINE BUFFER
MOVE TD,CVTPLB ;SEE IF SOS LINE NO.
TRNN TD,1
SETZ TD, ;NO
MOVEM TD,CVTSEQ## ;STORE SEQ NO. OR ZERO
SETZM CVTCCF ;STOP COMMENTING THIS
SETZM CVTCPF ;[1505] LINE ALREADY IS A COMMENT
SETZM CVTCAL ; AND ALL FUTURE LINES
MOVE TD,[POINT 7,CVTLBF,6] ;[1304]
MOVEM TD,CVTSCP ;[1304] LDB POINTER TO START OF CURRENT LINE
MOVEM TD,CVTSNP ;[1304] RESET NEXT WORD POINTER ALSO
>
SKIPN LIBDEV ;IS THERE A LIBRARY FILE?
JRST STLB20 ;NO--WE LOSE
USETI LIB,1 ;GET READY TO READ ROUGH TABLE
IN LIB, ;READ ROUGH TABLE
SKIPA TC,LIBNAM ;PICK UP LIBRARY ROUTINE NAME
JRST SETLBE ;[655] ERROR
MOVE TB,LIBNAM+1
LSHC TC,-6
TRZ TB,-1
LSH TB,-1
MOVE TA,LIBBH+1 ;SET TA TO POINT TO ROUGH-TABLE
IFN BIS,<
DMOVE TE,1(TA) ;COMPARE LIBNAM TO FIRST ENTRY
>
IFE BIS,<
MOVE TE,1(TA) ;COMPARE LIBNAM TO FIRST ENTRY
MOVE TD,2(TA)
>
PUSHJ PP,SETLBC
CAIA ;EQUAL
JRST SETLB4 ;GREATER
MOVEI TE,2 ;LESS
JRST SETL5A
SETLBE: GETSTS LIB,CH ;[655] GET ERROR STATUS
TRNN CH,IO.ERR ;[655] END-OF-FILE?
OUTSTR [ASCIZ /Premature end-of-file found on library file
/]
JRST GETLB9 ;[655] CONTINUE WITH STANDARD ERROR MESSAGE
;SEARCH ROUGH-TABLE
SETLB4: ADDI TA,2
IFN BIS,<
DMOVE TE,1(TA)
>
IFE BIS,<
MOVE TE,1(TA)
MOVE TD,2(TA)
>
PUSHJ PP,SETLBC
JRST SETLB5
JRST SETLB4
SKIPA TE,0(TA) ;ITEM FOUND--GET ADDRESS
SETLB5: MOVE TE,2(TA)
TLZ TE,777700
LSH TE,-7
ADDI TE,1
;AN APPROPRIATE ROUGH-TABLE ENTRY HAS BEEN LOCATED.
SETL5A: USETI LIB,(TE) ;READ IN FINE-TABLE
IN LIB,
SKIPA TA,LIBBH+1 ;SET UP AN IOWD TO FINE TABLE
JRST SETLBE ;[655] ERROR
HRLI TA,-^D64
;SEARCH THE FINE TABLE
SETLB6:
IFN BIS,<
DMOVE TE,1(TA)
>
IFE BIS,<
MOVE TE,1(TA)
MOVE TD,2(TA)
>
PUSHJ PP,SETLBC
JRST SETLB8
AOJA TA,SETLB7
JRST STLB21
SETLB7: AOBJN TA,SETLB6
JRST STLB21
;PROGRAM FOUND
SETLB8: MOVSI TE,(FSEQ)
AND TE,SW ;PRESERVE STATE OF FSEQ
MOVEM TE,CPYFLG
SETZM RPLFLG ;[557] CLEAR REPLACEMENT FLAG ALSO
SWOFF FSEQ ;TURN IT OFF
MOVE TE,2(TA)
TLZE TE,40 ;LIBRARY SEQUENCED?
SWON FSEQ
TLZ TE,777700
LSHC TE,-7
ADDI TE,1
HRRZM TE,RPLBLK ;STORE PTR TO CURRENT BLOCK
HRRZM TE,RPLBH ;PTR TO INITIAL BLOCK
USETI LIB,(TE)
IN LIB,
AOSA LIBBH+2
JRST SETLBE ;[655] ERROR
MOVEI TE,0
LSHC TE,7
ADDM TE,LIBBH+1
IMULI TE,5
MOVNS TE
ADDM TE,LIBBH+2
SWON FRLIB
MOVEI CH,$LF
SETL8A: PUSHJ PP,PUTCPY ;PUT LF IN CPY FILE SO LISTING LOOKS OK
PUSHJ PP,GETSEQ ;FORCE FIRST LIBRARY CHAR TO START ON NEW LINE.
;ALSO, PASS OVER ANY COMMENTS
SKIPN RPLCNT ;ANY REPLACEMENTS TO DO?
JRST REGLST ;[156] NO, GET BACK THIS FIRST CHAR LATER
TSWTZ FREGCH ;[1022] IF FREGCH IS ON THEN MAYBE WE JUST SAW CR-LF
JRST SETLB9 ;[1022] NO, SO ALL OK
LDB CH,LIBBH+1 ;[1022] GET LAST CHAR READ IN CASE IT WAS LF
CAIE CH,$LF ;[1022] SO DON'T BACKUP CPYFIL (IT WASN'T WRITTEN)
SETLB9: PUSHJ PP,BKPCPY ;[1022] DELETE LAST CHARACTER OUTPUT TO CPYFIL
;[1063] When we begin a new line under COPY REPLACING usually we just
;[1063] back up one character in the library buffer and march on.
;[1063] However, with procedure division paragraph names and 01 level numbers
;[1063] there are some problems with synchronization.
LDB CH,LIBBH+1 ;[1063] Get current char. from lib buffer
CAIN CH,$LF ;[1063] Is it a line-feed?
JRST SETL8A ;[1063] Yes, put it out to output buffer
TSWF FRLIB ;No, did the copy library end already?
JRST [PUSHJ PP,BKPLIB ;[1063] No, back up lib buffer
JRST RPLSAV] ;[1063] Save required items and return
SWOFF FECOPY ;Cleanup the flags
SETZM RPLCNT ;Things work better if not replacing
POPJ PP, ;Just return
SETL9B: MOVE CT,PHASEN ;[1063] Find if we are in DATA DIVISION.
CAIN CT,"C" ;[1063]
TSWF FLETTR ;[1063] Yes, but if it contains a non-digit it is not a level number.
PUSHJ PP,BKPCPY ;[1063] Back up the output COPY buffer.
PJRST RPLSAV ;SAVE REQUIRED ITEMS AND RETURN
;GET A LIBRARY PROGRAM (CONT'D).
;ERRORS
;NO LIBRARY FILE
STLB20: OUTSTR [ASCIZ "%Library file "]
PUSHJ PP,STLB30 ;PRINT DEV:FILE.EXT
OUTSTR [ASCIZ " not found - continuing
"]
MOVEI DW,E.75
MOVE CP,LIBHDR ;[557] GET LIBRARY NAME
CAME CP,['LIBARY'] ;[557] JUST THE DEFAULT
MOVEI DW,E.607 ;[557] NO, THEREFORE WE FAILED TO FIND IT
JRST STLB29
;PROGRAM NOT FOUND
STLB21: OUTSTR [ASCIZ "%Library routine "]
MOVE TA,[POINT 6,LIBNAM]
STLB22: ILDB TE,TA ;CONVERT ALL ':' BACK TO '-'
JUMPE TE,STLB23 ;FINISHED
CAIE TE,':'
JRST STLB22
MOVEI TE,'-'
DPB TE,TA
JRST STLB22
STLB23: MOVE TA,LIBNAM
PUSHJ PP,SIXOUT
MOVE TA,LIBNAM+1
PUSHJ PP,SIXOUT
OUTSTR [ASCIZ " in "]
PUSHJ PP,STLB30 ;PRINT DEV:FILE.EXT
OUTSTR [ASCIZ " not found - continuing
"]
MOVEI DW,E.74
STLB29: MOVE CP,CPYW2
LDB LN,[POINT 13,CPYW2,28]
SWOFF FCOPY!FRLIB ;[477] IF LIBARY NOT FOUND, CAN'T COPY
JRST FATAL
STLB30: PUSH PP,LIBDEV ;SAVE CURRENT DEVICE (USUALLY ZERO TO INDICATE ERROR)
SKIPN TA,LIBDV ;GET DEVICE
MOVSI TA,'DSK'
MOVEM TA,LIBDEV ;SETUP THE CORRECT DEVICE
MOVEI DA,LIBDEV ;POINT TO DATA BLOCK
PUSHJ PP,FILOUT## ;TYPE THE FULL FILE SPEC
POP PP,LIBDEV
POPJ PP,
;COMPARE LIBNAM AGAINST CONTENTS OF TE & TD.
;IF EQUAL, RETURN TO CALL + 1.
;IF LIBNAM > TE,TD RETURN TO CALL+2.
;IF LIBNAM < TE,TD RETURN TO CALL+3.
SETLBC: LSHC TE,-6
TRZ TD,-1
LSH TD,-1
CAME TC,TE
JRST SETLC1
CAMN TB,TD
POPJ PP,
AOS (PP)
CAMG TB,TD
AOS (PP)
POPJ PP,
SETLC1: AOS (PP)
CAMG TC,TE
AOS (PP)
POPJ PP,
;SPACE OVER UNTIL PREVIOUS SOURCE CHARACTER POSITION REACHED
ENDCPY: SWOFF FSEQ ;TURN OF FSEQ
IOR SW,CPYFLG ;PUT IT BACK THE WAY IT WAS
MOVEI CH,$LF
SKIPN SAVECP ;IF JUST STARTED NEW LINE
MOVEI CH," " ;DON'T PUT OUT EXTRA ONE
ENDCP1: PUSHJ PP,PUTCPY
MOVEI CH,1(CP)
CAML CH,CPYCP
JRST ENDCP2
MOVEI CH," "
JRST ENDCP1
ENDCP2: MOVEM CH,INPTCP ;[275] RESTORE LAST SOURCE CHAR POS BEFORE GOING TO LIBARY
SKIPE CH,REGKAR
SWONS FREGCH;
MOVEI CH," "
PUSHJ PP,PUTCPY
;CLEAR OUT CPYTAB AFTER END-OF-PROGRAM IN CPYFIL.
CLRCPY: HRRZ TE,CPYLOC
HRLI TE,1(TE)
MOVS TE,TE ;BUILD BLT PTR
HRRZ TD,CPYNXT
BLT TE,-1(TD) ;ZERO ALL OF CPYTAB
MOVE TE,CPYLOC ;YES--RESET CPYNXT
MOVEM TE,CPYNXT
SWOFF FCOPY!FECOPY!FRLIB ;TURN OFF "WE ARE COPYING"
IFN FT68274,<
PUSHJ PP,CVTDPL ;DUMP LINE CONTAINING COPY TEXT
SKIPN TE,CVTSEQ ;DO WE NEED TO FAKE UP A SOS LINE NO.?
JRST CLRCPZ ;NO
MOVEM TE,CVTPLB ;STORE NO.
MOVSI TE,(ASCII / /)
MOVEM TE,CVTPLB+1 ;ALSO TAB AS SIXTH CHAR
CLRCPZ: MOVE TD,[POINT 7,CPLCV2] ;COPY MESSAGE
PUSHJ PP,CVTTPL ;TO PREVIOUS LINE BUFFER
SETOM CVTCPF ;MAKE A COMMENT
SETZM CVTSEQ ;TURN OFF GENERATING SOS LINE NUMBERS
>
POPJ PP, ;RETURN
IFN FT68274,<
CPLCV1: ASCIZ /***** Start of copy library text *****
/
CPLCV2: ASCIZ /***** End of copy library text *****
/
>
SUBTTL FIPS FLAGGER TESTS
IFN ANS74,<
FLG.LI: PUSH PP,CH ;SAVE THE CHAR. (COULD BE UPPER OR LOWER CASE)
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.LI ;GET FLAG LEVEL OF LOW-INTERMEDIATE
JRST FLG.X ;MAKE THE TEST
FLG.HI: PUSH PP,CH ;SAVE THE CHAR. (, OR ;)
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.HI ;GET FLAG LEVEL OF HIGH-INTERMEDIATE
JRST FLG.X ;MAKE THE TEST
FLG.H: PUSH PP,CH ;SAVE THE CHAR. (COULD BE UPPER OR LOWER CASE)
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.H ;GET FLAG LEVEL OF HIGH
FLG.X: ANDCM TA,FLGSW ;CLEAR THE BITS WE ALLOW
SKIPE TA ;IS THIS WITHIN LIMITS?
PUSHJ PP,FLG.ES## ;NO
POP PP,TA
POP PP,CH
POPJ PP,
FLG.NS: PUSH PP,CH ;SAVE THE CHAR.
PUSH PP,TA ;ACC TO CONTAIN THE LEVEL FLAG
MOVEI TA,%LV.NS ;GET FLAG LEVEL OF NON-STANDARD
JRST FLG.X ;MAKE THE TEST
>
SUBTTL CONVERSION OF COBOL-68 TO COBOL-74 SUBROUTINES
IFN FT68274,<
INTERN CVTICL,CVTCCL,CVTDPL,CVTDCW,CVTSBP,CVTCTC,CVTUTC,CVTVTC,CVTRCW,CVTBCW,CVTACW,CVTICW,CVTTPL,CVTOAL,CVTINL ;[1413][1415]
;OUTPUT THE LINE IN THE PREVIOUS BUFFER
;COPY THE CURRENT BUFFER TO PREVIOUS AND INIT THE BUFFER
CVTOAL: TSWF FNOCPY ;[1360] ARE WE IN COPY REPLACING?
POPJ PP, ;[1360] YES, DON'T OUTPUT TWICE
SKIPE CVTPLB## ;ANYTHING IN LAST LINE BUFFER
PUSHJ PP,CVTDPL ;YES, DUMP PREVIOUS LINE
PUSHJ PP,CVTCCL ;COPY CURRENT LINE TO PREVIOUS LINE
SKIPE CVTCAL## ;ARE ALL LINES COMMENTS?
SETOM CVTCCF## ;YES
; JRST CVTICL ;INITIALIZE CONVERSION LINE BUFFER
;INITIALIZE CURRENT LINE BUFFER
CVTICL: MOVEI TD,^D132 ;INITIALIZE LINE BUFFER
MOVEM TD,CVTBFC##
MOVE TD,[POINT 7,CVTLBF##]
MOVEM TD,CVTBFP##
AOS CVTBFL ;[1357] INCREMENT LINE NUMBER
POPJ PP,
;ADD CR-LF TO CURRENT LINE.
CVTCRL: MOVEI CH,$CR ;ADD CR-LF TO CURRENT LINE
SOSL CVTBFC
IDPB CH,CVTBFP
MOVEI CH,$LF
SOSL CVTBFC
IDPB CH,CVTBFP
POPJ PP,
;COPY CURRENT LINE BUFFER TO PREVIOUS LINE BUFFER
CVTCCL: SETZ TD,
IDPB TD,CVTBFP ;MAKE SURE LINE ENDS IN NULL
MOVE TD,[CVTLBF,,CVTPLB]
BLT TD,CVTPLB##+CVTLBZ##-1
MOVE TD,[CVTLBF,,CVTLBF+1]
SETZM CVTLBF
BLT TD,CVTLBF+CVTLBZ-1 ;CLEAR LINE BUFFER
SETOM CVTPLF## ;SIGNAL PREVIOUS LINE HAS VALID DATA
MOVE TD,CVTCCF## ;COPY CURRENT COMMENT FLAG
MOVEM TD,CVTCPF## ;TO PREVIOUS LINE
SETZM CVTCCF
MOVE TD,CVTCXC## ;COPY EXTRA CHARACTER COUNT
MOVEM TD,CVTPXC##
SETZM CVTCXC
SKIPN CVTXLC## ;DO WE NEED TO GENERATE EXTRA LINES?
POPJ PP, ;NO
PUSHJ PP,CVTDPL ;YES, MAKE ROOM FOR IT
MOVE TD,CVTXLC ;GET CODE
SETZM CVTXLC ;ONLY ONCE PER SETTING
JRST @[CVTWSL]-1(TD) ;DISPATCH
CVTWSL: MOVEM LN,CVTTLY ;LINE NUMBER OF GENERATED TALLY
SOS CVTTLY ;BACKUP TO POINT TO WORKING-STORAGE
TSWF FSEQ ;[1444] /S?
SKIPA TD,[POINT 7,CVTWSS] ;[1444] YES
MOVE TD,[POINT 7,CVTWSM]
PJRST CVTTPL ;COPY TEXT TO PREVIOUS LINE
CVTWSM: ASCIZ /01 TALLY PIC S9(5) COMP.
/ ;[1426]
CVTWSS: ASCIZ /01 TALLY PIC S9(5) COMP. 68274
/ ;[1444]
;HERE TO COPY TEXT POINTED TO BY TD INTO PREVIOUS LINE BUFFER
CVTTPL: PUSH PP,CH
TSWF FSEQ ;/S SEQ NO.?
JRST CVTTP2 ;YES
MOVE TE,CVTPLB ;SEE IF SOS SEQ. NO.
TRNE TE,1
JRST CVTTP3 ;YES
SKIPA TE,[POINT 7,CVTPLB]
CVTTP1: IDPB CH,TE
CVTTP6: ILDB CH,TD
JUMPN CH,.-2
IDPB CH,TE ;STORE 1 NULL TO END LINE
POP PP,CH
POPJ PP,
CVTTP2: MOVE TE,[ASCII / /] ;WE NEED 6 BLANKS, FIVE ARE HERE
MOVEM TE,CVTPLB ;STORE THE LINE NO.
MOVE TE,[POINT 7,CVTPLB+1]
MOVEI CH," " ;HERE IS NO. 6
IDPB CH,TE
MOVE CH,TD ;SEE IF WE WANT AREA "A" OR "B"
ILDB CH,CH ;GET FIRST CHAR OF TEXT LINE
CAIN CH,"*" ;IS IT A COMMENT LINE
JRST CVTTP6 ;YES, START IN COL 7.
CAIE CH,$HT ;AREA "B" IF TAB
JRST CVTTP5 ;AREA "A"
MOVE CH,[ASCII / /] ;5 MORE SPACES
MOVEM CH,CVTPLB+1 ;COL 6 THRU COL 10
IBP TD ;BYPASS TAB
MOVE TE,[POINT 7,CVTPLB+2]
CVTTP5: MOVEI CH," " ;HERE IS COL 7 OR 11
JRST CVTTP1
CVTTP3: PUSH PP,TD
PUSHJ PP,ASCIAD ;CREATE A NEW LINE NO.
POP PP,TD
CVTTP4: MOVEM TE,CVTPLB ;STORE THE LINE NO.
MOVE TE,[POINT 7,CVTPLB+1]
MOVEI CH,$HT ;HERE IS THE SIXTH CHAR.
JRST CVTTP1
;REPLICATE CURRENT LINE BUFFER IN PREVIOUS LINE BUFFER
CVTRCP: MOVE TD,[CVTLBF,,CVTPLB]
BLT TD,CVTPLB##+CVTLBZ##-1
MOVE TD,CVTSCP ;CREATE A BYTE POINTER TO PREVIOUS BUFFER
JRST CVTRPL
CVTRCL: MOVE TD,[CVTLBF,,CVTPLB]
BLT TD,CVTPLB##+CVTLBZ##-1
MOVE TD,CVTBFP ;CREATE A BYTE POINTER TO PREVIOUS BUFFER
CVTRPL: PUSHJ PP,CVTEPl ;Make sure line ends correctly
SETOM CVTPLF## ;SIGNAL PREVIOUS LINE HAS VALID DATA
MOVE TD,CVTCCF## ;COPY CURRENT COMMENT FLAG
MOVEM TD,CVTCPF## ;TO PREVIOUS LINE
MOVE TD,CVTCXC## ;COPY EXTRA CHARACTER COUNT
MOVEM TD,CVTPXC##
POPJ PP, ;NO
;DUMP PREVIOUS LINE BUFFER TO CVT FILE
CVTDPL:
IFN DBMS, < ;[1504]
SKIPE FINVOK ;[1413] PART OF DBMS ?
POPJ PP, ;[1413] YES, EXIT
> ;[1504]
SKIPE BINDEV ;[1361] RETURN IF CVT FILE NOT WANTED
SKIPN CVTPLF ;ANYTHING THERE?
POPJ PP, ;NO
PUSH PP,CH
MOVE TD,[POINT 7,CVTPLB]
MOVE CH,CVTPLB ;GET FIRST WORD
TRNE CH,1 ;IN CASE SOS LINE NUMBERS
JRST CVTDP1 ;YES, WORRY ABOUT BIT 35
SKIPE CVTSEQ ;DO WE NEED TO ADD SOS LINE NUMBERS?
PUSHJ PP,CVTDP7 ;YES
SKIPN CVTCPF ;DO WE NEED TO COMMENT IT?
JRST CVTDP0 ;[1444] NO
TSWT FSEQ ;/S SEQUENCED?
JRST CVTDP2 ;NO
LDB CH,[POINT 7,CVTPLB+1,13] ;GET COL 7
CAIE CH,"*" ;ALREADY A COMMENT
CAIN CH,"/" ;...
JRST CVTDP3 ;YES
MOVEI CH,"*" ;NO
DPB CH,[POINT 7,CVTPLB+1,13]
JRST CVTDP3 ;IT IS NOW
CVTDP0: TSWF FSEQ ;[1444] /S?
SKIPN CVTPXC ;[1444] YES, DID LINE GET LONGER?
JRST CVTDP3 ;[1444] NO, JUST COPY IT
PUSH PP,TC ;[1444] GET SOME FREE ACCS
PUSH PP,TB ;[1444]
PUSH PP,TA ;[1444]
SETZB TC,TB ;[1444] TC = QUOTE CHAR, TB = LAST SPACE BEFORE COL 73
SETZ TA, ;[1444] TA = COUNT OF REMOVABLE SPACES
MOVEI TE,1 ;[1444] TE = COL COUNT, STARTS AT 1
;[1444] Scan the line looking for a good place to split it.
;[1444] This is the last space before column 73 that is not in a quoted string.
;[1444] Also check to see if we can find enough consecutive spaces that can be
;[1444] removed so that the line does not need to be split.
CVTDPS: ILDB CH,TD ;[1444] GET NEXT CHAR
JUMPE CH,CVTDPF ;[1444] END OF INPUT
JUMPN TC,[CAIE CH,TC ;[1444] IN QUOTE, IS IT MATCHING?
SETZ TC, ;[1444] YES, CLEAR FLAG
AOJA TE,CVTDPS] ;[1444] GET NEXT
CVTDPQ: CAIE CH,"""" ;[1444] LOOK FOR A POSSIBLE QUOTE
CAIN CH,"'" ;[1444] OF EITHER KIND
JRST [MOVE TC,CH ;[1444] FOUND ONE
AOJA TE,CVTDPS] ;[1444] KEEP LOOKING
CAIL TE,^D12 ;[1444] DON'T COUNT SPACE TIL IN B FIELD
CAIE CH," " ;[1444] SPACE?
AOJA TE,CVTDPS ;[1444] NO, GET NEXT CHAR
CAIGE TE,^D73 ;[1444] ARE WE STILL IN FIELD B?
MOVE TB,TE ;[1444] YES, STORE COL # OF THIS SPACE
ADDI TE,1 ;[1444] ADVANCE TO NEXT COLUMN
CVTDPT: ILDB CH,TD ;[1444] NO, GET NEXT CHAR
JUMPE CH,CVTDPF ;[1444] END OF INPUT
CAIE CH," " ;[1444] IS IT A CONSECUTIVE SPACE?
JRST CVTDPQ ;[1444] NO, BACK TO MAIN LOOP
ADDI TA,1 ;[1444] COUNT ONE MORE
CAML TA,CVTPXC ;[1444] HAVE WE ENOUGH SPACES?
CAIL TE,^D73 ;[1444] WITHIN FIELD B?
AOJA TE,CVTDPT ;[1444] NOT YET, GET NEXT CHAR
CVTDPF: CAIL TE,^D73 ;[1444] ARE WE OUTSIDE FIELD B?
SUBI TA,6 ;[1444] YES, USER MIGHT HAVE COL 73-80 BLANK
MOVE TD,[POINT 7,CVTPLB] ;[1444] RESET INPUT POINTER
JUMPE TB,CVTDPZ ;[1444] NEVER FOUND A SPACE
CAML TA,CVTPXC ;[1444] DID WE FIND ENOUGH CONSECUTIVE SPACES?
JRST CVTDPB ;[1444] YES, JUST REMOVE THEM
MOVE TE,TB ;[1444] NO, MUST SPLIT LINE
ILDB CH,TD ;[1444]
PUSHJ PP,CVTDCH ;[1444] DUMP CHARACTER
SOJG TE,.-2 ;[1444] LOOP FOR FIRST LINE
MOVEI TE,^D72 ;[1444] FILL LINE WITH SPACES
SUB TE,TB ;[1444] JUST TO BE NEAT
MOVEI CH," " ;[1444] GET SPACE
SKIPLE TE ;[1444] IN CASE LINE IS ALREADY FULL
PUSHJ PP,CVTDCH ;[1444] DUMP CHARACTER
SOJG TE,.-1 ;[1444] LOOP FOR FIRST LINE
MOVE TE,[POINT 7,[ASCIZ / 68274
/]] ;[1444] NEW COMMENT
CVTDPG: ILDB CH,TE ;[1444]
JUMPE CH,CVTDPH ;[1444] COPY UNTIL TERMINAL NULL IS FOUND
PUSHJ PP,CVTDCH ;[1444] DUMP CHARACTER
JRST CVTDPG ;[1444] LOOP
CVTDPH: MOVE TE,TB ;[1444] NO. OF SPACES TO OUTPUT
SUB TE,CVTPXC ;[1444] LESS EXTRA CHARACTERS WE HAVE
JUMPLE TE,CVTDPZ ;[1444] NONE
MOVEI CH," " ;[1444] GET SPACE
PUSHJ PP,CVTDCH ;[1444] DUMP CHARACTER
SOJG TE,.-1 ;[1444] LOOP FOR FIRST LINE
CVTDPZ: POP PP,TA ;[1444] RESTORE THE ACCS
POP PP,TB ;[1444]
POP PP,TC ;[1444]
JRST CVTDP3 ;[1444] COPY REST OF LINE
;[1444] Here to remove enough consecutive spaces so that line now fits
CVTDPB: MOVE TA,CVTPXC ;[1444] LOAD COUNT OF SPACES TO REPLACE
SETZ TC, ;[1444] CLEAR QUOTE FLAG
MOVEI TE,^D12 ;[1444] DON'T REMOVE SPACES UNTIL B MARGIN
CVTDPC: ILDB CH,TD ;[1444] GET NEXT CHAR
SUBI TE,1 ;[1444] COUNT DOWN UNTIL B MARGIN
CVTDPD: PUSHJ PP,CVTDCH ;[1444] OUTPUT IT
JUMPN TC,[CAIE CH,TC ;[1444] IN QUOTE, IS IT MATCHING?
SETZ TC, ;[1444] YES, CLEAR FLAG
JRST CVTDPC] ;[1444] GET NEXT
CAIE CH,"""" ;[1444] LOOK FOR A POSSIBLE QUOTE
CAIN CH,"'" ;[1444] OF EITHER KIND
JRST [MOVE TC,CH ;[1444] FOUND ONE
JRST CVTDPC] ;[1444] KEEP LOOKING
JUMPG TE,CVTDPC ;[1444] JUMP IF NOT IN B FIELD
CAIE CH," " ;[1444] SPACE?
JRST CVTDPC ;[1444] NO, GET NEXT CHAR
CVTDPE: ILDB CH,TD ;[1444] GET NEXT CHAR
CAIE CH," " ;[1444] IS IT A CONSECUTIVE SPACE?
JRST CVTDPD ;[1444] NO, BACK TO MAIN LOOP
SOJG TA,CVTDPE ;[1444] YES, REMOVE IT
JRST CVTDPZ ;[1444] ALL DONE WITH SPACES
CVTDP1: SKIPN TE,CVTSEQ ;DO WE NEED TO GENERATE LINE NO.?
JRST CVTDP9 ;NO
PUSHJ PP,ASCIAD ;YES, ADD 1 TO CURRENT
MOVEM TE,CVTSEQ ;AND STORE IT
MOVEM TE,CVTPLB ;ALSO CHANGE CURRENT
MOVE CH,TE
CVTDP9: PUSHJ PP,CVTDCH ;MAKE SURE THERE IS ROOM FOR NEXT WORD
MOVEM CH,@BINBH+1 ;NOW STORE FULL WORD
MOVE TD,[POINT 7,CVTPLB+1]
REPEAT 4,<
IBP BINBH+1
SOS BINBH+2
>
ILDB CH,TD ;GET CHAR AFTER LINE NUMBER
PUSHJ PP,CVTDCH ;STORE ALSO
SKIPN CVTCPF ;DO WE NEED TO COMMENT IT?
JRST CVTDP3 ;NO
CVTDP2: MOVE CH,TD ;COPY POINTER TO FIRST CHAR
ILDB CH,CH ;GET FIRST CHAR
CAIE CH,"*" ;IS IT ALREADY A COMMENT LINE?
SKIPA CH,["*"] ;NO, PUT OUT A COMMENT FIRST
CVTDP3: ILDB CH,TD
JUMPE CH,CVTDP4 ;COPY UNTIL TERMINAL NULL IS FOUND
PUSHJ PP,CVTDCH ;DUMP CHARACTER
JRST CVTDP3
CVTDCH: SOSGE BINBH##+2 ;USUAL LOOP
JRST CVTDPW ;BUFFER FULL
IDPB CH,BINBH+1
POPJ PP,
CVTDPW: OUT BIN,
JRST CVTDCH ;OK
MOVEI CH,BINDEV##
JRST DEVDED##
CVTDP4: SKIPN TD,CVTSEQ ;ALWAYS IF WE GENERATED SOS LINE NUMBERS
MOVE TD,CVTPLB ;GET FIRST WORD
TRNN TD,1 ;SOS LINE NUMBERS?
JRST CVTDP6 ;NO
SETZ CH,
CVTDP5: MOVE TD,BINBH+1
TLNN TD,760000 ;ON LAST BYTE IN WORD?
JRST CVTDP6 ;YES
PUSHJ PP,CVTDCH ;NOT YET
JRST CVTDP5
CVTDP6: POP PP,CH
POPJ PP,
;HERE TO ADD SOS LINE NUMBER TO LIBRARY SOURCE
CVTDP7: MOVE TE,CVTSEQ ;GET CURRENT LINE NO.
PUSHJ PP,ASCIAD ;ADD 1 TO IT
MOVEM TE,CVTSEQ ;AND STORE IT
MOVE CH,TE
PUSHJ PP,CVTDCH ;MAKE SURE THERE IS ROOM FOR NEXT WORD
MOVEM CH,@BINBH+1 ;NOW STORE FULL WORD
AOS BINBH+1 ;ACCOUNT FOR LINE NUMBER
MOVNI TE,5 ;AND FIVE CHARS.
ADDB TE,BINBH+2 ;WE HAVE NOW ACCOUNTED FOR ALL SIX CHARS.
MOVE TD,[POINT 7,CVTPLB]
MOVEI CH,$HT ;GET SIXTH CHAR
JUMPL TE,CVTDCH ;BUFFER IS EMPTY, DUMP AND RETURN
DPB CH,BINBH+1 ;DUMP THE CHAR
POPJ PP, ;AND RETURN
;HERE TO DELETE CURRENT WORD (IN NAMWRD) FROM CVT FILE
INTER. CV3.
CV3.: ;DELETE THE CURRENT WORD
CVTDCW: LDB TE,CVTBFP ;GET CURRENT CHAR
MOVE TC,CVTSCP ;POINTER TO START OF WORD TO DELETE
DPB TE,TC ;STORE OVER FIRST CHAR
MOVEI TD," " ;NOW FILL WITH SPACES
ILDB TE,TC
DPB TD,TC ;STORE OVER
JUMPN TE,.-2 ;NOT YET DONE
MOVE TE,CVTSCP ;POINTER TO START OF WORD DELETED
MOVEM TE,CVTBFP ;MAKE IT CURRENT POINTER
MOVEM TE,CVTSNP ;AND MOVE NEXT WORD POINTER BACK ALSO
MOVE TE,CVTSCL ;[1357] AND SAME FOR LINE NUMBER
MOVEM TE,CVTBFL ;[1357]
MOVEM TE,CVTSNL ;[1357]
POPJ PP,
;HERE TO SAVE POINTER TO CURRENT CHAR IN CVT BUFFER
CVTSBP: PUSH PP,CVTSNP## ;GET POINTER TO NEXT WORD FROM LAST TIME
POP PP,CVTSCP## ;SAVE IT AS NOW CURRENT
PUSH PP,CVTBFP## ;GET POINTER
POP PP,CVTSNP ;SAVE IT FOR NEXT TIME
PUSH PP,CVTSNL## ;[1357] AND SAME FOR LINE NUMBER
POP PP,CVTSCL## ;[1357]
PUSH PP,CVTBFL## ;[1357]
POP PP,CVTSNL ;[1357]
POPJ PP,
;[1415] Here to insert a line before the current line
CVTINL: HRLI TB,(POINT 7,) ;[1415] CREATE BYTE POINTER
AOS CVTSCL ;[1415] INCREMENT CURRENT LINE
PUSHJ PP,CVTCCW ;[1415] CHECK WHAT LINE CURRENT WORD IS ON
JRST CVTIN4 ;[1415] ON PREVIOUS LINE
PUSHJ PP,CVTDPL ;[1415] DEPOSITE PREVIOUS LINE
SETZM CVTCPF ;[1455] STOP COMMENTING
;[1415] Copy current line to previous line without distroying current line
MOVE TD,[CVTLBF,,CVTPLB] ;[1415]
BLT TD,CVTPLB+CVTLBZ-1 ;[1415]
;[1415] Find first character in previous line buffer
CVTIN1: PUSH PP,CH ;[1415]
MOVE TD,[POINT 7,CVTPLB] ;[1415] CREATE BYTE POINTER TO CVTPLB
CVTIN2: ILDB CH,TD ;[1415] GET CHARACTER FROM PREVIOUS BUFFER
CAIN CH," " ;[1415] SPACE ?
JRST CVTIN2 ;[1415] YES
CAIG CH,"9" ;[1415] PART OF LINE NUMBER ?
CAIGE CH,"0" ;[1415]
SKIPA ;[1415] NO
JRST CVTIN2 ;[1415] YES, SKIP PAST LINE NUMBERS
CAIN CH,$HT ;[1415] TAB ?
JRST CVTIN2 ;[1415] YES
;[1415] Replace the remaining characters of the previous line buffer with
;[1415] the string pointed to by TB. Also add in CRLF to end of line
;[1415] TD = ADDRESS OF STRING TO BE REPLACED
;[1415] TB = ADDRESS OF STRING TO REPLACE IT
ILDB CH,TB ;[1415] GET FIRST CHARACTER
DPB CH,TD ;[1415] STORE IT
CVTIN3: ILDB CH,TB ;[1415] GET NEXT CHARACTER
IDPB CH,TD ;[1415] STORE IT
SKIPE CH ;[1415] FINISHED ?
JRST CVTIN3 ;[1415] NO
MOVEI CH,$CR ;[1415] WRITE CR-LF TO PREVIOUS LINE
DPB CH,TD ;[1415]
MOVEI CH,$LF ;[1415]
IDPB CH,TD ;[1415]
SETZM CH ;[1415] WRITE OUT NULL
IDPB CH,TD ;[1415]
POP PP,CH ;[1415]
SOS CVTSCL ;[1415] RESET CURRENT LINE
POPJ PP, ;[1415]
;[1415] Current word is in the previous buffer,
CVTIN4: MOVE TD,[CVTPLB,,CVTTMP##] ;[1415]
BLT TD,CVTTMP+CVTLBZ-1 ;[1415]
PUSHJ PP,CVTIN1 ;[1415] REPLACE PREVIOUS LINE
PUSHJ PP,CVTDPL ;[1415] DUMP IT
SETZM CVTCPF ;[1455] STOP COMMENTING
MOVE TD,[CVTTMP,,CVTPLB] ;[1415]
BLT TD,CVTPLB+CVTLBZ-1 ;[1415]
POPJ PP, ;[1415]
;HERE TO REPLACE THE CURRENT WORD WITH SOMETHING ELSE
;TA = ADDRESS OF STRING TO BE REPLACED
;TB = ADDRESS OF STRING TO REPLACE IT
CVTRCW: HRLI TA,(POINT 7,) ;FORM BYTE POINTER
HRLI TB,(POINT 7,)
PUSHJ PP,CVTCCW ;SEE WHICH LINE CURRENT WORD IS IN
JRST CVTRWP ;ITS IN PREVIOUS LINE
ILDB TD,TA ;GET FIRST CHARACTER TO REPLACE
SKIPA TC,CVTSCP## ;GET POINTER TO CURRENT WORD IN CVT BUFFER
CVTRC1: IBP TC ;ADVANCE TO NEXT BYTE
LDB TE,TC ;MAKE SURE WE'RE WHERE WE SHOULD BE
JUMPE TE,CVTRC7 ;SHOULD NEVER HAPPEN
CAIE TE,(TD)
CAIN TE,"a"-"A"(TD) ;JUST TO BE SAFE
TRNA ;OK
JRST CVTRC1 ;NOT YET
ILDB TE,TB
DPB TE,TC ;REPLACE FIRST CHAR
CVTRC2: ILDB TE,TA ;ANYTHING LEFT IN SOURCE
JUMPE TE,CVTRC3 ;NO
ILDB TE,TB ;GET REPLACEMENT CHARACTER
JUMPE TE,[HALT] ;SMALLER
IDPB TE,TC
JRST CVTRC2 ;LOOP FOR EQUAL LENGTH PART
;HERE TO INSERT SOMETHING BEFORE THE CURRENT WORD
;BASICALY THE SAME AS CVTRCW
;TA = ADDRESS OF STRING OF CURRENT WORD
;TB = ADDRESS OF STRING TO INSERT
CVTBCW: HRLI TA,(POINT 7,) ;FORM BYTE POINTER
HRLI TB,(POINT 7,)
PUSHJ PP,CVTCCW ;SEE WHICH LINE CURRENT WORD IS IN
JRST CVTRWP ;ITS IN PREVIOUS LINE
ILDB TD,TA ;GET FIRST CHARACTER TO REPLACE
SKIPA TC,CVTSCP## ;GET POINTER TO CURRENT WORD IN CVT BUFFER
CVTBC1: IBP TC ;ADVANCE TO NEXT BYTE
LDB TE,TC ;MAKE SURE WE'RE WHERE WE SHOULD BE
JUMPE TE,CVTRC7 ;SHOULD NEVER HAPPEN
CAIE TE,(TD)
CAIN TE,"a"-"A"(TD) ;JUST TO BE SAFE
JRST CVTRC3 ;OK, WE'RE POINTING AT CURRENT WORD
JRST CVTBC1 ;NOT YET
;HERE TO INSERT SOMETHING AFTER THE CURRENT WORD
;TA = UNDEFINED
;TB = ADDRESS OF STRING TO INSERT
CVTACW: HRLI TB,(POINT 7,)
SKIPA TC,CVTSNP## ;GET POINTER TO NEXT WORD IN CVT BUFFER
CVTAC1: IBP TC ;ADVANCE TO NEXT BYTE
CVTAC2: LDB TE,TC ;MAKE SURE WE'RE WHERE WE SHOULD BE
JUMPE TE,CVTRC7 ;SHOULD NEVER HAPPEN
CAIN TE," " ;SHOULD NOT BE A BLANK
JRST CVTAC1 ;NOT YET
REPEAT 0,<
PUSH PP,TE ;SAVE FIRST CHAR OF NEXT WORD
ILDB TE,TB ;GET FIRST REPLACEMENT CHAR
DPB TE,TC ;STORE OVER FIRST CHAR
PUSHJ PP,CVTRC3 ;INSERT NEW WORDS
POP PP,TE ;GET BACK FIRST CHARACTER
SOS CVTBFC ;COUNT ONE FOR IT
IDPB TE,CVTBFP ;STORE IT AFTER INSERTED TEXT
IBP CVTSNP ;INCREMENT START OF NEXT WORD
AOS CVTCXC
POPJ PP,
>
REPEAT 4,<IBP TC> ;ADVANCE 4 BYTES
SOJA TC,CVTRC3 ;BACKUP 1 WORD, I.E. BACKUP 1 BYTE
;HERE TO INSERT SOMETHING AT CURRENT WORD WHERE WE DON'T KNOW WHAT CURRENT WORD IS.
;IF CURRENT CHAR. IS A PERIOD THEN INSERT BEFORE IT I.E. AFTER CURRENT WORD..
;IF IT IS SOMETHING ELSE THEN INSERT BEFORE CURRENT WORD.
;Enter with TB = address of text to insert
CVTICW: LDB TE,CVTBFP ;GET LAST CHAR STORED
CAIN TE,"." ;WAS IT A PERIOD?
JRST CVTACW ;YES, STORE AFTER CURRENT WORD
HRLI TB,(POINT 7,) ;Complete byte pointer
PUSHJ PP,CVTCCW ;SEE WHICH LINE ITS IN
JRST CVTIPl ;Its in previous line
MOVE TC,CVTSCP ;POINT TO CURRENT WORD
JRST CVTAC2 ;INSERT BEFORE THIS WORD
CVTIPl: MOVE TC,CVTSCP ;POINT TO CURRENT WORD
SUBI TC,CVTLBF-CVTPLB ;Backup to previous line
REPEAT 4,<IBP TC> ;ADVANCE 4 BYTES
SOJA TC,CVTRw3 ;BACKUP 1 WORD, I.E. BACKUP 1 BYTE
CVTRC3: MOVE TA,TC ;COPY STORE PTR TO SAFER PLACE
MOVE TC,TB ;GET COPY OF REPLACEMENT PTR
SETZ TD, ;USE TO COUNT CHAR LEFT
CVTRC4: ILDB TE,TC ;GET NEXT REPLACEMENT
SKIPE TE ;ALL DONE
AOJA TD,CVTRC4 ;COUNT IT
ADDM TD,CVTCXC## ;ADD IN EXTRA CHARACTERS
IDIVI TD,5 ;SEE HOW MANY WORDS
SKIPE TC
ADDI TD,1 ;COUNT PARTIAL WORD
HRRM TD,RVBLT## ;SET UP REVERSE BLT
MOVEI TE,CVTLBF+CVTLBZ-1
SUBI TE,(TA)
SUBI TE,(TD) ;N-1 WORDS TO MOVE
TLO TE,400000(TE) ;N-1+400000 IN LHS
HRRI TE,CVTLBF+CVTLBZ-1
SUBI TE,(TD) ;LAST ADDRESS IN SOURCE TO MOVE
PUSHJ PP,RVBLT## ;GO DO IT
SKIPE TC
SUBI TD,1 ;BACK UP TO NO. OF FULL WORDS
ADDM TD,CVTBFP ;POINTER TO END OF WORD WILL CHANGE
ADDM TD,CVTSNP ;POINTER TO NEXT WORD WILL ALSO HAVE MOVED
SKIPN TE,TC ;GET REMAINDER
JRST CVTRC6 ;NONE
IBP CVTBFP
IBP CVTSNP
SOJG TE,.-2 ;ADJUST FOR PARTIAL WORD
;NOW WE HAVE TO MOVE LEFTWARDS
MOVE TE,TC ;GET REMAINDER AGAIN
MOVE TC,TA ;POINTER TO LAST GOOD CHAR
ADDI TC,1(TD) ;BUT ITS BEEN MOVED
ADD TD,TA
IBP TD ;INCREMENT STORE POINTER
SOJG TE,.-1
CVTRC5: ILDB TE,TC ;GET A GOOD CHARACTER
IDPB TE,TD ;STORE OVER JUNK
JUMPN TE,CVTRC5 ;LOOP TIL NULL STORED
JRST CVTRC6
;NOW CONTINUE THE STORE
IDPB TE,TA
CVTRC6: ILDB TE,TB
JUMPN TE,.-2 ;STOP ON ZERO
POPJ PP,
CVTRC7: HALT .
;HERE TO CHECK WHICH LINE BUFFER CVTSCP POINTS TO
;Returns
; .+1 ;Previous line
; .+2 ;Current line
CVTCCW: MOVE TC,CVTSCL ;[1357] GET LINE NUMBER OF CURRENT WORD
CAML TC,CVTBFL ;[1357] IS IT IN CURRENT LINE?
AOS (PP) ;[1357] YES
POPJ PP,
;HERE IF THE CURRENT WORD IS IN THE PREVIOUS LINE
;THIS HAPPENS WHEN WE SCAN AHEAD TO FIND THE DELIMITER
CVTRWP: LDB TE,[POINT 7,CVTPLB,6]
CAIE TE,"*" ;IF LINE IS A COMMENT
CAIN TE,"/" ; OF EITHER KIND
JRST CVTRW6 ;THEN WORD CANNOT BE IN PREVIOUS LINE
MOVE TC,CVTSCP## ;GET POINTER TO CURRENT WORD IN CVT BUFFER
SUBI TC,CVTLBF-CVTPLB ;ADJUST TO POINT TO PREVIOUS BUFFER
MOVE TD,TA ;INCASE WE HAVE TO BACKUP
ILDB TD,TD ;GET FIRST CHARACTER TO REPLACE
TRNA
CVTRW1: IBP TC ;ADVANCE TO NEXT BYTE
LDB TE,TC ;MAKE SURE WE'RE WHERE WE SHOULD BE
JUMPE TE,CVTRW6 ;WE HAVE REACHED THE END-OF-LINE
CAIE TE,(TD)
CAIN TE,"a"-"A"(TD) ;JUST TO BE SAFE
TRNA ;OK
JRST CVTRW1 ;NOT YET
TSWT FSEQ ;[1444] /S?
JRST CVTRW9 ;[1444] NO, WE HAVE FOUND IT
;[1444] We can not be sure that we are synchronised yet. We might be in the comment field.
;[1444] A simple count will not work as the user might have tabs in the source line.
;[1444] We will compare the next 6 characters or until either runs out.
PUSH PP,TA ;[1444] SAVE THE POINTERS
PUSH PP,TB ;[1444]
PUSH PP,TC ;[1444]
PUSH PP,CH ;[1444] HOLDS COUNT
MOVEI CH,6 ;[1444] OF CHARACTERS TO COMPARE FOR MATCH
IBP TA ;[1444] ACCOUNT FOR FIRST CHAR
CVTRW7: ILDB TD,TA ;[1444] GET NEXT
JUMPE TD,CVTRW8 ;[1444] MUST HAVE MATCH
ILDB TE,TC ;[1444] GET NEXT FROM SOURCE LINE
CAIE TE,(TD) ;[1444] MATCH?
CAIN TE,"a"-"A"(TD) ;[1444] OR LOWER CASE?
TRNA ;[1444] OK UP TO THIS POINT
JRST CVTRWF ;[1444] NOT A MATCH
SOJG CH,CVTRW7 ;[1444] TRY NEXT
CVTRW8: POP PP,CH ;[1444] RESTORE
POP PP,TC ;[1444]
POP PP,TB ;[1444]
POP PP,TA ;[1444]
CVTRW9: IBP TA ;[1444] ACCOUNT FOR FIRST CHARACTER WE READ
ILDB TE,TB
DPB TE,TC ;REPLACE FIRST CHAR
CVTRW2: ILDB TE,TA ;ANYTHING LEFT IN SOURCE
JUMPE TE,CVTRW3 ;NO
ILDB TE,TB ;GET REPLACEMENT CHARACTER
JUMPE TE,[HALT] ;SMALLER
IDPB TE,TC
JRST CVTRW2 ;LOOP FOR EQUAL LENGTH PART
CVTRW3: MOVE TA,TC ;COPY STORE PTR TO SAFER PLACE
MOVE TC,TB ;GET COPY OF REPLACEMENT PTR
SETZ TD, ;USE TO COUNT CHAR LEFT
CVTRW4: ILDB TE,TC ;GET NEXT REPLACEMENT
SKIPE TE ;ALL DONE
AOJA TD,CVTRW4 ;COUNT IT
ADDM TD,CVTPXC## ;ADD IN EXTRA CHARACTERS
IDIVI TD,5 ;SEE HOW MANY WORDS
SKIPE TC
ADDI TD,1 ;COUNT PARTIAL WORD
HRRM TD,RVBLT ;SET UP REVERSE BLT
MOVEI TE,CVTPLB+CVTLBZ-1
SUBI TE,(TA)
SUBI TE,(TD) ;N-1 WORDS TO MOVE
TLO TE,400000(TE) ;N-1+400000 IN LHS
HRRI TE,CVTPLB+CVTLBZ-1
SUBI TE,(TD) ;LAST ADDRESS IN SOURCE TO MOVE
PUSHJ PP,RVBLT ;GO DO IT
SUBI TD,1 ;BACK UP TO NO. OF FULL WORDS
SKIPN TE,TC ;[1445] GET REMAINDER TO CORRECT ACC
JRST CVTRC6 ;[1445] JUMP IF NO REMAINDER
;NOW WE HAVE TO MOVE LEFTWARDS
MOVE TC,TA ;POINTER TO LAST GOOD CHAR
ADDI TC,1(TD) ;BUT ITS BEEN MOVED
ADD TD,TA
IBP TD ;INCREMENT STORE POINTER
SOJG TE,.-1
CVTRW5: ILDB TE,TC ;GET A GOOD CHARACTER
IDPB TE,TD ;STORE OVER JUNK
JUMPN TE,CVTRW5 ;LOOP TIL NULL STORED
JRST CVTRC6
CVTRWF: POP PP,CH ;[1444] RESTORE
POP PP,TC ;[1444]
POP PP,TB ;[1444]
POP PP,TA ;[1444]
CVTRW6: MOVE TE,[POINT 7,CVTLBF,6]
MOVEM TE,CVTSCP ;LDB POINTER TO START OF CURRENT LINE
AOS CVTSCL ;[1357] INCREMENT LINE NUMBER ALSO
JRST CVTRCW ;TRY AGAIN
;HERE TO TURN CURRENT CLAUSE INTO A COMMENT
;IF THE FIRST PART OF THE LINE IS NOT ALL SPACES OR TABS OUTPUT IT AND START A NEW LINE
INTER. CV0.
CV0.: ;TURN THIS CLAUSE INTO A COMMENT
CVTCTC: PUSHJ PP,CVTCCW ;SEE WHICH LINE BUFFER TO USE
JRST CVTCT4 ;POINTS TO PREVIOUS LINE
SETOM CVTCAL ;MAKE ALL LINES A COMMENT
SKIPE CVTCCF ;IS LINE ALREADY A COMMENT?
POPJ PP, ;YES, DO NOTHING EXTRA
MOVE TE,CVTLBF ;TEST FOR SOS LINE NUMBER
TRNN TE,1
TSWF FSEQ ;OR /S
SKIPA TD,[POINT 7,CVTLBF+1,6] ;YES
MOVE TD,[POINT 7,CVTLBF] ;NO, POINT TO START OF BUFFER
CVTCT1: ILDB TE,TD ;GET STORED CHAR
CAMN TD,CVTSCP ;ARE WE AT START OF CLAUSE
JRST CVTCT7 ;YES
CAIE TE," " ;ALLOW SPACE
CAIN TE,$HT ;AND TAB ONLY
JRST CVTCT1 ;OK
PUSHJ PP,CVTDPL ;DUMP PREVIOUS LINE
PUSH PP,CVTBFP ;SAVE CURRENT BP AS CVTCCL WILL INCREMENT IT
PUSHJ PP,CVTCCL ;COPY THIS LINE TO PREVIOUS
POP PP,CVTBFP ;RESTORE IT TO BEFORE TRRMINAL NULL
MOVE TD,[CVTPLB,,CVTLBF]
BLT TD,CVTLBF+CVTLBZ-1 ;COPY IT BACK
LDB TE,CVTSCP ;[1343] CHECK THAT LAST BYTE IS NOT A PERIOD
CAIN TE,"." ;[1343] BECAUSE IF IT IS THEN IT BELONGS TO
IBP CVTSCP ;[1343] THE PREVIOUS FIELD, SO BYPASS IT.
MOVE TD,CVTSCP ;GET POINTER TO CURRENT WORD IN CVT BUFFER
PUSHJ PP,CVTEPL ;Make sure it ends correctly
MOVE TD,[POINT 7,CVTLBF] ;POINT TO START OF BUFFER
MOVE TE,CVTLBF ;SEE IF SOS LINE NUMBER
TRNN TE,1
JRST CVTCT3 ;ITS NOT
PUSHJ PP,ASCIAD ;GENERATE NEW LINE NO.
MOVEM TE,CVTLBF ;STORE IT
MOVE TD,[POINT 7,CVTLBF+1,6]
CVTCT3: ILDB TE,TD ;ADVANCE TO NEXT BYTE
CAMN TD,CVTSCP ;ARE WE AT START OF CLAUSE
JRST CVTCT7 ;YES
CAIE TE,$HT ;LEAVE TAB ALONE
MOVEI TE," " ;OTHERWISE TURN INTO SPACE
DPB TE,TD
JRST CVTCT3
CVTCT4: MOVE TD,CVTSCP## ;GET POINTER TO CURRENT WORD IN CVT BUFFER
SUBI TD,CVTLBF-CVTPLB ;ADJUST TO POINT TO PREVIOUS BUFFER
CVTCT5: ILDB TE,TD ;SEE IF ALL WE HAVE IS END OF LINE
JUMPE TE,CVTCT6 ;LINE TERMINATES ON NULL
CAIE TE," " ;IGNORE SPACE
CAIN TE,$HT ;TAB
JRST CVTCT5
CAIE TE,"," ;COMMA
CAIN TE,";" ;SEMI-COLON
JRST CVTCT5
CAIE TE,$CR ;LOOK FOR END-OF-LINE
CAIN TE,$LF
JRST CVTCT6 ;FOUND IT
JRST CVTCT5 ;[1505] KEEP LOOKING
CVTCT6: MOVE TE,[POINT 7,CVTLBF]
MOVEM TE,CVTSCP ;BACK UP TO START OF LINE
SETOM CVTCAL ;MAKE ALL LINES A COMMENT
CVTCT7: SETOM CVTCCF ;TURN CURRENT LINE INTO A COMMENT
POPJ PP,
;Here to add <cr-lf-nul> to end of previous buffer
;Enter with byte pointer to current buffer in TD
CVTEPL: SUBI TD,CVTLBF-CVTPLB ;ADJUST TO POINT TO PREVIOUS BUFFER
CVTEPM: MOVEI TE,$CR ;[1445] REMOVE THE CURRENT WORD FROM PREV BUFFER
DPB TE,TD ; BY STORING <CR-LF-NUL>
MOVEI TE,$LF ; OVER FIRST CHAR OF IT
IDPB TE,TD
SETZ TE,
IDPB TE,TD
POPJ PP,
;[1454]Here to test to see if the current character is a period, if it is
;[1454] update CVTSCP ( pointer to start of clause )
INTER. CVTCFP ;[1454]
CVTCFP: CAIE CH,"." ;[1454] CHARACTER A PERIOD?
POPJ PP, ;[1454] NO, EXIT
CVTCF1: ILDB TD,CVTSCP ;[1454] GET NEXT CHARACTER
CAIE CH,"." ;[1454] IF PERIOD, STOP
CAIN CH,0 ;[1454] IF NULL STOP
POPJ PP, ;[1454]
JRST CVTCF1 ;[1454] REPEAT
;HERE TO TURN CURRENT CLAUSE BACK INTO A REAL STATEMENT AFTER CVTCTC CALLED
;IF THE FIRST PART OF THE LINE IS NOT ALL SPACES OR TABS OUTPUT IT AND START A NEW LINE
INTER. CV1.
CV1.: ;STOP COMMENTING THIS CLAUSE
CVTUTC: SETZM CVTCAL ;STOP COMMENTING
SKIPN CVTCCF ;IF CURRENT LINE ISN'T A COMMENT
POPJ PP, ;JUST RETURN
MOVE TE,CVTLBF ;SEE IF SOS LINE NO.
TRNN TE,1
TSWF FSEQ ;OR /S
SKIPA TD,[POINT 7,CVTLBF+1,6] ;POINT TO COL. 7
MOVE TD,[POINT 7,CVTLBF] ;POINT TO START OF BUFFER
CVTUT1: ILDB TE,TD ;GET STORED CHAR
CAMN TD,CVTSCP ;ARE WE AT START OF CLAUSE
JRST CVTUT3 ;YES
CAIE TE," " ;ALLOW SPACE
CAIN TE,$HT ;AND TAB ONLY
JRST CVTUT1 ;OK
JUMPE TE,CVTUT3 ;STOP ON NUL, IT MUST BE THE END
PUSHJ PP,CVTDPL ;DUMP PREVIOUS LINE
PUSHJ PP,CVTRCL ;COPY THIS LINE TO PREVIOUS
SETZM CVTBFL ;[1455]SET POINTER TO NOT LOOK AT PREVIOUS LINE
MOVE TD,[POINT 7,CVTLBF] ;POINT TO START OF BUFFER
MOVE TE,CVTLBF ;SEE IF SOS LINE NUMBER
TRNN TE,1
JRST CVTUT2 ;ITS NOT
PUSHJ PP,ASCIAD ;GENERATE NEW LINE NO.
MOVEM TE,CVTLBF ;STORE IT
MOVE TD,[POINT 7,CVTLBF+1,6]
CVTUT2: ILDB TE,TD ;ADVANCE TO NEXT BYTE
CAMN TD,CVTBFP ;ARE WE AT END OF CLAUSE
JRST CVTUT3 ;YES
JUMPE TE,CVTUT3 ;STOP ON NUL, IT MUST BE THE END
CAIE TE,$HT ;LEAVE TAB ALONE
MOVEI TE," " ;OTHERWISE TURN INTO SPACE
DPB TE,TD
JRST CVTUT2
CVTUT3: SETZM CVTCCF ;MAKE SURE CURRENT LINE ISN'T A COMMENT
POPJ PP,
;[1445] Same as CV1. except that we backup to in front of current word.
;[1445] We must be very careful about periods and not turn them into comments.
INTER. CV2.
CV2.: ;STOP COMMENTING THIS CLAUSE
CVTVTC: SETZM CVTCAL ;STOP COMMENTING
SKIPN CVTCCF ;IF CURRENT LINE ISN'T A COMMENT
POPJ PP, ;JUST RETURN
MOVE TE,CVTSCL ;[1445] LINE NUMBER OF START OF CURRENT WORD
CAMGE TE,CVTBFL ;[1445] IS IT IN CURRENT BUFFER?
AOJA TE,CVTVT3 ;[1445] NO, TRY PREVIOUS
MOVE TE,CVTLBF ;SEE IF SOS LINE NO.
TRNN TE,1
TSWF FSEQ ;OR /S
SKIPA TD,[POINT 7,CVTLBF+1,6] ;POINT TO COL. 7
MOVE TD,[POINT 7,CVTLBF] ;POINT TO START OF BUFFER
CVTVT1: ILDB TE,TD ;GET STORED CHAR
CAMN TD,CVTSCP ;ARE WE AT START OF CLAUSE
JRST CVTUT3 ;YES
CAIE TE," " ;ALLOW SPACE
CAIN TE,$HT ;AND TAB ONLY
JRST CVTVT1 ;OK
JUMPE TE,CVTUT3 ;STOP ON NUL, IT MUST BE THE END
PUSHJ PP,CVTDPL ;DUMP PREVIOUS LINE
PUSHJ PP,CVTRCP ;COPY THIS LINE TO PREVIOUS
MOVE TD,[POINT 7,CVTLBF] ;POINT TO START OF BUFFER
MOVE TE,CVTLBF ;SEE IF SOS LINE NUMBER
TRNN TE,1
JRST CVTVT2 ;ITS NOT
PUSHJ PP,ASCIAD ;GENERATE NEW LINE NO.
MOVEM TE,CVTLBF ;STORE IT
MOVE TD,[POINT 7,CVTLBF+1,6]
CVTVT2: ILDB TE,TD ;ADVANCE TO NEXT BYTE
CAMN TD,CVTSCP ;ARE WE AT END OF CLAUSE
JRST CVTUT3 ;YES
JUMPE TE,CVTUT3 ;STOP ON NUL, IT MUST BE THE END
CAIE TE,$HT ;LEAVE TAB ALONE
MOVEI TE," " ;OTHERWISE TURN INTO SPACE
DPB TE,TD
JRST CVTVT2
;[1445] Scan previous line looking for first delimiter.
;[1445] If its a period then we have to split the line.
;[1445] If its a space, comma ,semi-colon continue until a non-space or <cr-lf> or period is found.
;[1445] If we get to <cr-lf> turn all of line into comment.
;[1445] This will not guard against /S format KEY-WORD .COL73 where the period is in column 73.
CVTVT3: CAME TE,CVTBFL ;[1445] IN PREVIOUS BUFFER?
JRST CVTSCP ;[1445] NO, JUST GIVE UP
MOVE TD,CVTSCP ;[1445] GET POINTER TO CURRENT WORD
SUBI TD,CVTLBF-CVTPLB ;[1445] IN PREVIOUS BUFFER
CVTVT4: ILDB TE,TD ;[1445] GET NEXT CHAR
JUMPE TE,CVTUT3 ;[1445] END OF LINE
CAIE TE,$CR ;[1445]
CAIN TE,$LF ;[1445]
JRST CVTUT3 ;[1445] END OF LINE FOUND
CAIN TE,"." ;[1445] PERIOD?
JRST CVTVT6 ;[1445] YES, SPLIT LINE
CAIE TE," " ;[1445] LOOK FOR DELIMITERS
CAIN TE," " ;[1445]
JRST CVTVT5 ;[1445] SPACE OR TAB
CAIE TE,"," ;[1445]
CAIN TE,";" ;[1445]
JRST CVTVT5 ;[1445]
JRST CVTVT4 ;[1445] TRY NEXT CHAR
CVTVT5: ILDB TE,TD ;[1445] NOW LOOK FOR COBOL WORD OR E-O-L
JUMPE TE,CVTUT3 ;[1445] END OF LINE
CAIE TE,$CR ;[1445]
CAIN TE,$LF ;[1445]
JRST CVTUT3 ;[1445] END OF LINE FOUND
CAIN TE,"." ;[1445] PERIOD?
JRST CVTVT6 ;[1445] YES, SPLIT LINE
CAIE TE," " ;[1445] LOOK FOR DELIMITERS
CAIN TE," " ;[1445]
JRST CVTVT5 ;[1445] SPACE OR TAB
CAIE TE,"," ;[1445]
CAIN TE,";" ;[1445]
JRST CVTVT5 ;[1445]
JRST CVTUT3 ;[1445] FOUND SOMETHING, COULD BE COMMENT FIELD
CVTVT6: HRRZ TE,TD ;[1445] GET ADDRESS
PUSH PP,(TE) ;[1445] SAVE THE TWO WORDS
PUSH PP,1(TE) ;[1445] SO WE CAN ADD <CR-LF> SAFELY
PUSH PP,TD ;[1445] AND ADDRESS
PUSHJ PP,CVTEPM ;[1445] ADD <cr-lf-null>
PUSHJ PP,CVTDPL ;[1445] DUMP FIRST PART OF LINE
POP PP,TD ;[1445] RESTORE BYTE POINTER
HRRZ TE,TD ;[1445]
POP PP,1(TE) ;[1445] RESTORE TWO WORDS
POP PP,(TE) ;[1445]
PUSH PP,CVTSCP ;[1445]
MOVEM TD,CVTSCP ;[1445] FAKE OUT CV0. CODE
MOVE TD,[POINT 7,CVTPLB] ;[1445] POINT TO START OF PREVIOUS BUFFER
MOVE TE,CVTPLB ;[1445] SEE IF SOS LINE NUMBER
TRNN TE,1 ;[1445]
JRST CVTVT7 ;[1445] ITS NOT
PUSHJ PP,ASCIAD ;[1445] GENERATE NEW LINE NO.
MOVEM TE,CVTPLB ;[1445] STORE IT
MOVE TD,[POINT 7,CVTPLB+1,6] ;[1445]
CVTVT7: PUSHJ PP,CVTCT3 ;[1445] SO IT WILL REPACE FIRST PART WITH SPACES
MOVEI TE,"." ;[1445]
DPB TE,TD ;[1445] RESTORE PERIOD
POP PP,CVTSCP ;[1445] RESTORE
SETZM CVTCPF ;[1445] MAKE SURE PERIOD IS NOT A COMMENT
JRST CVTUT3 ;[1445] AND FOR NEXT LINE ALSO
;ADD TWO ASCII NUMBER TO GENERATE NEW SOS LINE NUMBER
ASCIAD: MOVE TD,[ASCII /00001/]
AND TD,K2A ;CONVERT TO NUMBERS
IOR TE,K4A ;MAKE SURE THIS IS IN DIGIT FORM
ADD TE,K1A ;GET EACH DIGIT IN RANGE 166 TO 177 FOR CARRY
ADD TD,TE ;SUM
AND TD,K3A ;GET RID OF 100 BITS IF THERE
MOVE TE,K4A ;FIND OUT WHICH ONES NEED SUBTRACTING
AND TE,TD
ASH TE,-3 ;CONVIENIENTLY THEY NEED 6 SUBTRACTED
SUBM TD,TE ;SO DO IT
IOR TE,K4A ;AND RECONVERT TO DIGITS
POPJ PP,
K1A: BYTE (7) 106,106,106,106,106
K2A: BYTE (7) 17,17,17,17,17
K3A: BYTE (7) 77,77,77,77,77
K4A: <ASCII /00000/>!1
;CHECK FOR NEW COBOL-74 RESERVED WORDS
CVT74: SKIPE CVTRWM## ;HAS THIS WORD ALREADY BEEN MODIFIED?
POPJ PP, ;YES
PUSHJ PP,CVTSBP ;SAVE POINTER TO CVT LINE BUFFER
MOVSI TE,-RWTBLN ;GET AOBJN WORD
MOVE TD,NAMWRD ;GET FIRST WORD OF NAME
RWLOOP: CAMN TD,RWTBL1(TE) ;CHECK AGAINST FIRST WORD
JRST RWTST ;FIRST WORD MATCHES
AOBJN TE,RWLOOP ;FAILED, TRY NEXT WORD
POPJ PP, ;ALL DONE, NO LUCK
RWTST: CAMN TD,[SIXBIT /LINAGE/] ;LINAGE AND LINAGE-COUNTER HAVE SAME FIRST WORD
JRST [SKIPN NAMWRD+1 ;CHECK FOR JUST LINAGE
JRST RWFND ;GOT IT
JRST .+1] ;NO TRY NORMAL TEST LOOP
MOVE TD,NAMWRD+1
CAME TD,RWTBL2(TE) ;TRY NEXT WORD
POPJ PP, ;NO, FAILED
MOVE TD,NAMWRD+2 ;SOME WORD ARE MORE THAN 12 CHARACTERS
CAME TD,RWTBL3(TE)
POPJ PP, ;FAILED THIS TEST
RWFND: SETOM CVTRWM ;SIGNAL WE'VE FLAGGED IT ONCE AND
EWARNJ E.777 ;TELL USER ITS A RESERVED WORD IN 74
DEFINE RESWRD <
XX ALSO ;;ALSO
XX BOTTOM ;;BOTTOM
XX CHARAC,TER ;;CHARACTER
XX CODE:S,ET ;;CODE-SET
XX COLLAT,ING ;;COLLATING
XX COMP:2 ;;COMP-2
XX COMPUT,ATIONA,L:2 ;;COMP-2
XX DAY ;;DAY
XX DEBUGG,ING ;;DEBUGGING
XX DUPLIC,ATES ;;DUPLICATES
XX DYNAMI,C ;;DYNAMIC
XX END:OF,:PAGE ;;END-OF-PAGE
XX EOP ;;EOP
XX EXCEPT,ION ;;EXCEPTION
XX INSPEC,T ;;INSPECT
;;XX LINAGE ;;LINAGE
XX LINAGE,:COUNT,ER ;;LINAGE-COUNTER
XX NATIVE ;;NATIVE
XX ORGANI,ZATION ;;ORGANIZATION
XX PRINTI,NG ;;PRINTING
XX PROCED,URES ;;PROCEDURES
XX REFERE,NCES ;;REFERENCES
XX REMOVA,L ;;REMOVAL
XX RMS ;;RMS
XX SEPARA,TE ;;SEPARATE
XX SORT:M,ERGE ;;SORT-MERGE
XX STANDA,RD:1 ;;STANDARD-1
XX START ;;START
XX TOP ;;TOP
XX TRAILI,NG ;;TRAILING
>
DEFINE XX(A,B,C)<
SIXBIT /A/
>
RWTBL1: RESWRD ;FIRST SIX CHARS OF WORD
RWTBLN==.-RWTBL1 ;LENGTH OF TABLE
DEFINE XX(A,B,C)<
SIXBIT /B/
>
RWTBL2: RESWRD ;SECOND SIX CHAR OF WORD
DEFINE XX(A,B,C)<
SIXBIT /C/
>
RWTBL3: RESWRD ;THIRD (AND FINAL) SIX CHARS OF WORD
>
SUBTTL EXTERNALS
EXTERN FATAL,WARN,DEVDED,STINFL,TRYNAM
EXTERN PUTCPY,PUTCIF,PUTFEL,SIXOUT,LNKSET
EXTERN CURCPY,CPYBHO,LIBHDR,LIBBH,LIBDEV,LIBNAM
EXTERN RPLCNT,RPLLOC,RPLNXT
EXTERN IOSRCS,DEVFIL,DEVDEV,DEVEXT,DEVSW,DEVSIZ,SRCEND
EXTERN GETENT,PHASEN,OPRTR,DCPNT.
EXTERN DEVBH,OPENIT
EXTERN PSCAN,PICBUF,PICPTR
EXTERN SRCBH,SRCDEV,CRFBHO,CRFDEV,CREFSW,CPMAXN
EXTERN SEQIN
EXTERN WASERC,PUNPTR,PLUSWD,MINWD,MULWD,LPARWD,EXPWD,PERWD,ENDIT
EXTERN NAMWRD,LITVAL,NAMVAL,FILLOC,FILNXT
EXTERN GWNAMP,GWVAL,GWLN,GWCP
EXTERN CPOPJ,CPOPJ1
IFN DBMS,<
EXTERN FINVOK,DBBUFH,DBDEV,DBBLCK,DBONLY
>
IFN MCS!TCS,<
EXTERN CDLOC,CDNXT
>
IFN ANS74,<
EXTERN NOIDHY,DEBSW
>
EXTERN $LFPTR
;EXTERNAL DATA LOCATIONS OF INTEREST DURING COPY AND REPLACING
EXTERN CPYLOC ;FIRST WORD OF COPY TABLE
EXTERN CPYNXT ;NEXT FREE WORD IN COPY TABLE
EXTERN CPYFLG ;STORE STATUS OF FLAGS BEFORE COPY
EXTERN CPYCP ;CHARACTER POSITION OF WORD FOLLOWING COPY STATEMENT
EXTERN CPYW2 ;SAVE "W2" DURING COPY
EXTERN EOLKAR ;END-OF-LINE CHARACTER FOR LAST LINE
EXTERN ITEMCT ;TO SAVE "CT"
EXTERN BLNKLN ;LINE NUMBER OF FIRST OF A SERIRS OF BLANKS
EXTERN BLNKCP ;CHARACTER POSITION OF FIRST OF A SERIES OF BLANKS
EXTERN SAVBCP ;TO SAVE BLNKCP
EXTERN SAVBLN ;TO SAVE BLNKLN
EXTERN SRCCOL ;INPUT COLUMN (SAME AS INPTCP UNLESS TABS)
EXTERN INPTCP ;INPUT CHARACTER POSITION FOR SEQUENCED SOURCE
EXTERN INPTST ;FIRST INPUT CHARACTER POSITION FOR ITEM
EXTERN TERMQ ;CHARACTER DELIMITING ALPHA LITERAL
EXTERN NOCONT ;IF -1, THEN CONTINUATION CARDS ARE ILLEGAL
EXTERN AMARFL ;[1316] IF -1 FORCE A-MARGIN AFTER LF FOLLOWING
;[1316] * COMMENT
EXTERN NCPYSW ;IF -1, OUTPUT TO CPYFIL IS FORBIDDEN
EXTERN PADCNT ;NO. OF SPACES NEEDED TO LINE UP COPY REPLACEMENT
EXTERN PARCNT ;NO. OF PARENS SEEN DURING REPLACEMENT TEST
EXTERN PICNXT ;[557] -1 WHEN NEXT DATUM IS, OR COULD BE, A PICTURE STRING
EXTERN REGKAR ;A CHARACTER FROM SRCFIL, SAVED UPON ENTERING SETLIB
EXTERN RPLFLG ;FLAGS STORED BEFORE COPY REPLACING
EXTERN RPLLOC ;POINTER TO START OF REPLACEMENT LIST
EXTERN RPLNXT ;POINTER TO NEXT REPLACEMENT ITEM
EXTERN RPLNXW ;POINTER TO NEXT REPLACEMENT WORD
EXTERN RPLCNT ;COUNT OF REPLACEMENTS
EXTERN RPLBH ;REPLACEMENT "BUFFER HEADER" INFO
EXTERN RPLCP ;STORE "CP" SO WE CAN BACK UP
EXTERN RPLICP ;DITTO FOR "INPTCP"
EXTERN RPLCST ;"INPTST" STORED ON FIRST REPLACEMENT
EXTERN RPLBLK ;CURRENT LIBRARY BLOCK NUMBER
EXTERN PSTBUF ;STORE PSEUDO-TEXT
EXTERN SRCBFC ;BLOCK NUMBER OF INPUT SOURCE BUFFER
EXTERN TERSCN ;[657] IF NON-ZERO TERMINATE SCAN IF CURRENT CHAR. MATCHES CONTENTS
EXTERN SAVECH ;TERMINATING PUNCTUATION OF A WORD
EXTERN SAVECP ;"CP" SAVED IN "GETCH"
EXTERN SAVELN ;"LN" SAVED IN "GETCH"
EXTERN SAVCP1 ;"CP" SAVED IN "GETWRD"
EXTERN SAVLN1 ;"LN" SAVED IN "GETWRD"
EXTERN SAVEWD ;TO SAVE "W1" & "W2"
EXTERN WORDCP ;"CP" FOR FIRST CHARACTER OF DATUM
EXTERN WORDLN ;"LN" FOR FIRST CHARCHTER OF DATAUM
;ITEMS TO BE SAVED BEFORE REPLACEMENT TEST (AT RPLSAV)
EXTERN L1BH0 ;RPLBLK
EXTERN L1BH1 ;LIBBH+1
EXTERN L1BH2 ;LIBBH+2
EXTERN L1CPI ;INPTCP
EXTERN L1CPO ;SAVECP
;ITEMS TO BE SETUP ON FIRST BLANK ON LINE (AT SVLKAR)
EXTERN L2BH0 ;RPLBLK
EXTERN L2BH1 ;LIBBH+1
EXTERN L2BH2 ;LIBBH+2
EXTERN L2CPI ;INPTCP
EXTERN L2CPO ;SAVECP
EXTERN R1CPO
EXTERN R1CPI
;ITEMS TO BE STORED JUST AFTER DATUM (AT CPLB40)
EXTERN R2BH0
EXTERN R2BH1
EXTERN R2BH2
EXTERN R2CPO
EXTERN R2CPI
;ITEMS TO BE SAVED AT (SVSKAR)
EXTERN R3BH0
EXTERN R3BH1
EXTERN R3BH2
EXTERN R3CPO
EXTERN R3CPI
;ITEMS TO BE SAVED AT (SVPKAR)
EXTERN R4BH0
EXTERN R4BH1
EXTERN R4BH2
EXTERN R4CPI
EXTERN R4CPO
END