--- /dev/null
+/MARK SENSE BATCH AND PIP
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975, 1977
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/MARK SENSE BATCH AND PIP JANUARY 9, 1974
+/
+/
+/
+/ AUTHOR:
+/ MARK B. ROSENTHAL
+/ DIGITAL EQUIPMENT CORPORATION
+/
+/ VERSION 3A M.H. 28-APR-77
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+
+
+
+L7775=CLA CLL CMA RTL
+L7776=CLA CLL CMA RAL
+L7777=CLA CLL CMA
+L0002=CLA CLL CML RTL
+L0001=CLA CLL IAC
+CONTCH=3 /CONTINUATION CHARACTER
+RUBOUT=7 /RUBOUT BITS
+JOBBIT=0200 /BIT POSITION OF $JOB IN COLUMN 1
+EOFCHR=6004 /END OF FILE CARD CHARACTER IS _
+TABCHR=6010 /TAB CHARACTER
+FFCHR=3010 /FORM FEED CHARACTER
+NOCHR=6400 /# CHARACTER
+RCSE=6672 /CARD READER SELECT AND SKIP IF READY
+RCSD=6671 /CARD READER SKIP IF CARD DONE
+RCRD=6674 /CARD READER CLEAR CARD DONE FLAG
+RCSF=6631 /CARD READER SKIP IF DATA READY
+RCRB=6634 /CARD READER READ BINARY
+KCF=6030 /CLEAR KEYBOARD FLAG
+SYSNO=CLA CLL IAC /OS8 DEVICE NUMBER FOR SYS:
+DSKNO=CLA CLL CML RTL /OS8 DEVICE NUMBER FOR DSK:
+FETCH=1
+LOOKUP=2
+ENTER=3
+CLOSE=4
+DECODE=5
+CHAIN=6
+USRIN=10
+USROUT=11
+F0=0
+F1=10
+JSBITS=7746 /JOB STATUS WORD
+
+
+
+*10
+XR1, 0
+XR2, 0
+XRCDR, 0
+XROPT, 0
+
+
+*20
+ERROR=JMS I .; XERR
+CONVRT=JMS I .; XCONVR
+OUT=JMS I .;OUTAD, XOUT
+SAVFLD=JMS I .;XSAVDF
+USR=JMS I .; 200
+KEYWD, 0;0;0;0
+TEMP1, 0
+TEMP2, 0
+TEMP3, 0
+TEMP4, 0
+TEMP5, 0
+OPTCNT, 0 /OUTPUT BUFFER COUNT
+OPTSW, 0 /OUTPUT BUFFER THREE WAY SWITCH
+KEYADR, 0
+KEYVAL, 0
+ERRFLG, 0
+ERRCNT, 0
+CONFLG, 0
+LNCNT, 0
+USRFLG, 0
+OFILE, ZBLOCK 5 /OUTPUT FILE DEVICE, LENGTH, AND NAME
+CDRFLG, -1 /CDRIN TO PASSES LAST CARD IF 0
+BCLSW, 0
+CDREOF, -1
+DEVENT, 0 /ENTRY ADDRESS OF OUTPUT DEVICE HANDLER
+IOERR, 0 /ERROR NUMBER
+VERNO9, ISZ IOERR
+IOER8, ISZ IOERR
+CDRER7, ISZ IOERR
+OPTER6, ISZ IOERR
+OPTER5, ISZ IOERR
+OPTER4, ISZ IOERR
+OPTER3, ISZ IOERR
+OPTER2, ISZ IOERR
+OPTER1, JMP I .+1
+ IOERR1
+
+
+\f*200
+START, ISZ USRFLG;SKP /IS THE USR IN CORE?
+ JMP CD /YES
+ CIF 10;JMS I (7700;USRIN /LOCK USR IN CORE
+CD, L7777 /SET FLAG FOR USR IN CORE
+ DCA USRFLG
+ CIF 10;USR;DECODE;0 /DELETE TENTATIVE FILES
+ TAD (7577 /COPY OUTPUT FILE #1 (NAME AND DEVICE)
+ DCA XR1
+ CDF F1
+ TAD I (7644 /TEST /V SWITCH
+ AND (4
+ SZA CLA
+ JMP VERNO9 /YES - PRINT VERSION NUMBER
+ TAD I XR1
+ SNA /IF NOT SPECIFIED,
+ DSKNO /USE DEVICE DSK:
+ DCA OFILE
+ TAD I XR1
+ SNA /WAS A NAME GIVEN?
+ JMP OPTER1 /NO
+INIT1, DCA OFILE+1
+ TAD I XR1
+ DCA OFILE+2
+ TAD I XR1
+ DCA OFILE+3
+ TAD I XR1
+ DCA OFILE+4
+ TAD (OFILE+1
+ DCA BLOKNO /SET FILE NAME ADDRESS
+ TAD I (7605 /GET SECOND OUTPUT DEVICE SPECIFICATION
+ DCA I (7600 /MOVE TO FIRST FOR SPOOLING IN BATCH
+ CDF
+ TAD BLOKNO /GET ADDRESS OF FILE NAME
+ DCA I (CLOSNM /AND SAVE FOR CALL TO CLOSE
+ TAD (OPTDEV&7600+1 /SET DEVICE HANDLER SPACE
+ DCA DEVHDL
+ TAD OFILE
+ CIF 10;USR;FETCH /FETCH DEVICE HANDLER
+DEVHDL, OPTDEV&7600+1 /2 PAGES
+ JMP OPTER2 /ERROR - CANNOT FETCH HANDLER
+ TAD DEVHDL /MOVE ENTRY ADDRESS
+ DCA DEVENT /TO PAGE ZERO
+ TAD OFILE /ENTER THE FILE NAME AS TENTATIVE
+ CIF 10;USR;ENTER
+BLOKNO, OFILE+1 /FILE NAME, STARTING BLOCK RETURNED HERE
+FILLEN, 0 /RETURNS FILE LENGTH HERE
+ JMP OPTER3 /CANNOT ENTER FILE
+ CIF 10;USR;USROUT /DISMISS THE USR
+ DCA USRFLG /CLEAR USR IN CORE FLAG
+ CDF 10
+ TAD BLOKNO /SAVE STARTING BLOCK NO. FOR BATCH
+ DCA I (7620
+ TAD OFILE /SAVE DEVICE NO. FOR BATCH
+ AND (17
+ DCA I (7617
+ TAD I (7643 /GET OPTIONS
+ CDF F0
+ AND (2100 / /B OR /F
+ SNA
+ DCA I (EOFJMP /IF NEITHER, THEN WE CHAIN TO BATCH
+ CLL RTL /GET /B OUT OF AC
+ SZA CLA /IF AC=0 START WITH BASIC KEYWORDS
+ TAD (FORKEY-BASKEY
+ TAD (BASKEY-15
+ DCA KEYADR
+ JMP I (INIT5
+
+
+PAGE
+\fINIT5, TAD (BPRI2 /TAILOR IT FOR BATCH PROCESSING
+ DCA I (BPRKEY /"PRINT #4,"
+ TAD (BINP2
+ DCA I (BINKEY /"INPUT #3,"
+ TAD (BSTO2
+ DCA I (BSTKEY /"CLOSE# 4\STOP"
+ TAD (BEND2
+ DCA I (BENKEY /"CLOSE #4\END"
+ CDF F1
+ DCA I (CBAS5 /NO JUMP
+ DCA I (DATL48 /NO JUMP
+ TAD (CL2M1A /".R LOADER_*GENIOX"
+ DCA I (CL2SX
+ TAD I (7643 /TEST /I OPTION (INTERACTIVE)
+ AND (10
+ SNA CLA
+ JMP INIT6
+ TAD BASJMP /SET UP FOR FILES 0 & 1
+ DCA I (CBAS5 /SET UP THE JMP
+ TAD BASJM1 /SET UP JUMP
+ DCA I (DATL48
+ TAD (CL2M1 /".R LOADER_*"
+ DCA I (CL2SX
+ CDF F0
+ TAD (BPRI
+ DCA I (BPRKEY
+ TAD (BINP
+ DCA I (BINKEY
+ TAD (BSTO
+ DCA I (BSTKEY
+ TAD (BEND
+ DCA I (BENKEY
+INIT6, CDF 10
+ TAD I (7644 /TEST /T OPTION
+ AND (20
+ SNA CLA
+ TAD (BATLPT-BATTTY
+ TAD (BATTTY
+ CIF CDF F1
+ JMS I (MOVODV
+ TAD I (7645 /TEST /2 OPTION
+ AND (200
+ SNA CLA
+ JMP INIT3
+ TAD (CF2 /FORTRAN 2
+ DCA I (FORADR
+ TAD (CL2
+ DCA I (LOAADR
+ TAD (DATX2
+ JMP INIT4
+INIT3, TAD (CF4 /FORTRAN 4
+ DCA I (FORADR
+ TAD (CL4
+ DCA I (LOAADR
+ TAD (DATX4 /INITIALIZE $DATA
+INIT4, DCA I (DATFTN
+ TAD I (DATFTN
+ DCA I (DATADR
+ TAD (SAVARA
+ DCA I (SAVPNT
+ DCA I (NAMCNT
+ CDF F0
+ DCA BCLSW /NO BCL CARDS YET
+ L7777
+ DCA CDREOF /RESET EOF SWITCH
+ TAD I (BLOKNO /SET STARTING BLOCK NUMBER
+ DCA I (OPTBLK
+ TAD (OPTBUF-1
+ DCA XROPT
+ TAD (-200
+ DCA OPTCNT
+ L7775
+ DCA OPTSW
+ DCA ERRCNT /CLEAR COUNT OF CARDS IN ERROR
+ JMP I (READY
+
+BASJMP, JMP CBAS7&177+INIT5
+BASJM1, JMP DATL49&177+INIT5
+
+
+PAGE
+\fREADY, JMS I (CDRIN /READ A CARD
+ JMP I (EOF /END OF FILE SENSED
+ TAD I XRCDR /GET COLUMN 1
+ DCA KEYWD /SAVE AS KEYWORD BITS
+ TAD XRCDR
+ DCA XR2
+
+
+/TRANSLATE LINE NUMBER
+ TAD (-5
+ DCA TEMP1
+ DCA LNCNT /CLEAR COUNT
+ DCA KEYWD+3 /CLEAR COLUMN 2-6 KEYWORD BITS
+LNLP, TAD I XRCDR /GET LINE NO. COLUMN
+ DCA TEMP2 /SAVE CHAR
+ TAD (6000
+ AND TEMP2 /GET KEYWORD BITS
+ CLL RAL
+ RTL
+ TAD KEYWD+3
+ CLL RTL
+ DCA KEYWD+3
+ TAD (1777
+ AND TEMP2 /GET CHAR
+ SNA
+ JMP LNLPEN /IGNORE BLANKS
+ CONVRT /TRANSLATE
+ JMP LNLPEN /IGNORE RUBOUTS
+ TAD (-"9
+ SMA SZA
+ JMP LNERR /NOT A NUMBER
+ TAD ("9-"0
+ SPA
+ JMP LNERR /NOT A NUMBER
+ TAD ("0
+LNLP1, DCA I XR2 /INSERT CHARACTER IN OUTPUT BUFFER
+ ISZ LNCNT /COUNT THIS CHARACTER
+LNLPEN, ISZ TEMP1 /GOT ALL LINE NUMBER COLUMNS?
+ JMP LNLP /NO - LOOP.
+ JMP I (KEYTRA /GO TRANSLATE KEYWORD
+
+
+LNERR, ERROR
+ JMP LNLP1
+
+
+MAKNA2, 0 /FIELD 1 OUTPUT ROUTINE FOR MAKNAM
+ CIF CDF F1
+ JMS I (MAKNA3
+ JMP I MAKNA2
+
+OOUT2, 0
+ OUT
+ CIF CDF F1
+ JMP I OOUT2
+
+GETCD1, 0
+ TAD I XRCDR
+ CIF CDF F1
+ JMP I GETCD1
+
+/FOR RETURN TO CALLING FIELD
+/PRESERVES AC AND LINK WHILE PUTTING
+/CIF CDF TO DATA FIELD AT ADDRESS
+/SPECIFIED AS FIRST WORD AFTER CALL
+XSAVDF, 0
+ DCA XSAVD1
+ RDF
+ TAD (CIF CDF
+ DCA XSAVD2
+ CDF
+ TAD I XSAVDF
+ ISZ XSAVDF
+ DCA XSAVD3
+ TAD XSAVD2
+ DCA I XSAVD3
+ TAD XSAVD1
+ JMP I XSAVDF
+XSAVD1, 0
+XSAVD2, 0
+XSAVD3, 0
+
+PAGE
+\fXERR, 0
+K7600, 7600
+ TAD ("? /OUTPUT A "?"
+ ISZ ERRFLG /FLAG ERROR ON THIS CARD
+ JMP I XERR
+
+TIME=12
+
+CDRIN, 0 /READ A CARD INTO THE BUFFER
+ SAVFLD;CDRCIF /SAVE DATA FIELD FOR RETURN
+ DCA ERRFLG /CLEAR ERROR FLAG FOR THIS CARD
+ ISZ CDREOF /HAVE WE SEEN EOF?
+ JMP CDRCIF /YES - STILL EOF
+ ISZ CDRFLG /SHOULD WE PASS LAST CARD?
+ JMP REINIT /YES
+CDRIN6, JMS CDRIN5 /RESET TIME OUT COUNTERS
+ TAD (-50 /YES - READ IT INTO THE CDR BUFFER
+ DCA TEMP1 /40 COLUMNS (DECIMAL)
+ TAD (CDRBUF-1
+ DCA XRCDR
+CDRIN3, RCSE /CARD READY?
+ JMP CDRIN4 /TEST TIME OUT
+ JMS CDRIN5 /RESET TIME OUT COUNT
+CDRIN1, JMS KBRD /TEST KEYBOARD (AFTER TIME OUT LOOP)
+ RCSD /CARD DONE?
+ SKP
+ JMP CDRIN7 /YES - TOO FEW COLUMNS
+ RCSF /CHARACTER READY?
+ JMP CDRIN1 /NO - TRY CARD DONE
+ JMS CDRIN5 /RESET TIME OUT COUNT
+ RCRB /YES - READ BINARY
+CDRIN2, DCA I XRCDR /AND STORE IT
+ ISZ TEMP1 /DON'T READ MORE THAN BUFFER CAN HOLD
+ JMP CDRIN1 /TRY CARD DONE AGAIN
+ RCSD /WAIT FOR END OF CARD - OR ELSE!
+ JMP .-1
+ RCRD /IF THIS ISN'T CLEARED,
+ /FORTRAN IV BECOMES VERY UNHAPPY!
+ JMP CDRIN8
+CDRIN7, RCRD /FORTRAN IV AGAIN
+ ISZ TEMP1 /ALLOW ONE COLUMN TOO FEW (EDU30 - 39 COL)
+ JMP CDRER7 /ERROR!
+ DCA I XRCDR
+CDRIN8, TAD (CDRBUF-1 /INIT BUFFER POINTERS AGAIN
+ DCA XRCDR
+ TAD (-50
+ DCA TEMP1
+ TAD (-EOFCHR /TEST FOR FIRST COLUMN=EOFCHR AND REST =0
+EOFLP, TAD I XRCDR /GET NEXT COLUMN
+ SZA CLA
+ JMP REINIT /NON-ZERO - NOT EOF
+ ISZ TEMP1
+ JMP EOFLP /LOOP
+ JMP CDRCIF /END OF FILE CARD
+REINIT, TAD (CDRBUF-1
+ DCA XRCDR
+ ISZ CDRIN /SKIP RETURN IF NOT EOF
+ L7777 /RESET EOF SWITCH
+CDRCIF, 0
+ DCA CDREOF
+ L7777 /SET TO READ A NEW CARD NEXT TIME
+ DCA CDRFLG
+ JMP I CDRIN
+
+CDRIN4, JMS KBRD /TEST TIME OUT
+ JMP CDRIN3 /TRY SELECTING CARD AGAIN
+
+CDRIN5, 0 /RESET TIME OUT
+ DCA TIMOUT
+ TAD (-TIME
+ DCA TIMOU2
+ JMP I CDRIN5
+
+KBRD, 0
+ KSF /KEYBOARD?
+ JMP KBRDTM /NO - TIME
+ KRS /IS IT ^C?
+ AND (177
+ TAD (-3
+ SNA CLA
+ JMP I K7600 /YES - RETURN TO OS-8
+KBRDTM, ISZ TIMOUT /TIMED OUT YET?
+ JMP I KBRD /NO
+ ISZ TIMOU2
+ JMP I KBRD /LIKEWISE
+ KCF /IGNORE ANYTHING TYPED BEFORE THIS
+ TAD (207 /NOTHING - WAKE HIM UP
+ JMS I (TOUT
+ TAD (MSGJAM /IT COULD BE JAMMED
+ DCA TEMP1
+ JMS I (TTYOUT
+KBRD1, KSF /WAIT FOR A CHARACTER OR READER
+ JMP KBRD3
+KBRD2, KRS /GET THE CHAR
+ AND (177 /WITHOUT PARITY
+ TAD (-3 /IS IT ^C?
+ SNA
+ JMP I K7600 /YES - TO MONITOR
+ KCF /IF ^C - LEAVE FLAG SO OS-8 WILL SEE IT. ELSE CLEAR IT
+ TAD (3-32 /IS IT ^Z?
+ SNA CLA
+ JMP CDRCIF /YES - EOF
+ JMP CDRIN6 /GO BACK AND TIME OUT AGAIN
+KBRD3, RCSE /SELECT A CARD?
+ JMP KBRD1 /NO - TRY KEYBOARD
+ TAD (-50 /RESET COUNT
+ DCA TEMP1
+ TAD (CDRBUF-1 /AND POINTER
+ DCA XRCDR
+ JMP CDRIN3+2 /YES - RE-ENTER ROUTINE WITH SUCCESSFUL SELECT
+
+CDRJA1, KSF
+ JMP .-1
+ JMP KBRD2
+
+TIMOUT, 0
+TIMOU2, 0
+
+PAGE
+\fKEYTRA, TAD I XRCDR /GET KEYWORD COLUMN
+ DCA KEYWD+1
+ TAD I XRCDR /DITTO
+ DCA KEYWD+2
+/CONVERT KEYWORD BITS TO NUMBER
+ TAD (KEYWD-1 /POINT INDEX REGISTER TO KEYWORD BUFFER
+ DCA XR1
+ TAD (-4 /SET COUNT OF WORDS
+ DCA TEMP1
+ DCA KEYVAL /ZERO KEYWORD VALUE
+WRDLP, TAD (-14 /SET BIT COUNT
+ DCA TEMP2
+ TAD I XR1 /GET WORD
+BITLP, ISZ KEYVAL /BUMP BIT VALUE
+ CLL RAL /SHIFT INTO LINK
+ SZL /IS THIS ONE ON?
+ JMP KEYFND /YES - KEYWORD FOUND
+ ISZ TEMP2 /COUNT BITS
+ JMP BITLP
+ ISZ TEMP1 /COUNT WORDS
+ JMP WRDLP
+ JMS I (LNOUT /SEND THE LINE NO.
+ JMP I (TEXTRA /ALL BITS OFF - NO KEYWORD
+
+
+KEYBAD, ERROR
+ OUT
+ JMP KEYBLK
+
+
+ TAD I XR1 /GET NEXT WORD
+KEYFND, SZA CLA /TEST THIS WORD
+ JMP KEYBAD /ERROR - MORE THAN ONE KEYWORD MARKED
+ ISZ TEMP1 /COUNT WORDS
+ JMP KEYFND-1 /AND LOOP
+
+/OUTPUT THE KEYWORD
+ TAD KEYVAL /IS IT A BATCH CONTROL LANGUAGE COMMAND?
+ TAD (-14
+ SMA SZA CLA
+ JMP KEYOUT
+ L7777 /FOUND A BCL CARD
+ DCA BCLSW /GENERATE "$END" BEFORE CLOSING FILE
+ CIF CDF F1
+ JMP I (BCLTRA /YES - HANDLE THAT SPECIALLY
+
+
+KEYOUT, JMS I (LNOUT /SEND LINE NUMBER
+ TAD KEYADR
+ TAD KEYVAL
+ DCA TEMP1
+ TAD I TEMP1 /GET ADDRESS OF KEYWORD
+ SNA
+ JMP KEYBAD /IF ZERO - UNUSED KEYWORD
+ DCA TEMP1 /ELSE SAVE IT
+ TAD TEMP1 /IS THIS "INPUT" OR "PRINT
+ TAD (-BPRI2 /BEING FUDGED UNDER BASIC?
+ SNA
+ JMP NOSGN /PRINT - CHECK FOR NUMBER SIGN
+ TAD (BPRI2-BINP2
+ SZA CLA
+ JMP KEYOU5 /NONE - ALL'S WELL
+NOSGN, TAD (-40 /SET COUNT
+ DCA TEMP3
+NOSGN1, TAD I XRCDR /IS NEXT CHAR BLANK?
+ SZA
+ JMP NOSGN2 /NO - IS IT #
+ ISZ TEMP3
+ JMP NOSGN1
+ JMP NOSGN3 /REST IS BLANK
+NOSGN2, TAD (-NOCHR /IS IT "#"?
+ SZA CLA
+ JMP NOSGN3 /NO
+ TAD TEMP1 /YES - USE "INPUT" OR "PRINT"
+ TAD (-BPRI2
+ SZA CLA
+ TAD (BINP-BPRI
+ TAD (BPRI
+ DCA TEMP1
+NOSGN3, TAD (CDRBUF+7
+ DCA XRCDR
+KEYOU5, JMS I (UNPACK /AND OUTPUT KEYWORD
+KEYBLK, TAD (" /INSERT BLANK AFTER KEYWORD
+ OUT
+ JMP I (TEXTRA
+
+
+PAGE
+\fUNPACK, 0 /OUTPUT PACKED 6-BIT ASCII TEXT
+ TAD I TEMP1 /IS FIRST CHAR = 00?
+ AND (7700
+ SZA CLA
+ JMP KEYOU1 /NO - NORMAL 6-BIT TRANSLATE
+ TAD (211 /YES - THIS IS TAB RATHER THAN END
+ OUT /OUTPUT IT
+ JMP KEYOU3 /AND GET SECOND CHARACTER
+KEYOU1, TAD I TEMP1 /GET FIRST CHARACTER
+ CLL RTR
+ RTR
+ RTR
+ JMS KEYOU2 /AND OUTPUT IT
+KEYOU3, TAD I TEMP1 /GET SECOND CHARACTER
+ JMS KEYOU2 /AND OUTPUT IT
+ ISZ TEMP1 /POINT TO NEXT TWO CHARACTERS
+ JMP KEYOU1 /ETC.
+
+KEYOU2, 0
+ AND (77 /MASK FOR THE LOW ORDER BITS
+ SNA
+ JMP I UNPACK /CHARACTER IS 00 - END OF KEYWORD
+ TAD (-37 /<CR>?
+ SNA
+ TAD (215-337 /THIS WILL BE 215 WHEN WE'RE DONE
+ SPA
+ TAD (100
+ TAD (237
+ OUT /OUTPUT THE CHARACTER
+ JMP I KEYOU2
+
+TTYOUT, 0 /USE UNPACK ROUTINE TO PRINT MESSAGE ON TTY
+ TAD (TOUT /SWITCH OUTPUT ROUTINES
+ DCA OUTAD
+ JMS UNPACK
+ TAD (XOUT /RESET OUTPUT ROUTINES
+ DCA OUTAD
+ JMP I TTYOUT /RETURN
+
+
+LNOUT, 0 /OUTPUT THE LINE NUMBER
+ SAVFLD;LNCIF
+ TAD LNCNT /GET NUMBER OF CHARS
+ CMA
+ DCA TEMP1
+ TAD (CDRBUF /START WITH COLUMN 2
+ DCA XR2
+LNOUT1, ISZ TEMP1;SKP /MORE DIGITS?
+ JMP LNOUT2 /NO
+ TAD I XR2;OUT
+ JMP LNOUT1
+LNOUT2, TAD LNCNT /ANY DIGITS?
+ SNA CLA
+ JMP LNCIF
+ TAD (" ;OUT /YES - SUFFIX A BLANK
+LNCIF, 0
+ JMP I LNOUT
+
+
+PAGE
+\f/TRANSLATE TEXT
+TEXTRA, DCA CONFLG /CLEAR CONTINUATION FLAG
+ DCA TEMP1 /CLEAR COUNT OF BLANK CHARACTERS
+ TAD (-40 /32 COLUMNS OF TEXT (DECIMAL)
+ DCA TEMP3
+TEXLP1, TAD I XRCDR
+ SNA /BLANK?
+ JMP TEXBLK /YES - COUNT A BLANK
+ TAD (-CONTCH /CONTINUATION CHARACTER?
+ SNA
+ JMP TEXCON /YES - ENOUGH OF THIS CARD
+ TAD (CONTCH
+ CONVRT /TRANSLATE THE CHARACTER
+ JMP TEXLP2 /RUBOUT? - GET THE NEXT CHARACTER
+ DCA TEMP2 /SAVE THE CHARACTER
+ JMS TEXBOU /OUTPUT THE COUNTED BLANKS
+ TAD TEMP2
+ OUT /OUTPUT THE CHARACTER
+TEXLP2, ISZ TEMP3 /COUNT COLUMNS
+ JMP TEXLP1
+ TAD (215 /OUTPUT A <CR>
+ OUT
+ JMP TEXFIN
+
+
+TEXCON, JMS TEXBOU
+ CLA CMA
+ DCA CONFLG /SET THE CONTINUATION FLAG
+ JMP TEXFIN
+
+
+TEXBLK, ISZ TEMP1 /COUNT THE BLANKS
+ JMP TEXLP2 /GET THE NEXT CHARACTER
+
+
+TEXBOU, 0 /OUTPUT BLANKS
+ TAD TEMP1
+ CMA
+ DCA TEMP1
+TEXBO1, ISZ TEMP1 /MORE BLANKS
+ SKP
+ JMP I TEXBOU /NO - RETURN
+ TAD (" /YES - OUTPUT A BLANK
+ OUT
+ JMP TEXBO1
+
+
+TEXFIN, TAD ERRFLG /DID THIS CARD HAVE AN ERROR?
+ SZA CLA
+ ISZ ERRCNT /YES - COUNT IT
+ JMP I (READY /PROCESS NEXT CARD
+
+
+\f/CARD CODE TO ASCII CONVERSION ROUTINE
+XCONVR, 0 /INPUT 12 BIT CARD CODE - OUTPUT 8 BIT ASCII
+ SAVFLD;XCOCIF /SAVE DATA FIELD FOR RETURN
+ DCA CONVR1 /SAVE 12 BIT CARD CODE
+ TAD (RUBOUT
+ AND CONVR1
+ TAD (-RUBOUT
+ SNA CLA /WAS CHARACTER RUBBED OUT?
+ JMP XCOCIF /YES - RETURN 0 IN AC
+ ISZ XCONVR /NOT RUBBED OUT - SKIP RETURN
+ TAD CONVR1
+ RTL
+ RTL
+ AND (7 /GET ZONE BITS
+ CLL RAL
+ DCA CONVR2 /2*ZONE BITS
+ TAD CONVR2
+ RTL
+ TAD CONVR2 /10*ZONE BITS
+ DCA CONVR2
+ TAD CONVR1
+ RTL
+ RAL
+ AND (7770 /1-9 "PUNCHES"
+ SNA
+ JMP CONVR3 /IF ALL OFF DON'T INCREMENT COUNT
+ CLL RAL /SHIFT NEXT BIT INTO LINK
+ ISZ CONVR2 /COUNT THE BIT
+ SNL
+ JMP .-3 /LOOP IF OFF
+ SZA CLA
+ JMP CONILL /IF REST OF AC IS NOT ZERO - ILLEGAL CHARACTER
+CONVR3, TAD CONVR2 /GET DISPLACEMENT OF CHAR IN TABLE
+ CLL RAR /GET WORD DISPLACEMENT IN AC
+ TAD (TRTAB /ADDRESS OF WORD
+ DCA CONVR2
+ TAD I CONVR2 /GET WORD
+ SZL
+ JMP .+4 /IF DISPLACEMENT WAS ODD, USE LOW ORDER HALF OF WORD
+ RTR
+ RTR
+ RTR
+ AND (77 /MASK FOR LOW PART OF WORD
+ SNA
+ JMP CONVR4 /ZERO IN TABLE IS ILLEGAL CODE (MAYBE)
+ TAD (240
+ JMP XCOCIF /RETURN WITH 8 BIT ASCII IN AC
+CONVR4, TAD CONVR1 /GET 12-BIT CARD CODE
+ TAD (-TABCHR /IS IT A TAB CHAR?
+ SNA
+ JMP CONVR5 /YUP!
+ TAD (TABCHR-FFCHR /HOW ABOUT A FORM FEED?
+ SZA CLA
+ JMP CONILL /NOPE - IT'S REALLY BAD
+ TAD (214-211 /IT'S FORM FEED
+CONVR5, TAD (211 /IT'S TAB
+ JMP XCOCIF
+CONILL, ERROR /SET ERROR FLAG; RETURN "?" IN AC
+XCOCIF, 0
+ JMP I XCONVR
+
+CONVR1, 0
+CONVR2, 0
+
+
+PAGE
+\f/OUTPUT A CHARACTER. RETURNS .+1 IF CHARACTER IS
+/JUST STORED IN BUFFER. RETURNS .+2 IF NO MORE SPACE IN
+/EMPTY. RETURNS .+3 IF BLOCK WAS WRITTEN AND THERE ARE
+/MORE BLOCKS IN THE EMPTY.
+XOUTP, 0 /OUTPUT ROUTINE
+ ISZ OPTSW /THREE WAY SWITCH
+ JMP XOUT1
+ DCA XOUT2 /SAVE CHAR IN TEMP
+ L7777
+ TAD XROPT /BACK UP 2 WORDS
+ DCA XOUT3
+ TAD XOUT2 /GET FIRST HALF OF CHARACTER
+ RTL
+ RTL
+ AND K7400
+ TAD I XOUT3 /ADD IN FIRST CHARACTER
+ DCA I XOUT3
+ ISZ XOUT3
+ TAD XOUT2 /GET SECOND HALF OF CHARACTER
+ RTR
+ RTR
+ RAR
+ AND K7400
+ TAD I XOUT3 /ADD IN SECOND CHARACTER
+ DCA I XOUT3
+ ISZ OPTCNT /IS BUFFER FULL?
+ JMP XOUT6 /NO - RETURN NORMALLY
+ JMS I DEVENT /CALL DEVICE HANDLER
+ 4200 /TWO PAGES OF OUTPUT FROM FIELD 0
+ OPTBUF /BUFFER ADDRESS
+OPTBLK, 0 /BLOCK NUMBER
+ JMP OPTER4 /ERROR DOING OUTPUT
+ ISZ OPTBLK /INCREMENT BLOCK NUMBER
+ TAD (OPTBUF-1 /RESET BUFFER POINTER
+ DCA XROPT
+ TAD (-200 /AND BUFFER LENGTH /2
+ DCA OPTCNT
+ ISZ XOUTP /SKIP RETURN IF BLOCK WRITTEN
+ ISZ I (FILLEN /MORE BLOCKS IN EMPTY?
+ ISZ XOUTP /YES - SKIP AGAIN
+XOUT6, L7775 /RESET 3-WAY SWITCH
+ DCA OPTSW
+ JMP I XOUTP /RETURN
+
+XOUT1, DCA I XROPT /SAVE CHARACTER IN BUFFER
+ JMP I XOUTP
+
+XOUT2, 0
+XOUT3, 0
+
+
+XOUT, 0
+ DCA CLOSLN /SAVE CHAR IN A CONVENIENT TEMP
+ TAD CLOSLN
+ JMS XOUTP /OUTPUT THE CHARACTER
+ SKP
+ JMP OPTER5 /FILLED UP AVAILABLE SPACE BEFORE ^Z
+ TAD CLOSLN /WAS IT <CR>?
+ TAD (-215
+ SZA CLA
+ JMP I XOUT /RETURN
+ TAD (212
+ JMP XOUT+1
+
+
+EOF, DCA KEYVAL /FINISH UP ANY BCL CARD IN PROGRESS
+ DCA CONFLG /ZERO THESE TO GET US AROUND
+ DCA LNCNT /THE TESTS IN BCLHUH
+ CIF CDF F1
+ JMP I (BCLTRA
+EOF2, ISZ BCLSW /WERE THERE ANY BCL CARDS?
+ JMP EOF1 /NO
+ TAD (MEND /YES - SEND "$END"
+ DCA TEMP1
+ JMS I (UNPACK
+EOF1, TAD (32 /^Z
+ JMS XOUTP /OUTPUT CHAR
+ JMP .-1 /BLOCK NOT YET FULL
+K7400, 7400 /BLOCK WRITTEN
+ TAD I (BLOKNO /BLOCK WRITTEN
+ CIA
+ TAD OPTBLK /GET LENGTH OF FILE WRITTEN
+ DCA CLOSLN /SET LENGTH FOR CLOSE
+ ISZ USRFLG;SKP /IS USR IN CORE?
+ JMP EOF3 /YES
+ CIF 10;JMS I (7700;USRIN /BRING IN THE USR
+EOF3, L7777 /SET USR IN CORE FLAG
+ DCA USRFLG
+ TAD OFILE /GET DEVICE NUMBER
+ CIF 10;USR;CLOSE
+CLOSNM, 0 /POINTER TO NAME
+CLOSLN, 0 /LENGTH OF FILE
+ JMP OPTER6
+ TAD CLOSLN
+ CIA
+ RTL
+ RTL
+ AND (7760 /GET MINUS LENGTH IN BITS 0-7
+ CDF 10
+ TAD I (7617
+ DCA I (7617 /SET LENGTH AND DEVICE NO. FOR BATCH
+ CDF
+ JMP I (ERRDEC /CONVERT NUMBER OF ERRORS TO DECIMAL
+
+
+PAGE
+\f/CONVERT NUMBER OF CARDS IN ERROR TO DECIMAL AND TYPE MESSAGE
+ERRDEC, TAD (DECN-1 /START POWERS OF 10 AT 1000
+ DCA XR1
+ TAD (-4
+ DCA TEMP1 /FOUR POWERS OF 10
+ DCA TEMP5 /CLEAR LEADING ZEROES FLAG
+ TAD ERRCNT /SET VALUE
+ DCA TEMP4
+ TAD (TOUT /FUDGE OUTPUT CALL
+ DCA OUTAD
+ JMS CONDEC /CONVERT TO DECIMAL
+ TAD (XOUT /RESTORE OUTPUT CALL
+ DCA OUTAD
+ TAD (NOMES /SET UP TO PRINT "NO"
+ DCA TEMP1
+ TAD TEMP5 /DID WE PRINT A NUMBER?
+ SNA CLA
+ JMS I (TTYOUT /NO - PRINT "NO"
+ TAD (CDMES /PRINT "CARDS IN ERROR"
+ DCA TEMP1
+ JMS I (TTYOUT
+EOFJMP, JMP I (CD /DONE WITH THIS ONE - CALL COMMAND DECODER
+ SYSNO /LOAD SYS: NUMBER FOR LOOKUP
+ CIF 10;USR;LOOKUP
+BATBLK, BATNAM
+ 0
+ JMP IOER8
+ TAD BATBLK
+ DCA CHNBLK
+ L0001
+ DCA I (JSBITS /KEEP USR ACROSS CHAIN
+ CIF 10;USR;CHAIN /NOW CHAIN TO BATCH
+CHNBLK, 0
+
+
+CONDEC, 0 /CONVERT A NUMBER TO DECIMAL
+ SAVFLD;CONCIF /SAVE DATA FIELD FOR RETURN
+DIGLP, TAD I XR1 /GET THIS POWER OF 10
+ DCA TEMP2 /AND SAVE IT
+ DCA TEMP3 /CLEAR THIS DIGIT
+DIGLP1, TAD TEMP4 /GET NUMBER TO BE CONVERTED
+ TAD TEMP2 /DIVIDE BY SUBTRACTING
+ SPA
+ JMP DIGLP2 /WENT NEGATIVE - DONE
+ ISZ TEMP3 /BUMP COUNT
+ DCA TEMP4 /SAVE REDUCED VALUE
+ JMP DIGLP1
+DIGLP2, CLA
+ TAD TEMP3 /GET VALUE OF THIS DIGIT
+ SZA
+ JMP DIGOUT /NOT A ZERO - PRINT IT
+ TAD TEMP5 /IF ZERO - IS IT LEADING?
+ SNA CLA
+ JMP DIGLPE /YES - DON'T PRINT IT
+DIGOUT, ISZ TEMP5 /IF PRINTING, THEN ZEROES ARE NOT LEADING
+ TAD (260 /CONVERT TO ASCII
+ OUT
+DIGLPE, ISZ TEMP1 /LAST DIGIT?
+ JMP DIGLP /NO - LOOP
+CONCIF, 0
+ JMP I CONDEC /RETURN
+
+
+TOUT, 0 /SEND A CHARACTER TO THE TTY
+ TLS
+ TSF
+ JMP .-1
+ TAD (-215 /WAS THE CHARACTER <CR>?
+ SZA CLA
+ JMP I TOUT /NO - RETURN
+ TAD (212 /YES - TYPE A LINE FEED
+ JMP TOUT+1
+
+
+IOERR1, CDF F0
+ CLA /TYPE ERROR MESSAGE
+ TAD IOERR /GET NUMBER
+ CLL RAL
+ TAD (IOETAB-1
+ DCA XR1
+ TAD I XR1 /GET ADDRESS OF MESSAGE
+ DCA TEMP1
+ DCA IOERR /CLEAR ERROR NUMBER
+ JMS I (TTYOUT /PRINT IT
+ TAD I XR1 /GO TO RESTART ADDRESS
+ DCA TEMP1
+ JMP I TEMP1
+
+
+PAGE
+\fOPTDEV, ZBLOCK 400 /TWO PAGES FOR DEVICE HANDLER
+OPTBUF, ZBLOCK 400 /TWO PAGES FOR OUTPUT BUFFER
+CDRBUF, DECIMAL;ZBLOCK 40;OCTAL
+BATNAM, TEXT "BATCH@SV";*.-1
+MEND, TEXT "_$END_"
+NOMES, TEXT "NO"
+CDMES, TEXT " CARDS IN ERROR_"
+MSGJAM, TEXT "LOAD MORE CARDS OR TYPE ^Z_"
+IOEM1, TEXT "NO OUTPUT FILE SPECIFIED_"
+IOEM2, TEXT "CAN'T FETCH DEVICE HANDLER_"
+IOEM3, TEXT "CAN'T ENTER FILE_"
+IOEM4, TEXT "OUTPUT ERROR_"
+IOEM5, TEXT "FILE TOO BIG_"
+IOEM6, TEXT "CAN'T CLOSE FILE_"
+IOEM7, TEXT "CARD IN READER BACKWARDS. TYPE SPACE TO CONTINUE._"
+IOEM8, TEXT /"BATCH.SV" NOT ON SYS: - CAN'T CHAIN_/
+VERM9, TEXT "MSBAT - VERSION 3A_@@@@@@"
+
+IOETAB, IOEM1;START
+ IOEM2;START
+ IOEM3;START
+ IOEM4;START
+ IOEM5;START
+ IOEM6;START
+ IOEM7;CDRJA1
+ IOEM8;7600
+ VERM9;START
+
+ DECIMAL
+DECN, -1000
+ -100
+ -10
+ -1
+ OCTAL
+
+/CHARACTER CODE TRANSLATION TABLE
+TRTAB,
+/0 IN ROWS 12-0
+ 0021 /?1
+ 2223 /23
+ 2425 /45
+ 2627 /67
+ 3031 /89
+/1
+ 2043 /0C
+ 4651 /FI
+ 5457 /LO
+ 6265 /RU
+ 7004 /X$
+/2
+ 1442 /,B
+ 4550 /EH
+ 5356 /KN
+ 6164 /QT
+ 6772 /WZ
+/3
+ 3632 />:
+ 0106 /!&
+ 7540 /]@
+ 0000 /<FORM FEED> ?
+ 0000 /??
+/4
+ 1641 /.A
+ 4447 /DG
+ 5255 /JM
+ 6063 /PS
+ 6671 /VY
+/5
+ 3400 /<?
+ 0000 /??
+ 0000 /??
+ 0000 /??
+ 0000 /??
+/6
+ 3303 /;#
+ 0705 /'%
+ 7337 /[? THE REAL ?
+ 0077 /<TAB> _
+ 0000 /??
+/7
+ 7435 /\=
+ 1315 /+-
+ 1217 /*/
+ 7610 /^(
+ 1102 /)"
+
+
+\f/BASIC KEYWORDS
+BDAT, TEXT "DATA"
+BCAL, TEXT "CALL"
+BCLO, TEXT "CLOSE"
+BDEF, TEXT "DEFINE"
+BCHN, TEXT "CHAIN"
+BDIM, TEXT "DIMENSION"
+BCHG, TEXT "CHANGE"
+BEND, TEXT "END"
+BEND2, TEXT "CLOSE #4\END"
+BFIL, TEXT "FILE"
+BGOS, TEXT "GOSUB"
+BIF, TEXT "IF"
+BINP, TEXT "INPUT"
+BINP2, TEXT "INPUT #3:"
+BLIS, TEXT "LIST"
+BNEX, TEXT "NEXT"
+BOLD, TEXT "OLD"
+BPRI, TEXT "PRINT"
+BPRI2, TEXT "PRINT #4:"
+BREA, TEXT "READ"
+BRES, TEXT "RESTORE"
+BRUN, TEXT "RUN"
+BFOR, TEXT "FOR"
+BGOT, TEXT "GOTO"
+BIFE, TEXT "IF END"
+BLET, TEXT "LET"
+BLIN, TEXT "LINPUT"
+BNEW, TEXT "NEW"
+BON, TEXT "ON"
+BRND, TEXT "RANDOM"
+BOV, TEXT "OVERLAY"
+BREP, TEXT "REPLACE"
+BUNS, TEXT "UNSAVE"
+BREM, TEXT "REMARK"
+BRET, TEXT "RETURN"
+BSAV, TEXT "SAVE"
+BSTO, TEXT "STOP"
+BSTO2, TEXT "CLOSE #4\STOP"
+
+/FORTRAN KEYWORDS
+FCMN, TEXT "@COMMON"
+FASN, TEXT "@ASSIGN"
+FCPX, TEXT "@COMPLEX"
+FBKS, TEXT "@BACKSPACE"
+FCNT, TEXT "@CONTINUE"
+FBKD, TEXT "@BLOCK DATA"
+FDTA, TEXT "@DATA"
+FCAL, TEXT "@CALL"
+FDEF, TEXT "@DEFINE FILE"
+FDO, TEXT "@DO"
+FEND, TEXT "@END"
+FEQU, TEXT "@EQUIVALENCE"
+FFOR, TEXT "@FORMAT"
+FGOT, TEXT "@GO TO"
+FINT, TEXT "@INTEGER"
+FPAU, TEXT "@PAUSE"
+FREAL, TEXT "@REAL"
+FREW, TEXT "@REWIND"
+FSBR, TEXT "@SUBROUTINE"
+FCMT, TEXT "C" /COMMENT
+FDIM, TEXT "@DIMENSION"
+FDBP, TEXT "@DOUBLE PRECISION"
+FEF, TEXT "@END FILE"
+FEXT, TEXT "@EXTERNAL"
+FFUN, TEXT "@FUNCTION"
+FIF, TEXT "@IF"
+FLOG, TEXT "@LOGICAL"
+FREAD, TEXT "@READ"
+FRET, TEXT "@RETURN"
+FSTO, TEXT "@STOP"
+FWRI, TEXT "@WRITE"
+\fBASKEY,
+/COLUMN 7 ROW
+ BDEF /12
+ BIFE /11
+ BLET /0
+ BLIS /1
+ BNEW /2
+ BON /3
+ BOV /4
+ BRND /5
+ BREM /6
+ BRES /7
+ BRUN /8
+BSTKEY, BSTO /9
+/COLUMN 8 ROW
+ BDIM /12
+BINKEY, BINP /11
+ BLIN /0
+ BNEX /1
+ BOLD /2
+ BFIL /3
+BPRKEY, BPRI /4
+ BREA /5
+ BREP /6
+ BRET /7
+ BSAV /8
+ BUNS /9
+/COLUMNS 2-6 COLUMN ROW
+ BCAL /2 12
+BENKEY, BEND /2 11
+ BCLO /3 12
+ BFOR /3 11
+ BCHN /4 12
+ BGOS /4 11
+ BCHG /5 12
+ BGOT /5 11
+ BDAT /6 12
+ BIF /6 11
+
+
+FORKEY,
+/COLUMN 7 /ROW
+ FCAL /12
+ FDEF /11
+ FDO /0
+ FEND /1
+ FEQU /2
+ FFOR /3
+ FGOT /4
+ FINT /5
+ FPAU /6
+ FREAL /7
+ FREW /8
+ FSBR /9
+/COLUMN 8 ROW
+ FCMT /12
+ FDIM /11
+ FDBP /0
+ FEF /1
+ FEXT /2
+ FFUN /3
+ FIF /4
+ FLOG /5
+ FREAD /6
+ FRET /7
+ FSTO /8
+ FWRI /9
+/COLUMN 2-6 COLUMN ROW
+ 0 /2 12
+ 0 /2 11
+ 0 /3 12
+ FCMN /3 11
+ FASN /4 12
+ FCPX /4 11
+ FBKS /5 12
+ FCNT /5 11
+ FBKD /6 12
+ FDTA /6 11
+
+
+\f FIELD 1
+
+
+
+
+
+*17
+
+
+OXR1, 0
+OTEMP1, 0
+CHAR, 0
+PUTPNT, 0
+GETPNT, 0
+DATFTN, 0 /ADDRESS OF FORTRAN $RUN
+GETCHR=JMS I .;XGETCH
+PUTCHR=JMS I .;XPUTCH
+BCLIN=JMS I .;XBCLIN
+OPTION=JMS I .;XOPTIO
+MOV6=JMS I .;XMOV6
+COLNAM=JMS I .;XCOLNA
+OUTNAM=JMS I .;XOUTNA
+ISIT=JMS I .;XISIT
+SEND=JMS I .;XSEND
+TSTCR=JMS I .;XTSTCR
+CDRTRA=JMS I .;BCLTRA+1
+ISNUM=JMS I .;XISNUM
+OUT1=JMS I .;OOUT1
+\f*200
+
+
+/PUT A CHARACTER INTO A 6-BIT BUFFER
+PUTCH1=XGETCH
+PUTCH4=CON628
+XPUTCH, 0
+ TAD (-215 /IF <CR>, IT BECOMES 37
+ SZA
+ TAD (215-337
+ TAD (337
+ AND (77 /AND OFF 6 BITS
+ DCA PUTCH1 /SAVE IT IN A TEMP
+ TAD PUTPNT /GET POINTER TO CHARACTER IN 6-BIT BUFFER
+ ISZ PUTPNT /AND BUMP POINTER
+ CLL RAR /GET WORD DISPLACEMENT
+ TAD I XPUTCH /ADD IN BASE ADDRESS
+ ISZ XPUTCH /BUMP RETURN ADDRESS
+ DCA PUTCH4 /SAVE ADDRESS OF WORD CONTAINING CHAR
+ SZL /LINK HAS FIRST OR LAST HALF INDICATOR
+ JMP PUTCH2
+ TAD PUTCH1 /FIRST HALF - ROTATE CHAR INTO HIGH BITS
+ CLL RTL;RTL;RTL
+ DCA PUTCH1
+ TAD I PUTCH4 /GET ANY CHARACTER ALREADY THERE
+ AND (77
+ JMP PUTCH3
+PUTCH2, TAD I PUTCH4
+ AND (7700 /GET CHARACTER ALREADY THERE
+PUTCH3, TAD PUTCH1 /ADD IN NEW CHARACTER
+ DCA I PUTCH4 /STORE THEM BOTH
+ JMP I XPUTCH /AND RETURN
+
+
+/GET A CHARACTER FROM A 6-BIT BUFFER
+XGETCH, 0
+ TAD XGETCH /MOVE RETURN ADDRESS TO CON628
+ DCA CON628
+ TAD GETPNT /GET POINTER TO CHARACTER
+ ISZ GETPNT /BUMP IT FOR NEXT TIME
+ JMP CON628+1 /ENTER CONVERSION ROUTINE
+
+
+/CONVERT 6-BIT ASCII TO 8-BIT
+/AC HAS POINTER TO CHARACTER
+/ARGUMENT IS BASE ADDRESS OF BUFFER
+CO628X=XGETCH
+CON628, 0
+ CLL RAR /GET WORD DISPLACEMENT IN AC
+ TAD I CON628 /ADD BASE ADDRESS OF BUFFER
+ ISZ CON628 /BUMP RETURN ADDRESS
+ DCA CO628X /SAVE ADDRESS
+ TAD I CO628X /GET WORD CONTAINING CHARACTER
+ SZL /LINK HAS INDICATOR FOR FIRST OR LAST CHAR
+ JMP .+4
+ RTR;RTR;RTR /FIRST CHAR - PUT IN LOW BITS
+ AND (77
+ JMS XSEND3 /GET PROPER 8-BIT REPRESENTATION
+ DCA CHAR /SAVE IT
+ TAD CHAR /RETURN WITH IT IN AC
+ JMP I CON628 /RETURN
+
+
+XSEND3, 0
+ TAD (-37
+ SNA
+ TAD (215-337
+ SPA
+ TAD (100
+ TAD (237
+ JMP I XSEND3
+
+
+GETCDR, 0
+ CIF CDF F0
+ JMS I (GETCD1 /GET A CHAR FROM THE CDR BUFFER
+ JMP I GETCDR
+
+
+OOUT1, 0
+ CIF CDF F0
+ JMS I (OOUT2
+ JMP I OOUT1
+
+
+MOVODV, 0
+ DCA .+2
+ MOV6;0;BATOUT
+ CIF F0 /RETURN DF=1
+ JMP I MOVODV
+
+
+XTSTCR, 0
+ GETCHR;BCLBUF
+ TAD (-215
+ SNA CLA
+ ISZ XTSTCR
+ L7777
+ TAD GETPNT
+ DCA GETPNT
+ JMP I XTSTCR
+
+
+PAGE
+\f/SUBROUTINE OPTION WILL SCAN THE BATCH CONTROL LANGUAGE
+/BUFFER FOR OPTIONS SPECIFIED IN IT'S CALL. AN OPTION IS
+/RECOGNIZED AS ANY ITEM WHICH FOLLOWS A "/". IT'S NAME
+/IS COMPOSED OF ANY CHARACTERS OTHER THAN "/" , "," ,
+/"=",OR <CR>. THE NAME IS TERMINATED BY ANY ONE OF THE
+/PREVIOUS DELIMITERS. IF IT IS TERMINATED BY A "=" AND
+/THE SUBROUTINE CALL INDICATES THAT IT EXPECTS A FILE NAME,
+/THEN THE FILE NAME FOLLOWS THE "=" AND IS TERMINATED BY A
+/"/" , "," , OR <CR>. THE SUBROUTINE CALL IS FOLLOWED BY A
+/POINTER TO A LIST OF ADDRESSES. THIS LIST IS TERMINATED BY
+/A ZERO ENTRY. EACH ENTRY POINTS TO AN OPTION CONTROL
+/BLOCK IN THE FOLLOWING FORM:
+/ OPTION CONTROL WORD
+/ (FILE NAME SPACE IF NEEDED - 6 WORDS)
+/ TEXT "OPTION NAME"
+/
+/THE FORMAT OF THE OPTION CONTROL WORD IS AS FOLLOWS:
+/ BIT 0: ON RETURN THIS BIT WILL BE SET IF
+/ THE OPTION WAS FOUND, AND CLEARED
+/ IF NOT
+/ BIT1: ON RETURN THIS BIT IS SET IF A NAME
+/ WAS GIVEN WITH THE OPTION
+/ BIT 2: SET IF OPTION HAS ALLOCATED 6 WORDS
+/ FOR A POSSIBLE FILE NAME. CLEARED
+/ IF NOT
+/ BITS 6-8: NUMBER OF CHARACTERS -1 OF SHORT
+/ FORM OF OPTION
+/ BITS 9-11: DIFFERENCE BETWEEN SIZES OF
+/ SHORT AND LONG FORMS
+/ THE SUM OF BITS 6-8 AND BITS 9-11
+/ SHOULD TOTAL THE LENGTH OF THE
+/ LONG FORM-1
+/
+/THE FILE NAME SPACE MAY BE INITIALIZED TO SOME DEFAULT
+/DEVICE, NAME, AND EXTENSION.
+/
+XOPTIO, 0
+
+/TURN OFF ALL OPTIONS
+ TAD I XOPTIO /GET ADDRESS OF LIST OF OPTION ADDRESSES
+ DCA OPTLIS /SAVE IT
+OPTIO1, TAD I OPTLIS /GET OPTION ADDRESS
+ ISZ OPTLIS /POINT TO NEXT ONE
+ SNA
+ JMP OPTIO2 /DONE TURNING OFF ALL OPTIONS
+ DCA OPTCTL
+ TAD I OPTCTL /GET OPTION CONTROL WORD
+ AND (1777 /CLEAR FIRST BIT
+ DCA I OPTCTL
+ JMP OPTIO1 /LOOP
+
+/SEARCH BCL BUFFER FOR "/"
+OPTIO2, DCA GETPNT /START AT BEGINNING OF BATCH CONTROL LINE
+OPTIO3, GETCHR;BCLBUF /GET A CHARACTER FROM THE BUFFER
+ ISIT /IS IT "/" OR <CR>?
+ OPTIS3;OPTIS4-1
+ JMP OPTIO3 /NO - KEEP LOOKING
+OPTI3A, TAD GETPNT /YES - SAVE IT'S POSITION
+ DCA OPTBEG
+ TAD I XOPTIO /GET ADDRESS OF LIST AGAIN
+ DCA OPTLIS /AND SAVE IT
+
+/FOUND A "/" - TRY ALL OPTIONS
+OPTIO4, TAD OPTBEG /START COMPARISON OF OPTION WITH CHARACTER AFTER "/"
+ DCA GETPNT
+ TAD I OPTLIS /GET ADDRESS OF OPTION CONTROL WORD
+ ISZ OPTLIS /AND BUMP POINTER FOR NEXT TIME
+ SNA /IS THE LIST ENDED?
+ JMP I (OPTIER /YES - OPTION WAS INVALID
+ DCA OPTCTL /NO - SAVE ADDRESS OF CONTROL WORD
+ TAD I OPTCTL /GET CONTROL WORD
+ RTL
+ SPA CLA /DOES IT HAVE SPACE FOR A FILE NAME
+ TAD (6 /YES - ADD SIZE OF THE SPACE
+ TAD OPTCTL /ADD ADDRESS OF OPTION
+ IAC /BUMP ONE FOR CONTROL WORD
+ DCA OPTTEX /SAVE ADDRESS OF OPTION TEXT
+ TAD I OPTCTL /GET LENGTH FOR UNIQUE OPTION FROM CONTROL WORD
+ RAR;RTR
+ AND (7
+ CMA /NEGATE IT (INCREMENTED BY ONE)
+ DCA OPTCT1 /SAVE IN COUNTER
+ DCA OPTCT2 /ZERO CHARACTER POSITION
+\f/COMPARE OPTION WITH CONTENTS OF BCL BUFFER
+OPTIO5, JMS OPTI6A
+ SZA CLA /ARE THEY THE SAME?
+ JMP OPTIO4 /NO - TRY NEXT OPTION
+ ISZ OPTCT1 /HAVE WE SUCCEEDED FAR ENOUGH FOR IT TO BE UNIQUE?
+ JMP OPTIO5 /NO - KEEP COMPARING
+
+ TAD GETPNT /SAVE CURRENT BUFFER POSITION
+ DCA OPTTM2
+ TAD I OPTCTL /GET REMAINING LENGTH FROM CONTROL WORD
+ AND (7
+ CMA
+ DCA OPTCT1
+OPTIO6, ISZ OPTCT1 /DONE WITH REMAINING CHARACTERS?
+ SKP
+ JMP OPTIO7 /YES - SUCCESS
+ JMS OPTI6A
+ SNA CLA /ARE THEY THE SAME?
+ JMP OPTIO6 /YES - KEEP GOING
+ TAD OPTTM2 /NO - MOVE POINTER BACK TO SHORT FORM
+ DCA GETPNT
+ JMP OPTIO7
+
+OPTI6A, 0
+ TAD OPTCT2
+ ISZ OPTCT2
+ JMS I (CON628
+OPTTEX, 0
+ CIA
+ DCA OPTTM1
+ GETCHR;BCLBUF
+ TAD OPTTM1
+ JMP I OPTI6A
+
+
+OPTRET, ISZ XOPTIO /INCREMENT RETURN ADDRESS
+ DCA GETPNT /SET POINTER TO BEGINNING OF BUFFER
+ JMP I XOPTIO
+
+
+OPTLIS, 0
+OPTCTL, 0
+OPTBEG, 0
+OPTCT1, 0
+OPTCT2, 0
+OPTTM1, 0
+OPTTM2, 0
+
+
+\f/TEST DELIMITER AFTER OPTION
+OPTIO7, GETCHR;BCLBUF /GET NEXT BUFFER CHARACTER
+ ISIT /IS IT "=", "," ,"/", OR <CR>?
+ OPTIS1;OPTIS2-1
+ JMP I (OPTIER /NONE OF THESE
+OPTIO8, TAD I OPTCTL /YES - GET CONTROL WORD
+ RTL
+ SMA CLA /DOES IT TAKE A FILE NAME?
+ JMP I (OPTIER /NO - ERROR
+ TAD OPTCTL /GET ADDRESS OF FILE NAME SPACE
+ IAC
+ DCA .+2
+ COLNAM /AND COLLECT A NAME INTO IT
+OPTTM3, 0
+ JMP I (OPTIER /ERROR RETURN
+ TAD I OPTCTL /TURN ON NAME BIT
+ AND (1777
+ TAD (2000
+ DCA I OPTCTL
+OPTIO9, TAD I OPTCTL /GET CONTROL WORD
+ AND (3777
+ TAD (4000 /TURN ON OPTION FOUND BIT
+ DCA I OPTCTL
+ JMP I (OPTI10
+
+
+PAGE
+\f/ON ERROR, REPORT IT
+OPTIER, TAD I (OPTBEG /OPTION BEGINS AT THIS POSITION
+ JMS OUTERR /OUTPUT THE ERROR
+ OPTERM
+
+/SQUISH THE CURRENT OPTION OUT OF BCL BUFFER
+OPTI10, L7777 /BACK UP OVER "/"
+ TAD I (OPTBEG /POINT TO BEGINNING OF OPTION
+ JMS BCLSQU /SQUISH OUT THIS OPTION
+ L7777
+ TAD I (OPTBEG
+ JMP I (OPTIO2 /GO LOOK FOR MORE OPTIONS
+
+
+\f/SQUISH OUT A PORTION OF THE BCL BUFFER
+/ TAD X /POSITION OF FIRST CHAR OF SQUISH
+/ JMS BCLSQU
+/GETPNT POINTS TO FIRST CHAR SURE TO BE KEPT AFTER
+/SQUISH CHARS. ONE CHAR PRECEDING IT IS TESTED,
+/AND IS KEPT IF IT IS A "/" OR <CR>
+BCLSQU, 0
+ DCA PUTPNT /AC POINTS TO BEGINNING OF AREA TO BE SQUISHED
+ TAD PUTPNT /SAVE THE POINTER
+ DCA OUTERR
+ L7777
+ TAD GETPNT
+ DCA GETPNT /TEST LAST CHAR OF STUFF TO BE SQUISHED
+ GETCHR;BCLBUF
+ ISIT /IS IT "/", OR <CR>?
+ BCLIS1;BCLIS2-1
+BCLSQ1, GETCHR;BCLBUF /GET A CHAR
+ TAD (-215 /IS IT <CR>?
+ SNA CLA
+ JMP BCLSQ3 /YES - DONE
+BCLSQ2, TAD CHAR /RESTORE CHAR
+ PUTCHR;BCLBUF /PUT THE CHAR IN THE BUFFER
+ JMP BCLSQ1 /GET ANOTHER CHAR
+BCLSQ3, TAD (215 /PUT A <CR>
+ PUTCHR;BCLBUF
+ TAD OUTERR /RESTORE POINTER
+ DCA GETPNT
+ JMP I BCLSQU /RETURN
+
+
+/SEND AN ERROR MESSAGE INCLUDING PART OF THE BCL BUFFER
+/TO THE OUTPUT BUFFER
+/ TAD X /POSITION OF FIRST CHAR IN BUFFER TO BE SENT
+/ JMS OUTERR
+/ A /ADDRESS OF ERROR MESSAGE TO PRECEDE IT
+/ /SIX-BIT ASCII
+OUTERR, 0
+ DCA GETPNT /SET BEGINNING OF BCL LINE TO OUTPUT
+ TAD I OUTERR /GET ERROR MESSAGE ADDRESS
+ ISZ OUTERR
+ SEND /PRINT IT
+OUTER1, GETCHR;BCLBUF /GET A CHARACTER
+ ISIT /IS IT "," ,"/", OR <CR>?
+ OUTIS1;OUTIS2-1
+ TAD CHAR /NO - SEND CHAR
+ OUT1
+ JMP OUTER1
+OUTER2, TAD (215
+ OUT1
+ JMP I OUTERR /RETURN
+
+
+/TEST A CHAR AND JUMP IF IN LIST
+/ JMS XISIT
+/ A1 /ADDRESS OF LIST OF NEGATIVE OF CHARS
+/ /TERMINATED BY A POSITIVE OR ZERO
+/ A2-1 /ADDRESS -1 OF LIST OF
+/ /TRANSFER ADDRESSES
+XISIT, 0
+ DCA ISIT1 /SAVE CHAR
+ TAD I XISIT /GET LIST OF CHARS
+ ISZ XISIT
+ DCA ISIT2
+ TAD I XISIT /GET LIST OF ADDRS - 1
+ ISZ XISIT
+ DCA ISIT3
+ISIT4, TAD I ISIT2 /GET THE NEXT CHAR
+ ISZ ISIT2
+ ISZ ISIT3
+ SMA
+ JMP ISIT5 /END OF LIST SIGNALLED BY ENTRY>=0
+ TAD ISIT1 /IS IT THE CHAR?
+ SZA CLA
+ JMP ISIT4 /NO - TRY THE NEXT
+ TAD I ISIT3 /GET SEND ADDRESS
+ DCA XISIT
+ISIT5, CLA
+ JMP I XISIT
+
+ISIT1, 0
+ISIT2, 0
+ISIT3, 0
+
+
+PAGE
+\f/COLLECT A NAME FROM THE BUFFER
+/ JMS XCOLNA
+/ X /ADDRESS OF SPACE TO RECEIVE NAME
+/ JMP ERR /INVALID NAME
+XCOLNA, 0
+ TAD I XCOLNA
+ DCA .+3
+ MOV6;ZER6;0
+ TAD I XCOLNA /ARGUMENT IS ADDRESS TO PUT NAME
+ ISZ XCOLNA
+ DCA COLPU1+2 /SAVE IT FOR USE AS PUTCHR ARG
+ L7776 /SET NAME - EXTENSION SWITCH FOR NAME
+ DCA COLSW
+ TAD (COLIS1 /SET TO COLLECT ANYTHING
+ DCA COLIS3 /I.E. DEVICE, FILE, OR EXTENSION
+ TAD (COLIS2-1
+ DCA COLIS3+1
+ TAD GETPNT /SAVE POINTER TO BEGINNING OF NAME
+ DCA COLNP1
+COLGE1, TAD GETPNT /SAVE POINTER TO BEGINNING OF SECTION
+ DCA COLNP2 /OF NAME
+COLGE2, GETCHR;BCLBUF /GET A CHAR
+ ISIT /IS IT ":",".","/", "," , OR <CR>?
+COLIS3, 0;0
+ JMP COLGE2
+
+COLDEV, JMS COLMOV;0;-4-1 /MOVE 4 CHARS TO POSITION 0
+ ISZ COLIS3 /REMOVE ":" FROM LIST
+ ISZ COLIS3+1
+ JMP COLGE1 /COLLECT NEXT PART OF NAME
+
+COLFIL, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4
+ ISZ COLSW /NEXT TIME COLLECT EXTENSION
+ TAD (COLIS1+2 /REMOVE "." FROM LIST
+ DCA COLIS3
+ TAD (COLIS2+1
+ DCA COLIS3+1
+ JMP COLGE1 /COLLECT NEXT PART OF NAME
+
+COLEXT, ISZ COLSW /ARE WE COLLECTING NAME OR EXTENSION?
+ JMP COLEX1 /NAME
+ JMS COLMOV;12;-2-1 /MOVE 2 CHARS TO POSITION 12
+ JMP COLEX2
+COLEX1, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4
+COLEX2, ISZ XCOLNA /NO ERRORS
+ JMP COLEX3
+
+COLERR, CLA
+ TAD COLNP1 /POINT TO BEGINNING OF NAME
+ JMS I (OUTERR /SEND IT AS ERROR MESSAGE
+ COLERM
+COLEX3, TAD COLNP1 /POINT TO BEGINNING OF NAME
+ JMS I (BCLSQU /SQUISH IT OUT
+ JMP I XCOLNA /RETURN
+
+COLMOV, 0
+ TAD I COLMOV /FIRST ARG IS POSITION
+ ISZ COLMOV
+ DCA PUTPNT
+ TAD I COLMOV /SECOND ARG IS COUNT
+ ISZ COLMOV
+ DCA COLCT1
+ TAD CHAR /GET DELIMITER
+ CIA
+ DCA COLCH1 /SAVE FOR TEST
+ TAD CHAR
+ TAD (-"Z
+ DCA COLCH2 /ANOTHER TEST
+ TAD COLNP2 /POINT TO BEGINNING OF THIS PART
+ DCA GETPNT
+COLMV1, GETCHR;BCLBUF /GET NEXT CHAR
+ TAD COLCH1 /SUBTRACT THE DELIMITER
+ SNA
+ JMP I COLMOV /DELIMITER - WE'RE DONE
+ TAD COLCH2 /CHAR-"Z"
+ SMA SZA
+ JMP COLERR /NOT ALPHA-NUMERIC
+ TAD ("Z-"A
+ SMA
+ JMP COLPUT /ALPHABETIC
+ TAD ("A-"9
+ SMA SZA
+ JMP COLERR /NOT NUMERIC
+ TAD ("9-"0
+ SPA
+ JMP COLERR /NOT NUMERIC
+COLPUT, CLA
+ ISZ COLCT1 /HAVE WE USED UP OUR COUNT?
+ JMP COLPU1 /NO - PUT THE CHAR
+ L7777 /YES - SET COUNTER TO SKIP
+ DCA COLCT1
+ JMP COLMV1 /GET NEXT CHAR
+COLPU1, TAD CHAR
+ PUTCHR;0 /PUT THE CHAR IN THE USER SPACE
+ JMP COLMV1 /GET THE NEXT CHAR
+
+
+COLSW, 0 /FILE NAME OR EXTENSION SWITCH
+COLNP1, 0 /POINTER TO BEGINNING OF NAME
+COLNP2, 0 /POINTER TO BEGINNING OF NAME PART
+COLCH1, 0 /TEMP LOC FOR COLMOV
+COLCH2, 0 /DITTO
+COLCT1, 0 /DITTO
+
+PAGE
+\fXMOV6, 0
+ TAD I XMOV6 /GET "FROM" ADDRESS
+ ISZ XMOV6
+ DCA MOV61
+ TAD I XMOV6 /GET "TO" ADDRESS
+ ISZ XMOV6
+ DCA MOV62
+ TAD (-6
+ DCA MOV63
+MOV64, TAD I MOV61
+ DCA I MOV62
+ ISZ MOV61
+ ISZ MOV62
+ ISZ MOV63
+ JMP MOV64
+ JMP I XMOV6 /RETURN
+MOV61, 0
+MOV62, 0
+MOV63, 0
+
+
+XBCLIN, 0
+ DCA PUTPNT /START AT BEGINNING OF BCL BUFFER
+ JMS I (SENDKY /SEND THE KEYWORD
+ DCA MOV61 /CLEAR THE BLANK COUNTER
+BCLIN5, JMS BCLIN3 /GET NEXT CARD AND PUT IT INTO BCL BUFFER
+ JMP BCLIN7+2 /CARD NOT CONTINUED - DONE
+ CIF F0
+ JMS I (CDRIN /READ ANOTHER CARD
+ JMP BCLIN7+2 /EOF
+ TAD (-10
+ DCA BCLIN4
+BCLIN6, JMS I (GETCDR /GET FIRST 8 CHARS
+ SZA CLA /TEST FOR ZERO
+ JMP BCLIN7 /NON-ZERO - ERROR
+ ISZ BCLIN4
+ JMP BCLIN6
+ JMP BCLIN5 /OK - PUT IT IN BUFFER
+
+BCLIN7, CDF F0
+ DCA I (CDRFLG /SET CDRIN TO RETURN THIS CARD AGAIN
+ CDF F1
+ TAD (215 /PUT A <CR>
+ PUTCHR;BCLBUF
+ TAD (215;OUT1
+ DCA GETPNT /SET POINTER TO BEGINNING
+ JMP I XBCLIN /RETURN
+
+BCLIN4, 0
+BCLIN3, 0
+ TAD (-40
+ DCA BCLIN4
+BCLIN9, JMS I (GETCDR /GET NEXT CDR CHAR
+ SNA
+ JMP BCLI13 /BLANK
+ TAD (-CONTCH
+ SNA
+ JMP BCLI10 /CONTINUATION
+ TAD (CONTCH
+ CIF F0
+ JMS I (XCONVR
+ JMP BCLIN8 /RUBOUT
+ DCA XMOV6 /SAVE THE CHAR
+ JMS BCLI14 /SEND THE BLANKS
+ TAD XMOV6
+ OUT1 /SEND IT
+ TAD XMOV6
+ PUTCHR;BCLBUF /PUT IT
+ TAD PUTPNT
+ TAD (-BCLSIZ^2+2 /BCL BUFFER FULL?
+ SMA CLA
+ JMP BCLI11 /FULL - ERROR
+BCLIN8, ISZ BCLIN4 /COUNT COLUMNS
+ JMP BCLIN9 /LOOP
+ JMP I BCLIN3
+BCLI10, ISZ BCLIN3 /SKIP RETURN FOR CONTINUATION
+ DCA MOV61 /CLEAR THE BLANK COUNTER
+ SEND;BCL10E /"_$"
+ TAD (211;OUT1 /<TAB>
+ JMP I BCLIN3 /RETURN
+
+BCLI11, SEND;BCL11E /SEND ERROR
+BCLI12, CIF F0
+ JMS I (CDRIN /GET THE NEXT CARD
+ JMP BCLIN7+2
+ JMS I (GETCDR /GET THE NEXT COLUMN
+ DCA BCLIN4 /SAVE THIS COLUMN
+ TAD (JOBBIT /IS THIS A $JOB CARD?
+ AND BCLIN4
+ SNA CLA
+ JMP BCLI12 /NO - FLUSH TO $JOB
+ TAD (-JOBBIT-1
+ AND BCLIN4
+ SZA CLA
+ JMP BCLI12
+ JMP BCLIN7 /YES - DONE
+
+BCLI13, ISZ MOV61 /ANOTHER BLANK
+ JMP BCLIN8
+
+BCLI14, 0
+ TAD MOV61
+ CMA
+ DCA MOV61
+BCLI15, ISZ MOV61;SKP
+ JMP I BCLI14
+ TAD (" ;OUT1
+ JMP BCLI15
+
+
+
+
+PAGE
+\fBCLTRA, JMP I .+1 /GO FINISH UP LAST BCL COMMAND
+ BCLHUH /HUH? - I.E. WHICH COMMAND WAS IT?
+ CIF CDF F0
+ JMP I (TEXFIN /TO COPY A DECK UNTIL THE NEXT BCL
+ /COMMAND - JMS BCLTRA+1
+
+BCLHU1, 0 /JMS HERE WITH ARG = TRANSFER ADDRESS
+ TAD I BCLHU1 /GET TRANSFER ADDRESS
+ DCA BCLHU1
+ TAD (BCLHUH /ON NEXT BCL CARD - NOTHING TO FINISH
+ DCA BCLTRA+1
+ CIF CDF F0 /FIELD 0!
+ JMP I BCLHU1 /GO GO GO
+
+
+BCLHUH, CDF F0
+ TAD I (KEYVAL /GET KEYWORD VALUE
+ CDF F1
+ TAD (BCLGO /USE IT TO GET TRANSFER ADDRESS
+ DCA OTEMP1
+ TAD I OTEMP1
+ DCA OTEMP1
+ CDF F0
+ TAD I (CONFLG /WAS LAST CARD CONTINUED?
+ CDF F1
+ SZA CLA
+ JMS BCLHU2 /YES - ERROR
+ CDF F0
+ TAD I (LNCNT /DID THIS CARD HAVE A LINE NUMBER?
+ CDF F1
+ SNA CLA
+ JMP I OTEMP1 /YES - GO TO IT!
+ CIF CDF F0
+ JMS I (LNOUT /OUTPUT THE LINE NUMBER
+ JMS BCLHU2 /WHAT'S IT DOING WITH A NUMBER ANYWAY?
+ JMP I OTEMP1 /NOW WE GO.
+
+BCLHU2, 0
+ CDF F0
+ ISZ I (ERRFLG
+ CDF F1
+ SEND;BCLHM1 /"?_"
+ JMP I BCLHU2
+
+
+BCLEOF, JMS BCLHU1;EOF2
+
+
+CERR, JMS BCLHU1;KEYBAD
+
+
+\fXOUTNA, 0
+ TAD I XOUTNA /GET ADDRESS OF NAME
+ ISZ XOUTNA
+ DCA OUTNA2
+ TAD GETPNT /SAVE BUFFER INPUT POINTER
+ DCA OUTNA6
+ DCA OUTNA3 /SET FLAG FOR NO NAME
+ JMS OUTNA4;0;-4 /SEND 4 CHARS FROM POSITION 0
+ TAD OUTNA3
+ SNA CLA
+ JMP .+3 /NO DEVICE - NO ":"
+ TAD (":
+ OUT1
+ JMS OUTNA4;4;-6 /SEND 6 CHARS FROM POSITION 4
+ TAD (12 /SET UP TO GET EXTENSION
+ DCA GETPNT
+ JMS OUTNA1 /GET FIRST CHAR
+ JMP OUTNA5 /NO EXTENSION
+ CLA
+ TAD (".
+ OUT1
+ JMS OUTNA4;12;-2 /SEND 2 CHARS FROM POSITION 12
+OUTNA5, TAD OUTNA6 /RESTORE BUFFER INPUT POINTER
+ DCA GETPNT
+ JMP I XOUTNA
+
+OUTNA1, 0
+ GETCHR
+OUTNA2, 0
+ TAD (-300 /IS IT NULL?
+ SNA
+ JMP I OUTNA1 /YES - DONE
+ ISZ OUTNA1 /SKIP RETURN
+ TAD (300
+ JMP I OUTNA1
+OUTNA3, 0 /NAME PRESENT SWITCH
+
+OUTNA4, 0
+ TAD I OUTNA4 /GET CHAR POSITION
+ ISZ OUTNA4
+ DCA GETPNT
+ TAD I OUTNA4 /GET NO OF CHARS
+ ISZ OUTNA4
+ DCA OUTN41
+OUTN42, JMS OUTNA1 /GET A CHAR
+ JMP I OUTNA4 /NULL - DONE
+ OUT1
+ ISZ OUTNA3 /SET NAME PRESENT
+ ISZ OUTN41
+ JMP OUTN42
+ JMP I OUTNA4 /DONE - RETURN
+OUTN41, 0
+OUTNA6, 0
+
+
+PAGE
+\fXSEND, 0
+ SZA /IF AC =0, ADDRESS IS ARG OF CALL
+ JMP XSEND4
+ TAD I XSEND /GET MESSAGE ADDRESS
+ ISZ XSEND
+XSEND4, DCA OTEMP1
+XSEND1, TAD I OTEMP1
+ CLL RTR;RTR;RTR
+ JMS XSEND2
+ TAD I OTEMP1
+ JMS XSEND2
+ ISZ OTEMP1
+ JMP XSEND1
+
+XSEND2, 0
+ AND (77
+ SNA
+ JMP I XSEND /NULL ENDS MESSAGE
+ JMS I (XSEND3 /GET 8-BIT REPRESENTATION
+ OUT1
+ JMP I XSEND2
+
+
+MAKNAM, 0
+ TAD (DECN /START CONVERSION AT 100
+ CDF F0
+ DCA I (XR1
+ L7775 /CONVERT 3 DIGITS
+ DCA I (TEMP1
+ ISZ NAMCNT /BUMP NAME COUNTER
+ TAD NAMCNT
+ DCA I (TEMP4
+ L0001
+ DCA I (TEMP5 /SAVE LEADING ZEROES
+ TAD (MAKNA2
+ DCA I (OUTAD
+ CDF F1
+ TAD I MAKNAM /MOVE DEFAULT NAME TO OUTPUT AREA
+ DCA .+3
+ MOV6;FILNAM;0
+ TAD I MAKNAM
+ ISZ MAKNAM
+ DCA MAKNA3+2
+ TAD (7 /PUT NUMBER AT POSITION 7-9
+ DCA PUTPNT
+ CIF F0
+ JMS I (CONDEC /OUTPUT NUMBER
+ TAD (XOUT /RESTORE OUTPUT ROUTINE
+ CDF F0
+ DCA I (OUTAD
+ CDF F1
+ JMP I MAKNAM /RETURN
+
+MAKNA3, 0
+ PUTCHR;0
+ CIF CDF F0
+ JMP I MAKNA3
+NAMCNT, 0
+
+
+XISNUM, 0
+ TAD (-"9
+ SMA SZA
+ JMP XISNU1
+ TAD ("9-"0
+ SMA
+ ISZ XISNUM
+XISNU1, CLA
+ JMP I XISNUM
+
+
+SAVNAM, 0
+ TAD SAVPNT
+ DCA SAV1+2 /PUT NAME IN LIST
+ TAD SAVPNT
+ TAD (-SAVTOP /ARE WE AT TOP OF LIST?
+ SNA
+ JMP I SAVNAM /YES - DON'T SAVE NAME
+ TAD (SAVTOP+6
+ DCA SAVPNT /ADVANCE POINTER FOR NEXT TIME
+ TAD I SAVNAM /GET NAME TO SAVE
+ DCA SAV1+1
+ ISZ SAVNAM
+SAV1, MOV6;0;0
+ JMP I SAVNAM
+
+SAVPNT, SAVARA /POINT TO SAVE AREA
+
+
+UNSNAM, 0
+ TAD I UNSNAM
+ ISZ UNSNAM
+ DCA UNSNA1+2 /POINT TO SPACE TO RECEIVE NAME
+ TAD SAVPNT
+ TAD (-6-SAVARA
+ SPA
+ JMP UNSNA2 /EMPTY - RETURN
+ TAD (SAVARA
+ DCA SAVPNT /BACK UP
+ TAD SAVPNT
+ DCA UNSNA1+1 /SET ADDRESS FROM WHICH NAME WILL COME
+UNSNA1, MOV6;0;0
+ ISZ UNSNAM /SKIP RETURN UNLESS EMPTY
+UNSNA2, CLA
+ JMP I UNSNAM
+
+
+PAGE
+\f/
+/
+/ $DECK
+/
+/
+CDECK, BCLIN /GET THE LINE
+ OPTION;CDEOPT /ANALYZE THE OPTIONS
+ TSTCR /END OF LINE?
+ JMP CDECK1 /NO - GET A NAME
+CDECK3, MOV6;CDEDEF;NAME1 /YES - MOVE DEFAULT NAME
+ JMP CDECK2
+CDECK1, COLNAM;NAME1 /COLLECT A NAME
+ JMP CDECK3 /FAIL - BAD NAME
+CDECK2, SEND;CDEM1 /".R PIP_*"
+ OUTNAM;NAME1 /SEND THE NAME
+ SEND;CDEM2 /"<BAT:_"
+ TAD I (OPFOR /WAS "/FOR" SPECIFIED?
+ SMA CLA
+ TAD (BASKEY-FORKEY /NO - USE BASIC
+ TAD (FORKEY-15
+ CDF F0
+ DCA I (KEYADR
+ CDF F1
+ CDRTRA /TRANSLATE THE CARDS
+ SEND;CMEOD /"$EOD_"
+ TAD I (OPNOL /WAS "/NOLIST" SPECIFIED?
+ SPA CLA
+ JMP I (BCLHUH /YES - DONE
+ TAD ("*;OUT1
+ JMS I (PIPOUT;BATOUT /SEND NAME OF LISTING DEVICE
+ TAD ("<;OUT1
+ OUTNAM;NAME1 /SEND NAME OF FILE
+ TAD (215;OUT1
+ JMP I (BCLHUH
+
+
+\f/
+/
+/ $BASIC
+/
+/
+CBAS, BCLIN /GET BCL LINE
+ OPTION;CBAOPT /ANALYZE OPTIONS
+ TSTCR /END OF LINE?
+ JMP CBAS2 /NO - GET NAME
+CBAS1, MOV6;CBATK;NAME1 /MOVE IN BAT:
+ SEND;CBAM1 /.R PIP *PROG.BA<
+ OUTNAM;NAME1 /SEND NAME
+ JMP CONT
+CBAS2, COLNAM;NAME1 /COLLECT THE NAME
+ JMP CBAS1 /FAIL - USE DEFAULT
+CBAS3, SEND;CBAM1 /".R PIP_*PROG.BA<"
+ SEND;CBAM6
+CONT, TAD (215;OUT1
+CBAS5, JMP CBAS7 /SET OR CLOBBERED IN INIT
+ TAD (211;OUT1
+ SEND;CBAM3 /'FILE #0,"DATA.DA"\FILEV #1,"'
+ OUTNAM;BATOUT /"TTY:" OR "LPT:"
+ SEND;CBAM4 /'"_'
+CBAS7, TAD (BASKEY-15
+ CDF F0
+ DCA I (KEYADR /SET KEYWORD LIST
+ CDF F1
+ CDRTRA /TRANSLATE CARDS
+ SEND;CMEOD /"$EOD_"
+ SEND;CBAM7
+ SEND;CBAM5
+ OUTNAM;NAME1
+ SEND;CBAM8
+ TAD I (OPNOL /WAS "/NOLIST SPECIFIED?"
+ SPA CLA
+ JMP CBAS4
+ SEND /SEND AN EOD (MH)
+ CMEOD /(MH)
+ SEND /SEND AN .R PIP * (MH)
+ CDEM1 /(MH)
+ JMS I (PIPOUT;BATOUT
+ SEND;CBAM2 /"<PROG.BA_"
+CBAS4, TAD (DATBAS
+ DCA I (DATADR /SET "$DATA" ROUTINE
+ JMP I (BCLHUH /DONE
+
+
+/
+/
+/ $RUN (AFTER $BASIC)
+/
+/
+DATBAS, BCLIN
+ OPTION;ZER6 /NO OPTIONS
+ SEND;DATBM1 /".R PIP_*DATA.DA<BAT:_"
+ CDRTRA /TRANSLATE THE CARDS
+ SEND;DATBM2 /"$EOD_.R BCOMP_*PROG.BA_"
+ TAD DATFTN /$RUN IS FORTRAN NOW
+ DCA I (DATADR
+ JMP I (BCLHUH /DONE
+
+
+PAGE
+\f/
+/
+/ $FORTRAN (FORTRAN IV)
+/
+/
+CF4, BCLIN /GET BCL LINE
+ OPTION;CF4OPT /ANALYZE OPTIONS
+ TSTCR /END OF LINE?
+ JMP CF42
+CF41, JMS I (MAKNAM;NAME1 /YES - MAKE A NAME
+ JMP CF43
+CF42, COLNAM;NAME1 /NO - COLLECT A NAME
+ JMP CF41 /BAD NAME - MAKE ONE
+CF43, SEND;CF4M1 /".R PIP_*"
+ OUTNAM;NAME1 /SEND THE NAME
+ TAD ("<;OUT1
+ TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN
+ SMA CLA
+ JMP CF44 /NO
+ OUTNAM;OPSRC+1 /YES - SEND IT
+ TAD (215;OUT1
+ JMP CF45
+CF44, SEND;CF4M2 /"BAT:_"
+CF45, TAD (FORKEY-15 /FORTRAN CARDS
+ CDF F0
+ DCA I (KEYADR
+ CDF F1
+ CDRTRA /TRANSLATE THE CARDS
+ SEND;CF4M3 /"$EOD_.R F4_*"
+ OUTNAM;NAME1
+ TAD I (OPNOL /WAS "/NOLIST" SPECIFIED?
+ SPA CLA
+ JMP CF46 /YES - DON'T GENERATE LIST FILES
+ TAD (",;OUT1
+ TAD I (OPLIS
+ RAL
+ SPA CLA /WAS A NAME GIVEN?
+ JMP CF47 /YES - GET IT
+ MOV6;BATOUT;OPLIS+1 /NO - GIVE LIST DEV
+CF47, OUTNAM;OPLIS+1 /SEND NAME OF LISTING FILE
+CF46, TAD ("<;OUT1
+ OUTNAM;NAME1
+ TAD I (OPRALF /PRODUCE RALF LISTING?
+ SMA CLA
+ JMP CF48 /NO
+ SEND;CF4M4 /"/F"
+CF48, TAD (215;OUT1
+ TAD (DATF4
+ DCA I (DATADR /SET "$DATA" ADDRESS
+ JMS I (SAVNAM;NAME1 /SAVE NAME FOR "$LOAD"
+ JMP I (BCLHUH /DONE
+
+
+/
+/
+/ $RUN (FORTRAN II)
+/
+/
+DATF2, BCLIN
+ JMS I (CL2S /DO $LOAD STUFF
+ JMP DATL21
+DATL2, BCLIN
+ OPTION;ZER6 /NO OPTIONS IF ALREADY LOADED
+ JMP DATL21
+DATX2, BCLIN
+ JMS I (DATNAM /GET A NAME
+ TAD I (NAMELD /WAS A DEVICE SPECIFIED?
+ SZA CLA
+ JMP DATL21 /YES
+ TAD (0423 /NO - USE "DSK"
+ DCA I (NAMELD
+ TAD (1300
+ DCA I (NAMELD+1
+DATL21, SEND;DTF2M1 /".RUN "
+ OUTNAM;NAMELD
+ TAD (215;OUT1
+ CDRTRA /WITH GENIOX, INPUT IS FROM BATCH STREAM
+ SEND;CMEOD /"$EOD_"
+ TAD DATFTN /$DATA IS NOW FORTRAN
+ DCA I (DATADR
+ JMP I (BCLHUH
+
+
+
+PAGE
+\f/
+/
+/ $LOAD (FORTRAN IV)
+/
+/
+/THIS SUBROUTINE IS USED WITH EITHER A $LOAD OR $RUN
+CL4S, 0
+ OPTION;CL4OPT /ANALYZE OPTIONS
+ SEND;CL4SM1 /".R LOAD_*"
+ TAD I (OPIMAG /WAS "/IMAGE" FILE SPECIFIED
+ RAL
+ SMA CLA
+ JMP CL4S1 /NO
+ MOV6;OPIMAG+1;NAMELD /YES - MOVE NAME
+ JMP CL4S2
+CL4S1, MOV6;CL4DEF;NAMELD /USE DEFAULT NAME
+CL4S2, OUTNAM;NAMELD /SEND THE NAME OF THE IMAGE FILE
+ TAD I (OPLIS /WAS "/LIST" FILE GIVEN?
+ SMA CLA
+ JMP CL4S4
+ TAD I (OPLIS;RAL
+ SPA CLA
+ JMP CL4S3
+ MOV6;BATOUT;OPLIS+1
+CL4S3, TAD (",;OUT1
+ OUTNAM;OPLIS+1
+CL4S4, TAD I (OPSSYM /LIST SYSTEM SYMBOLS?
+ SMA CLA
+ JMP CL4S11 /NO
+ SEND;CL4SM8 /"/S"
+CL4S11, SEND;CL4SM2 /"<_*"
+ TAD I (OPLIB;RAL /WAS "/LIBRARY" FILE SPECIFIED?
+ SMA CLA
+ JMP CL4S5
+ OUTNAM;OPLIB+1 /SEND NAME OF LIBRARY
+ SEND;CL4SM3 /"/L_*"
+CL4S5, TAD I (OPNOA /WAS "/NOAUTO" SPECIFIED?
+ SPA CLA
+ JMP CL4S7 /YES - DON'T BOTHER WITH SAVED NAMES
+CL4S6, JMS I (UNSNAM;NAME1 /GET A SAVED NAME
+ JMP CL4S7 /OUT OF NAMES
+ OUTNAM;NAME1 /SEND IT
+ SEND;CL4SM4 /"/C_*"
+ JMP CL4S6
+CL4S7, TSTCR;SKP /END OF LINE?
+ JMP CL4S10
+ GETCHR;BCLBUF /GET NEXT CHARACTER
+ DCA CHRSAV
+ GETCHR;BCLBUF
+ TAD (-"=
+ SZA CLA
+ JMP CL4S8
+ TAD CHRSAV
+ ISIT;CLIS1;CLIS2-1 /IS IT "L" OR "O"
+CL4S8, L7776
+ TAD GETPNT /BACK UP 2
+ DCA GETPNT
+CL4S9, COLNAM;NAME1
+ JMP CL4S7 /BAD NAME
+ OUTNAM;NAME1 /SEND THE NAME
+ SEND;CL4SM4 /"/C_*"
+ JMP CL4S7
+CL4SL, SEND;CL4SM5 /"/O"
+CL4SO, SEND;CL4SM6 /"_*"
+ L7776
+ TAD GETPNT /BACK 2
+ JMS I (BCLSQU
+ JMP CL4S9
+CL4S10, SEND;CL4SM7 /"$_"
+ DCA I (NAMCNT
+ JMP I CL4S /RETURN
+
+
+/$LOAD
+CL4, BCLIN /GET THE LINE
+ JMS CL4S /ANALYZE IT
+ TAD (DATL4 /SET "$DATA" ADDRESS
+ DCA I (DATADR
+ JMS I (BCLHU1;TEXFIN
+
+CHRSAV, 0
+
+PAGE
+\f/
+/
+/ $RUN (FORTRAN IV) - FORMERLY CALLED $DATA
+/
+/
+/THIS SUBROUTINE IS CALLED FROM DATF4 - THE REAL $RUN PROCESSOR
+DAT4, 0
+ TAD (-12^7 /ZERO OUT CONTROL WORD
+ DCA DEVASC /FOR EACH DEVICE NUMBER
+ TAD (DEVASN-1
+ DCA OXR1
+DEVAS1, DCA I OXR1
+ ISZ DEVASC
+ JMP DEVAS1
+ BCLIN /GET THE INPUT LINE
+DAT41, GETCHR;BCLBUF /GET A CHAR
+DAT411, ISIT;OPTIS3;DATIS1-1 /IS IT "/" OR <CR>?
+ JMP DAT41 /NO
+DAT42, L7777
+ TAD GETPNT /SAVE POINTER TO "/"
+ DCA DEVAST
+ GETCHR;BCLBUF
+ ISNUM
+ JMP DAT411 /IT'S NOT A NUMBER
+ TAD CHAR
+ TAD (-"0
+ CIA
+ DCA DEVASC
+ TAD DEVASC
+ CIA
+ CLL RAL;RTL
+ TAD DEVASC /NUMBER*7
+ TAD (DEVASN
+ DCA DEVASC
+DAT47, GETCHR;BCLBUF /GET ANOTHER CHAR
+ ISIT;DATIS2;DATIS3-1 /IS IT "N","C", OR "="?
+ JMP DAT411 /NO
+DAT44, TAD I DEVASC /"N" SETS BIT 1
+ AND (5777
+ TAD (2000
+ DCA I DEVASC
+ JMP DAT47
+DAT45, TAD I DEVASC /"C" SETS BIT 2
+ AND (6777
+ TAD (1000
+ DCA I DEVASC
+ JMP DAT47
+DAT46, TAD GETPNT /SAVE POINTER TO POSSIBLE NAME
+ DCA DEVASP
+ GETCHR;BCLBUF /GET THE NEXT CHAR
+ ISNUM
+ JMP DAT48 /NOT A NUMBER
+ TAD CHAR /SAVE THE NUMBER
+ DCA DEVASS
+ GETCHR;BCLBUF
+ ISIT;DATIS4;DATIS5-1 /IS IT "," "/" OR <CR>?
+DAT48, TAD DEVASP /RESET NAME POINTER
+ DCA GETPNT
+ TAD I DEVASC /ZERO OUT NUMBER
+ AND (7400
+ DCA I DEVASC
+ TAD DEVASC;IAC /GET POINTER TO DEVICE BLOCK
+ DCA .+2
+ COLNAM;0 /COLLECT NAME
+ JMP DAT49 /BAD NAME
+DAT412, TAD I DEVASC /NAME OR NUM OK - SET BIT 0
+ AND (3777
+ TAD (4000
+ DCA I DEVASC
+DAT49, TAD DEVAST /SQUISH
+ JMS I (BCLSQU
+ JMP DAT41
+DAT410, TAD I DEVASC /ADD NUMBER TO CONTROL WORD
+ AND (7400
+ TAD DEVASS
+ DCA I DEVASC
+ JMP DAT412
+DAT43, JMP I DAT4
+
+
+DEVASP, 0
+DEVASC, 0
+DEVASS, 0
+DEVAST, 0
+
+
+/SEND A NAME AND SEND /T OPTION IF DEVICE IS TTY:
+PIPOUT, 0
+ TAD I PIPOUT /GET ADDRESS OF NAME
+ ISZ PIPOUT
+ DCA PIPPNT
+ OUTNAM /SEND IT
+PIPPNT, 0
+ TAD I PIPPNT /GET CHAR OF DEVICE
+ TAD (-2424 /IS IT "TT"?
+ SZA CLA
+ JMP I PIPOUT /NO
+ ISZ PIPPNT
+ TAD I PIPPNT
+ TAD (-3100 /IS IT "Y@"?
+ SZA CLA
+ JMP I PIPOUT /NO
+ SEND;PIPM1 /"/T"
+ JMP I PIPOUT
+
+
+PAGE
+\f/$RUN (FORTRAN IV)
+DATF4, JMS I (DAT4 /PROCESS DEVICE NUMBER STUFF
+ JMS I (CL4S /DO LOAD STUFF
+ JMP DATL46
+DATL4, JMS I (DAT4
+ OPTION;ZER6 /NO OPTIONS
+ JMP DATL46
+DATX4, JMS I (DAT4 /DO DEVICE NUMBER STUFF
+ JMS DATNAM /COLLECT A NAME
+DATL46, SEND;DTF4M1 /".R PIP_*DATA.DA<BAT:_"
+ CDRTRA /TRANSLATE CARDS
+ SEND;DTF4M2 /"$EOD_.R FRTS_*"
+ OUTNAM;NAMELD /SEND LOADER NAME
+DATL48, JMP DATL49 /ZEROED OR CREATED IN INIT
+ SEND;DTF4M6 /"_*DATA.DA/4_*"
+ OUTNAM;BATOUT
+ SEND;DTF4M7 /"/5"
+ JMP DTL410
+DATL49, SEND;DTF4M8 /"_*/5=4"
+DTL410, SEND;DTF4M3 /"_*"
+ TAD (-12 /TRANSLATE THE DEVICE NUMBERS
+ DCA DATF4C
+ TAD (DEVASN-7
+ DCA DATF4P
+DATL41, TAD (7
+ TAD DATF4P
+ DCA DATF4P
+ TAD I DATF4P
+ SMA CLA /WAS THIS ONE SPECIFIED?
+ JMP DATL47 /NO
+ TAD I DATF4P
+ AND (377 /WAS IT A NUMBER?
+ SNA
+ JMP DATL42
+ DCA CHAR /YES - SAVE IT
+ TAD ("=;OUT1
+ TAD CHAR;OUT1
+ JMP DATL43
+DATL42, TAD DATF4P;IAC /POINT TO NAME
+ DCA .+2
+ OUTNAM;0 /SEND IT
+DATL43, TAD I DATF4P /"N"?
+ RAL
+ SMA CLA
+ JMP DATL44 /NO
+ TAD ("<;OUT1
+DATL44, TAD I DATF4P /"C"?
+ RTL
+ SMA CLA
+ JMP DATL45 /NO
+ SEND;DTF4M4 /"/C"
+DATL45, TAD ("/;OUT1
+ TAD DATF4C
+ TAD ("0+12;OUT1
+ SEND;DTF4M3 /"_*"
+DATL47, ISZ DATF4C
+ JMP DATL41
+ SEND;DTF4M5 /"$_"
+ TAD DATFTN /"$DATA" IS NOW FORTRAN
+ DCA I (DATADR
+ JMP I (BCLHUH
+
+DATF4C, 0
+DATF4P, 0
+
+
+DATNAM, 0
+ OPTION;ZER6 /NO OPTIONS
+ TSTCR;SKP /IS THERE A NAME?
+ JMP DATNO /NO
+ COLNAM;NAMELD /YES - COLLECT IT
+ JMP DATNO /INVALID NAME
+ JMP I DATNAM /RETURN
+DATNO, SEND;DATNO1 /"?NO PROGRAM TO RUN_"
+ JMS I (BCLHU1;TEXFIN
+
+
+PAGE
+\f/
+/
+/ $FORTRAN (FORTRAN II)
+/
+/
+CF2, BCLIN
+ OPTION;CF2OPT /ANALYZE OPTIONS
+ TSTCR /END OF LINE?
+ JMP CF22
+CF21, JMS I (MAKNAM;NAME1 /CREATE A NAME
+ JMP CF23
+CF22, COLNAM;NAME1 /COLLECT A NAME
+ JMP CF21 /FAIL - CREATE A NAME
+CF23, SEND;CF2M1 /".R PIP_*"
+ OUTNAM;NAME1
+ TAD ("<;OUT1
+ TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN?
+ SMA CLA
+ JMP CF24 /NO
+ OUTNAM;OPSRC+1
+ TAD (215;OUT1
+ JMP CF25
+CF24, SEND;CF2M2 /"BAT:_"
+CF25, TAD (FORKEY-15 /FORTRAN CARDS
+ CDF F0
+ DCA I (KEYADR
+ CDF F1
+ CDRTRA /TRANSLATE THE CARDS
+ SEND;CF2M3 /"$EOD"
+ TAD I (OPNOL /WAS "/NOLIST" SPECIFIED?
+ SPA CLA
+ JMP CF27
+ SEND;CF2M4 /"_*"
+ TAD I (OPLIS;RAL /WAS A LISTING FILE GIVEN?
+ SPA CLA
+ JMP CF26 /YES
+ MOV6;BATOUT;OPLIS+1 /NO - USE LISTING DEVICE
+CF26, JMS I (PIPOUT;OPLIS+1
+ TAD ("<;OUT1
+ OUTNAM;NAME1
+CF27, SEND;CF2M5 /"_.R FORT_*"
+ OUTNAM;NAME1
+ TAD I (OPNOL /NOLIST?
+ SPA CLA
+ JMP CF28 /YES
+ TAD I (OPSABR /WAS "/SABR" SPECIFIED?
+ SMA CLA
+ JMP CF28 /NO
+ TAD (",;OUT1
+ OUTNAM;OPLIS+1
+CF28, TAD ("<;OUT1
+ OUTNAM;NAME1
+ TAD (215;OUT1
+ TAD (DATF2
+ DCA I (DATADR /ENABLE $DATA
+ JMS I (SAVNAM;NAME1 /SAVE THE NAME FOR $LOAD
+ JMP I (BCLHUH /DONE
+
+
+\f/
+/
+/ $EOD
+/ $MSG
+/
+/
+CEOD,
+CMSG,
+ JMS SENDKY /OUTPUT THE BCL KEYWORD
+ JMS I (BCLHU1;TEXTRA
+
+/
+/
+/ $JOB
+/
+/
+CJOB, TAD (SAVARA /RESET SAVED NAMES
+ DCA I (SAVPNT
+ DCA I (NAMCNT /ZERO MAKNAM COUNTER
+ TAD DATFTN /$RUN IS NOW FORTRAN
+ DCA I (DATADR
+ BCLIN /SEND THE LINE TO THE BATCH STREAM
+ SEND;MJOB1 /".R FOTP_*FIL???.*/D_"
+ JMS I (BCLHU1;TEXFIN
+
+SENDKY, 0
+ CDF F0
+ TAD I (KEYVAL
+ CDF F1
+ TAD (BCLKEY-1
+ DCA OTEMP1
+ TAD I OTEMP1
+ SEND
+ TAD (" ;OUT1
+ JMP I SENDKY
+
+
+PAGE
+\f/
+/
+/ $LOAD (FORTRAN II)
+/
+/
+/THIS SUBROUTINE IS CALLED BY CL2 OR DATF2
+CL2S, 0
+ OPTION;CL2OPT /ANALYZE OPTIONS
+ SEND /".R LOADER_*" OR ".R LOADER_*GENIOX"
+CL2SX, CL2M1 /OR CL2M1A
+ TAD I (OPINP /WAS "/INPUT" SPECIFIED?
+ SMA CLA
+ JMP CL2S1
+ SEND;CL2M3 /"/I"
+CL2S1, TAD I (OPOPT /WAS "/OUTPUT" SPECIFIED?
+ SMA CLA
+ JMP CL2S2
+ SEND;CL2M4 /"/O"
+CL2S2, TAD I (OPTWO /WAS "/TWO" SPECIFIED?
+ SMA CLA
+ JMP CL2S3
+ SEND;CL2M5 /"/H"
+CL2S3, SEND;CL2M6 /"_*"
+ TAD I (OPLIB;RAL /WAS A LIBRARY SPECIFIED?
+ SMA CLA
+ JMP CL2S4
+ OUTNAM;OPLIB+1
+ SEND;CL2M7 /"/L_*"
+CL2S4, TAD I (OPLIS /WAS "/LIST" SPECIFIED?
+ SMA CLA
+ JMP CL2S6
+ TAD I (OPLIS;RAL /WAS A NAME GIVEN?
+ SPA CLA
+ JMP CL2S5 /YES
+ MOV6;BATOUT;OPLIS+1
+CL2S5, OUTNAM;OPLIS+1
+ SEND;CL2M8 /"</M_*"
+CL2S6, TAD I (OPNOA /WAS "/NOAUTO" SPECIFIED?
+ SPA CLA
+ JMP CL2S8
+CL2S7, JMS I (UNSNAM;NAME1 /GET A SAVED NAME
+ JMP CL2S8 /EMPTY
+ OUTNAM;NAME1
+ SEND;CL2M6 /"_*"
+ JMP CL2S7
+CL2S8, TSTCR;SKP /END OF LINE?
+ JMP CL2S9 /YES
+ COLNAM;NAME1
+ OUTNAM;NAME1
+ SEND;CL2M6 /"_*"
+ JMP CL2S8
+CL2S9, SEND;CL2M9 /"$_.SAVE "
+ TAD I (OPIMAG;RAL /WAS AN IMAGE FILE NAME GIVEN?
+ SMA CLA
+ JMP CL2S10 /NO - USE DEFAULT
+ TAD I (OPIMAG+1 /WAS A DEVICE GIVEN?
+ SZA CLA
+ JMP CL2S11 /YES
+ TAD (0423 /"DS"
+ DCA I (OPIMAG+1
+ TAD (1300 /"K"
+ DCA I (OPIMAG+2
+CL2S11, MOV6;OPIMAG+1;NAMELD
+CL2S12, OUTNAM;NAMELD
+ TAD (215;OUT1
+ JMP I CL2S
+
+CL2S10, MOV6;CL2SN2;NAMELD
+ DCA I (NAMCNT
+ JMP CL2S12
+
+
+/$LOAD
+CL2, BCLIN
+ JMS CL2S
+ TAD (DATL2 /$DATA DOES NOT DO LOAD
+ DCA I (DATADR
+ JMS I (BCLHU1;TEXFIN
+
+
+PAGE
+\fBCLBUF, ZBLOCK 400 /SPACE FOR A WHOLE BUNCH OF CONTINUATION CARDS
+BCLSIZ=.-BCLBUF
+SAVARA, ZBLOCK 6^62 /SPACE FOR SAVED NAMES
+SAVTOP=.
+/OPTION LISTS
+CDEOPT, OPBAS;OPFOR;OPNOL;0 /$DECK
+CBAOPT, OPNOL;0 /$BASIC
+CF4OPT, OPSRC;OPNOL;OPLIS;OPRALF;0 /$FORTRAN (F4)
+CL4OPT, OPIMAG;OPLIS;OPLIB;OPNOA;OPSSYM;0 /$LOAD (F4)
+CF2OPT, OPSRC;OPNOL;OPLIS;OPSABR;0 /$FORTRAN (F2)
+CL2OPT, OPINP;OPOPT;OPTWO;OPIMAG;OPLIS;OPLIB;OPNOA;0 /$LOAD (F2)
+/OPTIONS WITHOUT ASSOCIATED FILE NAME
+OPBAS, 0004;TEXT "BASIC" /B
+OPFOR, 0006;TEXT "FORTRAN" /F
+OPNOL, 0023;TEXT "NOLIST";*.-1 /NOL
+OPRALF, 0003;TEXT "RALF";*.-1 /R
+OPNOA, 0023;TEXT "NOAUTO";*.-1 /NOA
+OPSSYM, 0013;TEXT "SSYMB" /SS
+OPSABR, 0012;TEXT "SABR";*.-1 /SA
+OPINP, 0013;TEXT "INPUT" /IN
+OPOPT, 0023;TEXT "OUTPUT";*.-1 /OUT
+OPTWO, 0020;TEXT "TWO" /TWO
+/OPTIONS WITH ASSOCIATED FILE NAME
+OPSRC, 1002;ZBLOCK 6;TEXT "SRC" /S
+OPLIS, 1003;ZBLOCK 6;TEXT "LIST";*.-1 /L
+OPIMAG, 1013;ZBLOCK 6;TEXT "IMAGE" /IM
+OPLIB, 1024;ZBLOCK 6;TEXT "LIBRARY" /LIB
+/FILE NAMES
+NAME1, ZBLOCK 6
+NAMELD, ZBLOCK 6
+BATOUT, ZBLOCK 6
+ZER6, ZBLOCK 6
+BATTTY, TEXT "TTY@@@@@@@@@";*.-1
+BATLPT, TEXT "LPT@@@@@@@@@";*.-1
+CDEDEF, TEXT "@@@@DECK@@@@";*.-1
+CBATK, TEXT "BAT@@@@@@@@@";*.-1
+CL4DEF, TEXT "@@@@PROG@@LD";*.-1
+FILNAM, TEXT "@@@@FIL@@@@@";*.-1
+CL2SN2, TEXT "DSK@PROG@@@@";*.-1
+/SPACE FOR DEVICE ASSIGNMENTS UNDER FORTRAN 4
+DEVASN, ZBLOCK 7^12
+/LISTS FOR ISIT
+CLIS1, -"L;-"O;0
+CLIS2, CL4SL;CL4SO
+DATIS1, DAT42 /"/"
+ DAT43 /<CR>
+DATIS2, -"N;-"C;-"=;0
+DATIS3, DAT44;DAT45;DAT46
+DATIS5, DAT410;DAT410;DAT410
+OPTIS2, OPTIO8 /"="
+ OPTIO9 /","
+ OPTIO9 /"/"
+ OPTIO9 /<CR>
+
+OPTIS4, OPTI3A
+ OPTRET
+
+OPTIS1, -"=
+DATIS4,
+OUTIS1, -",
+OPTIS3,
+BCLIS1, -"/;-215
+/LIST MUST BE TERMINATED BY A POSITIVE WORD
+ 0
+
+COLIS2, COLDEV /":"
+ COLFIL /"."
+ COLEXT /"/"
+ COLEXT /","
+ COLEXT /<CR>
+
+
+COLIS1, -":;-".;-"/;-",;-215
+/TERMINATE LIST WITH POSITIVE WORD
+ 0
+
+BCLIS2, BCLSQ2 /"/"
+ BCLSQ3 /<CR>
+
+OUTIS2, OUTER2 /","
+ OUTER2 /"/"
+ OUTER2 /<CR>
+
+/LIST OF BCL ROUTINE ADDRESSES
+BCLGO, BCLEOF /FOR FINISHING UP BEFORE CLOSING FILE
+ CBAS /$BAS
+FORADR, CF4 /$FOR
+DATADR, DATX4 /$DATA
+LOAADR, CL4 /$LOAD
+ CJOB /$JOB
+ CMSG /$MSG
+ CDECK /$DECK
+ CEOD /$EOD
+ CERR
+ CERR
+ CERR
+ CERR
+/LIST OF BCL KEYWORDS
+BCLKEY, MBAS
+ MFOR
+ MDATA
+ MLOAD
+ MJOB
+ MMSG
+ MDECK
+ MEOD
+/ERROR MESSAGES
+OPTERM, TEXT "?INVALID OPTION: /"
+COLERM, TEXT "?INVALID FILE SPECIFICATION - "
+BCL11E, TEXT "?_BCL LINE TOO LONG_"
+/MESSAGES
+BCLHM1, TEXT "?_"
+BCL10E, TEXT "_$"
+CF4M1,
+CF2M1,
+CDEM1, TEXT ".R PIP_*"
+CDEM2, TEXT "<BAT:_"
+CMEOD, TEXT "$EOD_"
+CBAM1, TEXT ".R PIP"
+ *.-1
+CBAM7, TEXT "_*PROG.BA<"
+CBAM2, TEXT "<PROG.BA"
+ *.-1
+CBAM8, TEXT "_"
+CBAM3, TEXT 'FILE #3:"DATA.DA"\FILEV #4:"'
+CBAM4, TEXT '"_'
+CBAM5, TEXT "PROG.BA,"
+CBAM6, TEXT "BAT:,"
+PIPM1, TEXT "/T"
+DTF4M1,
+DATBM1, TEXT ".R PIP_*DATA.DA<BAT:_"
+DATBM2, TEXT "$EOD_.R BCOMP_*PROG.BA_"
+CF2M2,
+CF4M2, TEXT "BAT:_"
+CF4M3, TEXT "$EOD_.R F4_*"
+CF4M4, TEXT "/F"
+CL4SM1, TEXT ".R LOAD_*"
+CL4SM2, TEXT "<_*"
+CL2M7,
+CL4SM3, TEXT "/L_*"
+CL4SM4, TEXT "/C_*"
+CL4SM5, TEXT "/O"
+DTF4M3,
+CF2M4,
+CL2M6,
+CL4SM6, TEXT "_*"
+DTF4M5,
+CL4SM7, TEXT "$_"
+CL4SM8, TEXT "/S"
+DTF4M2, TEXT "$EOD_.R FRTS_*"
+DTF4M4, TEXT "/C"
+DTF4M6, TEXT "_*DATA.DA/4_*"
+DTF4M7, TEXT "/5"
+DTF4M8, TEXT "_*/5=4"
+DATNO1, TEXT "?NO PROGRAM TO RUN_"
+CF2M3, TEXT "$EOD"
+CF2M5, TEXT "_.R FORT_*"
+CL2M1, TEXT ".R LOADER_*"
+CL2M1A, TEXT ".R LOADER_*GENIOX"
+CL2M3, TEXT "/I"
+CL2M4, TEXT "/O"
+CL2M5, TEXT "/H"
+CL2M8, TEXT "</M_*"
+CL2M9, TEXT "$_.SAVE "
+DTF2M1, TEXT ".RUN "
+MBAS, TEXT "$BASIC"
+MFOR, TEXT "$FORTRAN"
+MJOB1, TEXT ".R FOTP_*FIL???.*/D_"
+MEOD, TEXT "$EOD"
+MJOB, TEXT "$JOB"
+MMSG, TEXT "$MSG"
+MDECK, TEXT "$DECK"
+MLOAD, TEXT "$LOAD"
+MDATA, TEXT "$RUN"
+\f$
projects / pdp8.git / blobdiff