File: PIP10.PA of Tape: OS8/OS8-V3D/al-4697c-sa-os8-v3d-7
(Source file text)
/2 OS8 PIP10 - PDP-10 CONVERSION PROGRAM V3A
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
DTRB=6772
DTLB=6774
DTXA=6764
DTCA=6762
DTRA=6761
DTSF=6771
/WRITTEN BY MARK BRAMHALL 1970
/MODIFIED FOR TD8E BY R. LARY 1973
/DATE 75 PATCH ADDED BY S.R. AFTER 1/5/75
/
/PIP10 IS A PIP FOR OS8 THAT HANDLES PDP-10 DECTAPES
/
/COMMAND DECODER RULES:
/
/*OUTPUT_INPUT,INPUT,...
/
/OUTPUT IS:
/ DEV:FILE.EXT[NN]
/ DEFAULT DEVICE IS DSK:
/ [NN] IGNORED IF PDP-10 OUTPUT
/ IF /L OR /F DEFAULT OUTPUT IS TTY:
/
/INPUT IS:
/ DEV:FILE.EXT
/ DEFAULT DEVICE IS DSK:
/ FOLLOWING DEFAULT DEVICES ARE THE PRECEEDING DEVICE
/ UP TO NINE (9) INPUT FILES
/
/OPTIONS ARE:
/ /L IS LIST DIRECTORY (ONLY VALID IF PDP-10 INPUT)
/ /F IS SHORT FORM DIRECTORY (ONLY PDP-10 INPUT)
/ /Z IS ZERO DIRECTORY BEFORE TRANSFER (ONLY IF PDP-10 OUTPUT)
/ /D IS DELETE OLD OUTPUT FILE BEFORE TRANSFER
/ /B IS BINARY MODE TRANSFER (I.E. 8 BITS PER 36 BITS)
/ /I IS IMAGE MODE TRANSFER (I.E. 3 12 BITS PER 36 BITS)
/ /P IS PRESERVE LINE NUMBERS (DEFAULT IS TO DELETE THEM)
/ MAINTENACE RELEASE FIXES:
/1. DATE 75 STUFF
/2. TD8E RELIABILITY IMPROVEMENTS
/3. ANSI DATE OUTPUT FORMAT
/4. INCORPORATED PATCH BY DAVID HEMBLEN [UNITED AIRCRAFT
/ RESEARCH LABORATORIES] TO ALLOW WRITING PDP-6
/ DECTAPES ON A TD8E.
/COMMAND DECODER SETS UP:
/
/AT "MOUTPU" THE LIST--
/ LLL LLL LLD DDD OR UUU 100 000 000
/ NAME (TRIMMED) NAME (EXCESS 40)
/ NAME NAME
/ NAME NAME
/ EXTENSION EXTENSION
/ 0 EXTENSION
/
/ OS8 FILE OR PDP-10 FILE
/
/WHERE L IS LENGTH (8 BITS), D IS DEVICE (4 BITS), U IS UNIT (3 BITS)
/
/AT "MINPUT" THE LIST--
/ LLL LLL LLD DDD OR UUU 100 000 000
/ START BLOCK ANY BLOCK
/
/ OS8 FILE OR PDP-10 FILE
/
/THE LIST ENDS WITH A ZERO (0) WORD
/
/AT "MPARAM" THE BLOCK--
/ ABC DEF GHI JKL
/ MNO PQR STU VWX
/ YZ0 123 456 789
/
/WHICH ARE THE OPTION CHARACTERS
/
/THE = CONSTRUCTION IS NOT IMPLEMENTED
/DEFINITIONS
VERSION= 3 /VERSION NUMBER
SUBVER= 01 /PATCH LEVEL
/LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
DIRECT=7000 /PDP-10 DIRECTORY BUFFER (FIELD 1)
IBUF10=3000 /PDP-10 INPUT BUFFER (FIELD 1)
INBUF=3000 /OS8 INPUT BUFFER (FIELD 1)
OBUF10=5000 /PDP-10 OUTPUT BUFFER (FIELD 1)
OUBUF=5000 /OS8 OUTPUT BUFFER (FIELD 1)
OUDEVH=7200 /OUTPUT DEVICE (FIELD 0)
INDEVH=6600 /INPUT DEVICE (FIELD 0)
INCTL=1010 /INPUT CONTROL
OUCTL=5010 /OUTPUT CONTROL
INRECS=4 /INPUT RECORDS
MDATE=7666 /MONITOR'S DATE (FIELD 1)
MINPUT=7617 /INPUT LIST (FIELD 1)
MOUTPU=7600 /OUTPUT LIST (FIELD 1)
MPARAM=7643 /PARAMETER LIST (FIELD 1)
JSBITS=7746 /0S8 JOB STATUS BITS
DCB=7760 /DEVICE CONTROL BLOCK (FIELD 1)
PTP=20 /DCB VALUE OF THE PAPER TAPE PUNCH
/PAGE ZERO AND POINTERS
*10
INDEX0, 0 /AUTO-INDEX REGISTERS
INDEX1, 0
INDEX2, 0
INDEX3, 0
INDEX4, 0
INDEX5, 0
INDEX6, 0
IXR, 0 /INPUT LIST INDEX REGISTER
*20
UNIT10, 0 /CURRENT PDP-10 UNIT (U400)
POINT, 0 /GENERAL POINTER
CNTR, 0 /GENERAL COUNTER
TEMP1, 0 /TEMPORARIES
TEMP2, 0
TEMP3, 0
TEMP4, 0
TEMP5, 0
TEMP6, 0
CHARNI, 0 /CHARACTER INPUT NUMBER
CHARNO, 0 /CHARACTER OUTPUT NUMBER
OUNIT, 0 /OUTPUT UNIT
IUNIT, 0 /INPUT UNIT
IBLOCK, 0 /INPUT BLOCK
OBLOCK, 0 /OUTPUT BLOCK
INPUT, 0 /INPUT ROUTINE POINTER
OUTPUT, 0 /OUTPUT ROUTINE POINTER
IPOINT, 0 /INPUT POINTER
OPOINT, 0 /OUTPUT POINTER
SAVELN, 0 /OPTION /P SWITCH
MODE, 0 /OPTION /I AND /B SWITCH
WORDS, 0 /WORDS LEFT COUNTER
DATE, 0 /TODAY'S DATE
FREEP, 0 /POINT TO FREE SPOT
PRINT0, 0 /PRINT ROUTINE TEMPORARIES
PRINT1, 0
PRINT2, 0
PRINT3, 0
PRINTC, 0 /240 FOR LEADING SPACES
RBFLAG, 0 /RUBOUT FLAG
CDDEVF, 0 /DEFAULT DEVICE NAME
0
CDNAME, 0 /FILE NAME
0
0
CDEXT, 0 /FILE EXTENSION
0
0 /FILLER WORD
PERSW, 0 /PERIOD SWITCH
DEVSW, 0 /DEVICE SWITCH
CDDEV, 0 /DEVICE
0
INSEG, 0 /PDP-10 UNIT WITH DIRECTORY IN CORE
PDP10D, ZBLOCK 10 /LIST OF KNOWN PDP-10 UNITS
CDCNT, 0 /INPUT LIST COUNTER
CDI04, 0 /POINTER SAVE
XDSK, TEXT /DSK/ /DEFAULT DEVICE DSK:
OCHARY, 0 /TEMPORARY
DVTYPE, 0 /DEVICE TYPE HOLDER
TDUNIT, 0 /0 OR 4000
TAPFUN, 0 /DECTAPE FUNCTION
DATE75, 0 /1 MEANS HAD H.O. BIT ON
XDATE, 0 /POINTS TO EXTRA DATE BIT
HIDATE, 0 /HIGH-ORDER BIT OF TODAY'S DATE
/ KLUDGE FOR DATE-75 BUG:
/ ONLY CONSIDER 1 MORE BIT OF PRECISION
/ INSTEAD OF ALL 3 EXTRA BITS
/ SINCE OS/8 DATE WILL RUN OUT BEFORE
/ THAT FAILS
PAGE
JMP I (PIP10 /NORMAL ENTRY
JMS ERROR /PIP10 CANNOT BE CHAINED TO
ERMES0-1
/ERROR ROUTINES
IOERR, JMS ERROR /I/O ERROR
ERMES1-1
NOROOM, JMS ERROR /NO ROOM IN TAPE OR DIRECTORY
ERMES2-1
NOOFIL, JMS ERROR /NO SUCH DEVICE
ERMES3-1
FNOTFD, JMS ERROR /FILE NOT FOUND
ERMES9-1
NOT10F, JMS ERROR /NOT A PDP-10 FILE
ERMES4-1
ERDELF, JMS ERROR /ERROR DELETING A FILE
ERMES5-1
NOTPSF, JMS ERROR /NOT A OS8 FILE
ERMES6-1
NOOOFL, JMS ERROR /ERROR OPENING THE OUTPUT FILE
ERMES7-1
SYNTAX, JMS ERROR /SYNTAX ERROR
ERMES8-1
ERROR, 0 /ERROR ROUTINE
CLA
CDF
TAD I ERROR
DCA INDEX0 /POINT TO MESSAG-1
TAD (ERROR3
DCA OUTPUT /SET TTY: OUTPUT
JMS ERROR4 /PRINT THE STRING
JMP I (PIPCD /AND BACK TO NORMAL
ERROR4, 0 /PRINT THE STRING POINTED BY INDEX0
TAD I INDEX0
DCA TEMP1 /SAVE WORD
TAD TEMP1
RTR
RTR
RTR
JMS ERROR2 /BREAK IT DOWN
TAD TEMP1
JMS ERROR2
JMP ERROR4+1 /LOOP
ERROR2, 0
AND [77 /USE 6 BITS
SNA
JMP I ERROR4 /END
DCA TEMP2
TAD TEMP2
AND (40
SNA CLA
TAD (100
TAD [200 /MAKE A CHAR
TAD TEMP2
TAD (-337 /_ IS SPECIAL
SNA
TAD (215-337
TAD (337
JMS ERROR7 /PUT IT
JMP I ERROR2
ERROR7, 0
DCA TEMP2
TAD TEMP2
JMS I OUTPUT
TAD TEMP2
TAD (-215
SZA CLA
JMP I ERROR7
TAD (212
JMP ERROR7+1
ERROR3, 0
TLS
TSF
JMP .-1
CLA
JMP I ERROR3
/PRINT ROUTINE
PRINT, 0
DCA PRINT0
PRINT7, DCA PRINTC /SET SWITCH
TAD (PRINTL
DCA PRINT1
CLL CLA CMA RTL
DCA PRINT3
PRINT4, DCA PRINT2
JMP .+3
DCA PRINT0
ISZ PRINT2
TAD PRINT0
TAD I PRINT1
SMA
JMP .-5
CLA
ISZ PRINT1
TAD PRINT2
SZA
JMP PRINT5 /IT IS NON-ZERO
TAD PRINTC
SZA
JMS I OUTPUT /PRINT LEADING SPACE IF DESIRED
JMP PRINT6
PRINT5, TAD ("0
JMS I OUTPUT
CLL CLA CML RAR
PRINT6, ISZ PRINT3
JMP PRINT4
TAD PRINT0
TAD ("0
JMS I OUTPUT
JMP I PRINT
PAGE
/PDP-10 DECTAPE SERVICE ROUTINE
/
/CALL:
/ JMS READT /READ PDP-10 DECTAPE
/ BUFFER /BUFFER ADDRESS - FIELD 1
/ BLOCK /BLOCK NUMBER
/
/ JMS WRITET /WRITE PDP-10 DECTAPE
/ BUFFER /BUFFER ADDRESS - FIELD 1
/ BLOCK /BLOCK NUMBER
/
/THE UNIT IS IN "UNIT10"
TCON2, 2 /MUST BE AT BEGINNING OF PAGE!
WRITET, 0 /WRITE PDP-10 DECTAPE
CDF /BE SURE OF FIELD 0
TAD WRITET
STL
JMS I (TDIOCK /CHECK FOR TD IO
TAD I WRITET /GET BUFFER ADDRESS
DCA TBUF /AND SAVE IT
JMS RWTEST /TEST DIRECTION
WRITE2, JMS I (FLIP /REVERSE - FLIP BUFFER NOW
TAD (50
WRITE1, DCA TAPFUN /SET FUNCTION (30=READ, 50=WRITE)
DTLB /SEARCH INTO FIELD 0
TAD (TBLK
DCA I TCA /TAPE BLOCK INTO "TBLK"
TERR, RTL /ERROR BIT IS 0 INITIALLY
RAL /SHIFT END ZONE BIT INTO LINK
CML CLA /CLEAR REST OF THE JUNK
TAD [200 /'GO' BIT
TSTART, SNL /SKIP IF NO REVERSE DIRECTION
TAD [400 /'REVERSE' BIT
DTXA /START DRIVE GOING
TLOOP, JMS I (DTWAIT
TOUT, SPA /ERROR?
JMP TERR /YES - CHECK IT
DTRA /CHECK DIRECTION
RTL
RTL /DIRECTION BIT INTO LINK
TMOD1, SZL CLA /'SNL CLA' IF REVERSE MODE
TMOD4, TAD TCON2 /'CLL CLA CMA RAL' IF REVERSE MODE
TAD TBLK /GET BLOCK FOUND
CMA
TAD I WRITET /GET BLOCK DESIRED
CMA
SZA CLA /SKIP IF FOUND THE BLOCK
JMP TSTART /NOT FOUND - GO AGAIN
TMOD2, SZL CLA /'SNL CLA' IF REVERSE MODE
JMP TSTART+1 /FOUND BUT WRONG DIRECTION - REVERSE IT
CLA CMA
TAD TBUF /GET BUFFER ADDRESS-1
DCA I TCA /SET ADDRESS
TAD (10
DTLB /SET FIELD 1 BUFFER
TAD TAPFUN
DTXA /SET READ OR WRITE
TAD TM600
DCA I TWC /SET WORD COUNT OF 600 OCTAL WORDS
DTSF /FLAG?
JMP .-1 /NO - WAIT
DTRB /CHECK FOR ERRORS
SPA CLA
JMP I (IOERR /ERROR!!
TAD [200
DTXA /STOP THE DRIVE
TMOD3, JMS I (FLIP /POSSIBLE FLIP AFTER READ
ISZ WRITET
JMP I WRITET /EXIT
TCA, 7755 /DECTAPE CURRENT ADDRESS
TWC, 7754 /DECTAPE WORD COUNT
TBLK, 0 /SET TO BLOCK FOUND IN SEARCH
TBUF, 0 /HOLDS BUFFER ADDRESS
/READ ENTRY POINT
READT, 0 /PDP-10 DECTAPE READ
CDF /INSURE FIELD 0
TAD READT
CLL
JMS I (TDIOCK /CHECK FOR TD IO
TAD I READT /GET BUFFER ADDRESS
DCA TBUF /AND SAVE IT
TAD READT
DCA WRITET /MOVE RETURN ADDRESS
JMS RWTEST /CHECK DIRECTION
NOP /NO INITIAL FLIP IF REVERSE
TAD (30 /READ FUNCTION
JMP WRITE1 /GO DO REST OF THE ROUTINE
RWTEST, 0 /CHECK DIRECTION TO READ/WRITE AND SEARCH
ISZ WRITET
JMS I (GOLDBK /GET OLD BLOCK NUMBER (NEGATIVE)
TAD I WRITET /GET DESIRED BLOCK
DCA TBLK /SAVE FOR FUTURE USE
SZL CLA
TAD (10 /FORWARD - SZL CLA
TAD TMOD6 /REVERSE - SNL CLA
DCA TMOD1 /SET UP FOR DIRECTION
TAD TMOD1
DCA TMOD2
SNL CLA
TAD WRITE2 /REVERSE - FLIP BUFFER AFTER
DCA TMOD3 /FORWARD - NO BUFFER FLIP
TMOD6, SNL CLA
TAD (7344-1200 /REVERSE - CLL CLA CMA RAL
TAD TMOD5 /FORWARD - TAD TCON2
DCA TMOD4 /X0002 OR 17776
SZL CLA
ISZ RWTEST /FORWARD - 2ND EXIT
IAC
SNL
CIA /REVERSE DIRECTION
TAD I WRITET
SPA
TM600, CLA /NO LOWER THAN 0
DCA I TAPFUN /SET NEW LAST SERVICED BLOCK
TAD TBLK /REMEMBER SAVING THIS?
CLL
SMA SZA /<0 AND 0 SKIP AND HAVE LINK=0
CLL CML CIA />0 BECOMES <0 AND HAS LINK=1
TMOD5, TAD TCON2
CLA RTR /LINK HAS SEARCH DIRECTION
RTR
TAD (10 /ADD 'SEARCH' BIT
DTCA DTXA /LOAD SEARCH AND DIRECTION
TAD UNIT10 /GET UNIT
DTXA /ADD UNIT (ALSO FLIPS DIRECTION)
JMP I RWTEST /EXIT
PAGE
/"OLDTBL" IS LIST OF LAST SERVICED BLOCKS
OLDTBL, 0;0;0;0;0;0;0;0
/FLIP THE BUFFER ROUTINE
FLIP, 0 /FLIP A 600 WORD BUFFER (FIELD 1)
TAD I (TBUF /BUFFER START
DCA FLIP1 /SET START
TAD (577
TAD I (TBUF
DCA FLIP2 /SET END (END=START+577)
TAD (-300
DCA FLIP3 /SET COUNT (600/2=300)
CDF 10 /BUFFER IS IN FIELD 1
FLIP6, TAD I FLIP1 /GET START
JMS FLIP4 /FLIP IT
DCA FLIP5 /SAVE TEMPORARILY
TAD I FLIP2 /GET END
JMS FLIP4 /FLIP IT
DCA I FLIP1 /PUT END INTO START
TAD FLIP5
DCA I FLIP2 /PUT START INTO END
ISZ FLIP1 /BUMP POINTERS
CLA CMA
TAD FLIP2
DCA FLIP2
ISZ FLIP3 /DONE?
JMP FLIP6 /NO - LOOP
CDF /BACK TO FIELD 0
JMP I FLIP /EXIT
FLIP1, 0 /START POINTER
FLIP2, 0 /END POINTER
FLIP3, 0 /COUNTER
FLIP5, 0 /TEMPORARY
FLIP7, 0 /FLIPPING TEMPORARIES
FLIP8, 0 /" "
FLIP4, 0 /FLIP A CELL
DCA FLIP7 /SAVE IT
TAD FLIP7
RTL
RTL
AND (7 /GET ...1
DCA FLIP8 /ACCUMULATE RESULT
TAD FLIP7
RTR
RAR
AND (70 /GET ..2.
TAD FLIP8
DCA FLIP8 /BUILD RESULT
TAD FLIP7
AND (70
CLL RTL
RAL /GET .3..
TAD FLIP8
DCA FLIP8 /BUILD RESULT
TAD FLIP7
AND (7
CLL RTR
RTR /GET 4...
TAD FLIP8
CMA /GET NOT 4321
JMP I FLIP4 /EXIT
/TD8E I/O ROUTINE - CALLS STANDARD ROUTINE
TDIOCK, 0
DCA TDRET /SAVE RETURN ADDR
RAR
DCA TDFUN /SAVE READ/WRITE
JMS I (GET10D /GET TYPE OF DECTAPE
TAD (-2
SZA CLA
JMP I TDIOCK /TC08 - CONTINUE
TAD I TDRET
DCA TDBUF /SAVE BUF ADDR
ISZ TDRET
JMS GOLDBK /GET OLD BLOCK #
TAD I TDRET
CLA RAL /GET DIRECTION
TAD (110 /ONE BLOCK, FIELD 1
TAD TDFUN
DCA TDFUN /SAVE FINAL FUNCTION WORD
JMS I (TDUSET /SET UP HANDLER
TAD TDUNIT
SPA CLA
TAD (DTA1-DTA0
TAD (DTA0
DCA TDIOCK /SET UP HANDLER ENTRY PTR
TAD I TDRET
DCA I TAPFUN
TAD I TAPFUN
DCA TDBLK
JMS I TDIOCK
TDFUN, 0
TDBUF, 0
TDBLK, 0
JMP I (IOERR
ISZ TDRET
JMP I TDRET
TDRET, 0
GOLDBK, 0
TAD UNIT10 /GET THE UNIT WE NEED
CLL RTL
RTL /SHIFT INTO BITS 9-11
TAD (OLDTBL
DCA TAPFUN /POINT TO THIS UNIT'S POSITION
TAD I TAPFUN /GET LAST SERVICED BLOCK
CLL CIA
JMP I GOLDBK
PAGE
/GET A LINE ROUTINE
GLINE, 0 /GET A LINE
TAD ["*
JMS I [ERROR3 /ANNOUNCE US WITH A *
DCA RBFLAG /RESET RUBOUT FLAG
TAD [LINBUF-1
DCA IXR /POINT TO THE BUFFER
CHLOOP, KSF
JMP CHLOOP /WAIT FOR TTY:
TAD [200
KRS /READ TTY:
DCA TEMP1
KCC
TAD [SPADR-1
DCA INDEX0 /SET LIST SEARCH
TAD I INDEX0
SNA
JMP .+6 /END OF LIST
TAD TEMP1
SNA CLA
JMP I INDEX0 /FOUND SO JUMP
ISZ INDEX0
JMP .-7 /LOOP
JMS PRNT /PRINT IT
CINSRT, TAD TEMP1
DCA I IXR /STORE THE CHARACTER
TAD IXR
TAD (-LINBUF-100
SZA CLA
JMP CHLOOP /GET ANOTHER CHARACTER
JMS CRCR
JMP I (SYNTAX /ERROR
CARRET, JMS CRCR
CLFINI, DCA I IXR /SET END
DCA I IXR
JMP I GLINE /EXIT
SPADR, -225;JMP CTRLU
-215;JMP CARRET
-377;JMP RUBOUT
-375;JMP ALTMOD
-376;JMP ALTMOD
-233;JMP ALTMOD
-200;JMP CHLOOP
-217;JMP CHLOOP
-337;JMP BAKARR
-212;JMP LFEED
-203;JMP CTRLC
0
BAKARR, JMS PRNT /"_"
TAD ["<
JMP CINSRT+1 /USE "<" INSTEAD
CTRLC,
CTRLU, TAD ["^
JMS I [ERROR3 /CONTROL CHARACTERS
TAD TEMP1
TAD [100
CLRLIN, JMS I [ERROR3
JMS CRCR
TAD I INDEX0
SZA CLA
JMP GLINE+1 /NOT "^C"
TSF
JMP .-1
JMP I (7605 /TO MONITOR
CRCR, 0
TAD [215
DCA TEMP1
JMS PRNT
TAD [212
JMS I [ERROR3 /PRINT CR-LF
JMP I CRCR
ALTMOD, TAD ["$
DCA TEMP1 /ALTMODE IS "$"
JMS PRNT
JMP CLFINI /ENDS THE LINE
RUBOUT, TAD IXR
TAD (1-LINBUF
SNA CLA
JMP RBSPCL /SPECIAL TREATMENT
TAD ("\
ISZ RBFLAG
JMS I [ERROR3 /PRINT \
CLA CMA
DCA RBFLAG /SET FLAG
TAD IXR
DCA TEMP2
TAD I TEMP2
JMS I [ERROR3 /PRINT RUBED CHAR
LBCKUP, CLA CMA
TAD IXR
JMP CHLOOP-1 /GO GET ANOTHER
RBSPCL, ISZ RBFLAG
JMP CLRLIN+1 /NOT INTO RUBOUTS
TAD ("\
JMP CLRLIN
PRNT, 0
ISZ RBFLAG
JMP .+3
TAD ("\
JMS I [ERROR3 /END OF RUBOUTS
DCA RBFLAG
TAD TEMP1
JMS I [ERROR3 /PRINT CHAR
JMP I PRNT
LFEED, JMS CRCR
DCA I IXR /SET END
TAD [LINBUF-1
DCA IXR
TAD ["*
JMS I [ERROR3
TAD I IXR /PRINT THE LINE
SNA
JMP LBCKUP
JMP .-4
PAGE
/FIND A SLOT ROUTINE
/SLOT NUMBERS BETWEEN 0 AND 1101
/RETURN WITH A 5 BIT NUMBER (1 TO 26 OCTAL)
/
/CALL:
/ JMS FINDSL /FIND A SLOT
/ SLOT# /SLOT NUMBER
/ (AC) /VALUE OF SLOT RETURNED
/
/SLOT NUMBER OF 0 RETURNS 7777
FINDSL, 0 /FIND A SLOT
CLA CMA
TAD I FINDSL /GET SLOT NUMBER-1
ISZ FINDSL
SPA /WAS IT 0?
JMP FINDSA /YES
JMS DIV7 /NO - DIVIDE BY 7
TAD (JMP I FINDS0+7
DCA DIV1 /USE REMAINDER FOR JUMPING
CDF 10 /BUFFER IS IN FIELD 1
DIV1, HLT /TEMPORARY AND JUMP CELL
FINDSA, CLA CMA
JMP I FINDSL /EXIT WITH 7777 FOR SLOT NUMBER 0
FINDS0, FINDS1 /JUMP TABLE
FINDS2
FINDS3
FINDS4
FINDS5
FINDS6
FINDS7
/DIVIDE BY 7 ROUTINE
DIV7, 0 /DIVIDE BY 7
DCA DIV1 /SAVE IT
TAD (DIRECT
DCA POINT /POINT TO DIRECTORY
TAD DIV1
DIV3, TAD (-7 /SUBTRACT 7'S
SPA
JMP I DIV7 /EXIT WITH REMAINDER
ISZ POINT /BUMP POINTER BY 3
ISZ POINT
ISZ POINT
JMP DIV3 /AND LOOP
/FIND SLOT ROUTINE #1
/USE WORD 1 BITS 0-4
FINDS1, TAD I POINT /GET CELL
RTL
RTL
RTL /GET FIRST 5 BITS
FINDS8, AND [37 /ONLY 5 BITS
CDF /BACK TO FIELD 0
JMP I FINDSL /AND EXIT WITH VALUE IN AC
/FIND SLOT ROUTINE #2
/USE WORD 1 BITS 5-9
FINDS2, TAD I POINT
RTR /USE BITS 5-9
JMP FINDS8
/FIND SLOT ROUTINE #3
/USE WORD 1 BITS 10-11 AND WORD 2 BITS 0-2
FINDS3, TAD I POINT
AND [3 /USE BITS 10-11 OF 1ST WORD
CLL RTL
RAL /SHIFT TO BITS 7-8
DCA DIV1 /SAVE IT
ISZ POINT /NEXT WORD
TAD I POINT
CLL RTL
FINDS9, RTL /GET INTO BITS 8-11
AND [17 /GET ONLY BITS 8-11
TAD DIV1 /ADD OTHER BITS
JMP FINDS8
/FIND SLOT ROUTINE #4
/USE WORD 2 BITS 3-7
FINDS4, ISZ POINT /USE 2ND WORD
TAD I POINT
RTR /USE BITS 3-7
JMP FINDS2+1
/FIND SLOT ROUTINE #5
/USE WORD 2 BITS 8-11 AND WORD 3 BIT 0
FINDS5, ISZ POINT /USE 2ND WORD
TAD I POINT
AND [17
CLL RAL /GET BITS 7-10
DCA DIV1 /AND SAVE THEM
ISZ POINT /NEXT WORD
CLL CLA CML RAR
AND I POINT /GET BIT 0
JMP FINDS9
/FIND SLOT ROUTINE #6
/USE WORD 2 BITS 1-5
FINDS6, ISZ POINT
ISZ POINT /USE 3RD WORD
TAD I POINT
RAL
JMP FINDS1+1
/FIND SLOT ROUTINE #7
/USE WORD 3 BITS 6-10
FINDS7, ISZ POINT
ISZ POINT /USE 3RD WORD
TAD I POINT
RAR /GET RID OF LAST BIT
JMP FINDS8
/DELETE A PDP-10 ENTRY
/
/CALL:
/ (AC) /POINT TO NAME-1 (FIELD 1)
/ JMS DELETE /DELETE A PDP-10 ENTRY
/ -NO- /NOT FOUND
/ -OK- /ENTRY DELETED
DELETE, 0 /DELETE A PDP-10 ENTRY
JMS I (FIND /TRY TO FIND IT FIRST
JMP I DELETE /NOT FOUND
ISZ DELETE /FOUND - 2ND EXIT
DCA DELET1 /SAVE SLOT NUMBER
CLA IAC
DCA DELET2 /START AT SLOT 1
TAD (-1101
DCA DELET3 /DO 1101 SLOTS
JMS FINDSL /FIND A SLOT
DELET2, 0 /SLOT NUMBER
CIA
TAD DELET1 /IS IT ONE OF OURS?
SZA CLA
JMP DELET4 /NO
TAD DELET2 /YES
DCA .+2 /SET SLOT NUMBER AGAIN
JMS I (FILLSL /FILL WITH A 0
0
0 /FILL WITH A 0
DELET4, ISZ DELET2 /NEXT SLOT
ISZ DELET3 /MORE?
JMP DELET2-1 /YES - LOOP
CDF 10 /DIRECTORY IS IN FIELD 1
DCA I INDEX0 /REMEMBER "FIND" SETTING THIS UP?
DCA I INDEX0 /REMOVE THE FILE NAME
DCA I INDEX0
TAD INDEX0
TAD [77
DCA INDEX0 /POINT TO EXTENSION
DCA I INDEX0
DCA I INDEX0 /REMOVE EXTENSION
DCA I INDEX0
CDF
JMP I DELETE /EXIT
DELET1, 0 /HOLDS FOUND SLOT NUMBER
DELET3, 0 /COUNTER
PAGE
/FILL A SLOT ROUTINE
/
/CALL:
/ JMS FILLSL /FILL A SLOT
/ SLOT# /SLOT NUMBER
/ VALUE /VALUE TO FILL SLOT WITH
/
/SLOT NUMBER 0 IS ILLEGAL!
FILLSL, 0 /FILL A SLOT ROUTINE
CLA CMA
TAD I FILLSL /GET SLOT NUMBER-1
ISZ FILLSL
JMS I (DIV7 /DIVIDE BY 7
TAD (JMP I FILLS0+7
DCA FILLS9 /USE REMAINDER FOR JUMPING
TAD I FILLSL /GET VALUE
ISZ FILLSL
AND [37 /5 BIT VALUE ONLY
CDF 10 /DIRECTORY IS IN FIELD 1
FILLS9, HLT /TEMPORARY AND JUMP CELL
/JUMP TABLE
FILLS0, FILLS1
FILLS2
FILLS3
FILLS4
FILLS5
FILLS6
FILLS7
FILLSA, 0 /TEMPORARY
/FILL SLOT ROUTINE #1
/BITS 0-4 OF WORD 1
FILLS1, CLL RTR
RTR /VALUE INTO BITS 0-4
RTR
DCA FILLS9 /SAVE VALUE
TAD I POINT
AND [177 /AND OFF BITS 0-4
FILLS8, TAD FILLS9 /ADD IN VALUE
DCA I POINT /SET NEW WORD
CDF /BACK TO FIELD 0
JMP I FILLSL /EXIT
/FILL SLOT ROUTINE #2
/BITS 5-9 OF WORD 1
FILLS2, CLL RTL /VALUE INTO BITS 5-9
DCA FILLS9 /SAVE VALUE
TAD I POINT
AND (7603 /AND OFF BITS 5-9
JMP FILLS8
/FILL SLOT ROUTINE #3
/BITS 10-11 OF WORD 1 AND BITS 0-2 OF WORD 2
FILLS3, DCA FILLS9 /SAVE VALUE
TAD FILLS9
CLL RAR
CLL RAR /GET BITS 10-11
CLL RAR
DCA FILLSA /SAVE
TAD I POINT
AND (7774 /AND OFF BITS 10-11
TAD FILLSA /ADD IN BITS 10-11
DCA I POINT /SET NEW WORD
ISZ POINT /GOTO WORD 2
TAD FILLS9
AND [7 /GET BITS 0-2
CLL RTR
RTR /SHIFT THEM
DCA FILLS9 /SAVE VALUE
TAD I POINT
AND (777 /AND OFF BITS 0-2
JMP FILLS8
/FILL SLOT ROUTINE #4
/BITS 3-7 OF WORD 2
FILLS4, CLL RTL
RTL /SHIFT INTO POSITION
DCA FILLS9 /AND SAVE
ISZ POINT /USE WORD 2
TAD I POINT
AND (7017 /AND OFF BITS 3-7
JMP FILLS8
/FILL SLOT ROUTINE #5
/BITS 8-11 OF WORD 2 AND BIT 0 OF WORD 3
FILLS5, DCA FILLS9
TAD FILLS9 /GET VALUE
CLL RAR /GET BITS 8-11
DCA FILLSA /AND SAVE
ISZ POINT /USE WORD 2 FIRST
TAD I POINT
AND [7760 /AND OFF BITS 8-11
TAD FILLSA /ADD IN THOSE BITS
DCA I POINT /SET NEW WORD 2
ISZ POINT /NOW WORD 3
CLA IAC
AND FILLS9 /GET BIT 0
CLL RTR /AND SHIFT INTO POSITION
DCA FILLS9 /AND SAVE IT
CLL CLA CMA RAR
AND I POINT /AND OFF BIT 0
JMP FILLS8
/FILL SLOT ROUTINE #6
/BITS 1-5 OF WORD 3
FILLS6, CLL RTL
RTL /SHIFT INTO POSITION
RTL
DCA FILLS9 /AND SAVE
ISZ POINT
ISZ POINT /USE WORD 3
TAD I POINT
AND (4077 /AND OFF BITS 1-5
JMP FILLS8
/FILL SLOT ROUTINE #7
/BITS 6-10 OF WORD 3
/BIT 11 OF WORD 3 A 0
FILLS7, CLL RAL /SHIFT INTO POSITION
DCA FILLS9 /AND SAVE
ISZ POINT
ISZ POINT /USE WORD 3
TAD I POINT
AND [7700 /AND OFF BITS 6-11
JMP FILLS8
FIX75, 0 /DF 10
CDF /SET H.O. DATE WORD OF FILE
TAD I (SLOTNO /ENTRY NO. OF FILE
CLL RAL /*3
TAD I (SLOTNO /SINCE 1 -10 WORD= 3 -8 WORDS
TAD (DIRECT-1 /POINT TO HIGH ORDER BIT OF DATE
DCA FIXPTR /V3C
CDF 10
STA CLL RAL /OTHER STUFF IS VERY IMPORTANT
AND I FIXPTR /SO KEEP IT
TAD HIDATE /OR IN THIS BIT
DCA I FIXPTR /AND WRITE IT BACK
JMP I FIX75
FIXPTR, 0 /POINTS TO WORD CONTAINING H.O. DATE
PAGE
/GET NEXT SLOT ROUTINE
/GOES BY 5'S EITHER FORWARD OR BACKWARD
/
/CALL:
/ (AC) /CURRENT BLOCK NUMBER
/ JMS NEXTSL /GET NEXT SLOT
/ (AC) /NEXT BLOCK NUMBER
/
/GOES TO "NOROOM" IF DIRECTORY FULL
NEXTSL, 0 /GET NEXT SLOT
TAD NEXTDI /ADD IN DIRECTION FACTOR
SPA
JMP NEXTS2 /<0 MEANS REVERSE DIRECTION
TAD [-1102
SMA
JMP NEXTS2 />1101 MEANS REVERSE DIRECTION
TAD (1102
DCA NEXTS1 /SET NEW BLOCK NUMBER
JMS I (FINDSL /IS THIS SLOT FREE?
NEXTS1, 0 /BLOCK NUMBER
SZA CLA
JMP NEXTS3 /NO - NOT FREE
TAD NEXTS1 /FREE
DCA NEXTS7+1 /SET BLOCK AGAIN
NEXTS7, JMS I (FILLSL /FILL THIS SLOT THEN
0 /SLOT TO FILL
SLOTNO, 0 /VALUE TO FILL WITH
TAD NEXTDI
SMA CLA /MAKE SURE DIRECTION IS -4 OR 4
TAD (10
TAD (-4
DCA NEXTDI
TAD NEXTS7+1 /GET NEW BLOCK
JMP I NEXTSL /EXIT
NEXTS2, CLA /REVERSE DIRECTION
TAD NEXTDI
SMA CLA /SET 0 OR 1101
TAD (1101
DCA NEXTS1 /INTO BLOCK NUMBER
TAD NEXTDI
CIA /REVERSE DIRECTION
JMP NEXTS3+1 /GO PRETEND WE FOUND A FULL SLOT
NEXTS3, TAD NEXTDI
SMA CLA /MAKE DIRECTION -1 OR 1
CLL CLA CMA RAL
CMA
DCA NEXTDI /DIRECTION IS -1 OR 1
TAD [-1102
DCA NEXTS4 /CHECK 1102 BLOCKS
TAD NEXTS1
DCA NEXTS5 /SET START BLOCK
JMS I (FINDSL /CHECK A SLOT
NEXTS5, 0 /SLOT TO CHECK
SNA CLA
JMP NEXTS6 /FOUND A FREE SLOT
ISZ NEXTS4 /TRY MORE?
SKP /YES
JMP I (NOROOM /NO - OUT OF ROOM
TAD NEXTS5
TAD NEXTDI /ADD DIRECTION TO SLOT
SPA
JMP NEXTS2 /<0 IS TOO FAR
TAD [-1102
SMA
JMP NEXTS2 />1101 IS TOO FAR
TAD (1102
DCA NEXTS5 /SET NEW BLOCK
JMP NEXTS5-1 /KEEP GOING
NEXTS6, TAD NEXTS5 /GET FREE BLOCK
JMP NEXTS7-1 /AND SET IT
NEXTS4, 0 /COUNTER
NEXTDI, 0 /DIRECTION (5, -5, 1, -1)
/MORE PDP-10 OUTPUT
/OUTPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
OCHAR3, TAD OCHARY
CLL RTR
RTR
AND [7
TAD I OPOINT
DCA I OPOINT
ISZ OPOINT
TAD OCHARY
AND [17
CLL RTR
RTR
RAR
JMP I (OCHARD
MONTBL, "J;"A;"N
"F;"E;"B
"M;"A;"R
"A;"P;"R
"M;"A;"Y
"J;"U;"N
"J;"U;"L
"A;"U;"G
"S;"E;"P
"O;"C;"T
"N;"O;"V
"D;"E;"C
PAGE
/PDP-10 CHARACTER OUTPUT ROUTINE
/
/CALL:
/ (AC) /CHARACTER
/ JMS OCHR10 /OUTPUT TO PDP-10
/ -RETURN- /O.K. RETURN
OCHR10, 0 /OUTPUT TO PDP-10
DCA OCHARY /SAVE CHAR
TAD MODE /IMAGE MODE?
SZA
JMP OC10A1 /YES /I OR /B
TAD OCHARY /NO - USE 7 BITS
AND [177
OC10A2, DCA OCHARY
OC10A3, TAD CHARNO /GET CHAR NUMBER
TAD (JMP I OCHARX
DCA OCHARZ /USE TO SET UP JUMP
CDF 10 /BUFFER IS IN FIELD 1
OCHARZ, 0 /JUMP TO THE ROUTINE
OC10A1, SMA CLA /BINARY?
JMP OC10A3 /NO
TAD OCHARY /YES
AND [377
JMP OC10A2
OCHARX, OCHAR0
OCHAR1
OCHAR2
OCHAR3
OCHAR4
/OUTPUT CHARACTER #0 - BITS 0-6 WORD 1
OCHAR0, TAD I [OBUF10+2
AND [177 /GET COUNT
TAD (-177
SZA CLA
JMP OCHARA /STILL ROOM IN BUFFER
CDF /NO ROOM IN BUFFER
TAD OBLOCK
JMS I (NEXTSL /GET THE NEXT BLOCK NUMBER
DCA OCHARZ /AND SAVE IT
CDF 10 /BACK TO FIELD 1
TAD OCHARZ
AND [7700
CLL RTR
RTR
RTR /GET LINK POINTER
DCA I [OBUF10
TAD OCHARZ
AND [77
CLL RTL
RTL
RTL
TAD I [OBUF10+1
DCA I [OBUF10+1 /AND SET POINTER
TAD OUNIT
DCA UNIT10 /SET OUR UNIT
TAD OBLOCK
DCA .+3 /AND OUR BLOCK
JMS I (WRITET /WRITE PDP-10 DECTAPE
OBUF10
0 /BLOCK NUMBER IS SET
CDF 10 /BACK TO FIELD 1
DCA I [OBUF10
TAD I [OBUF10+1
AND [77
DCA I [OBUF10+1 /CLEAR POINTER
TAD OCHARZ
DCA OBLOCK /SET NEW BLOCK
TAD I [OBUF10+2
AND [7400
DCA I [OBUF10+2 /ZERO COUNT
TAD (OBUF10+3
DCA OPOINT /RESET POINTER
OCHARA, ISZ I [OBUF10+2 /BUMP COUNT
TAD MODE /IMAGE MODE?
SNA
JMP OCHARB /NO
SMA CLA /BINARY?
JMP OC10A4 /NO
DCA I OPOINT /YES
ISZ OPOINT
DCA I OPOINT
ISZ OPOINT
TAD OCHARY
DCA I OPOINT /SET 8 BITS
ISZ OPOINT
OCHARC, CDF /BACK TO FIELD 0
JMP I OCHR10 /EXIT
OC10A5, ISZ OPOINT
OC10A4, TAD OCHARY
JMP OCHARD
OCHARB, TAD OCHARY
CLL RTL
RTL
RAL /USE BITS 0-6
OCHARD, DCA I OPOINT /SET IT
ISZ CHARNO /BUMP CHARACTER NUMBER
JMP OCHARC
/OUTPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
OCHAR1, TAD MODE
SZA CLA
JMP OC10A5
TAD OCHARY
CLL RAR /GET BITS 7-11
CLL RAR
TAD I OPOINT
DCA I OPOINT /SET WORD 1
ISZ OPOINT /NOW WORD 2
TAD OCHARY
AND [3
CLL RTR
RAR /GET BITS 0-1
JMP OCHARD
/OUTPUT CHARACTER #2 - BITS 2-8 WORD 2
OCHAR2, TAD MODE
SZA CLA
JMP OC10A6
TAD OCHARY
CLL RTL
RAL /GET BITS 2-8
TAD I OPOINT
JMP OCHARD
/OUTPUT CHARACTER #4 - BITS 4-10 WORD 3
/BIT 11 WORD 3 IS 0
OCHAR4, TAD OCHARY
CLL RAL /BITS 4-10
TAD I OPOINT
OC10A7, DCA I OPOINT /SET WORD 3
ISZ OPOINT
DCA CHARNO /RESET CHARACTER NUMBER
JMP OCHARC
OC10A6, ISZ OPOINT
TAD OCHARY
JMP OC10A7
PAGE
/PDP-10 CHARACTER INPUT
/
/CALL:
/ JMS ICHR10 /PDP-10 INPUT
/ -EOF- /END OF FILE RETURN
/ (AC) /NORMAL RETURN - CHARACTER IN AC
ICHR10, 0 /PCP-10 INPUT ROUTINE
TAD CHARNI
TAD (JMP I ICHARX
DCA ICHARY /USE CHARACTER NUMBER TO FORM JUMP
CDF 10 /BUFFER IS IN FIELD 1
ICHARY, 0 /TEMPORARY AND JUMP CELL
ICHARX, ICHAR0
ICHAR1
ICHAR2
ICHAR3
ICHAR4
/INPUT CHARACTER #0 - BITS 0-6 WORD 1
ICHAR0, TAD WORDS /GET NUMBER OF WORD LEFT
SZA CLA
JMP ICHARA /STILL MORE WORDS LEFT
TAD IBLOCK /GET NEXT BLOCK
SNA
JMP ICHARC+1 /NONE - EOF
DCA .+5 /SET NEXT BLOCK
TAD IUNIT
DCA UNIT10 /SET OUR UNIT
JMS I (READT /READ PDP-10 DECTAPE
IBUF10
0 /OUR BLOCK IS SET
CDF 10 /BACK TO FIELD 1
TAD I [IBUF10+2
AND [177
DCA WORDS /SET NUMBER OF WORDS
TAD I [IBUF10+1
RTR
RTR
RTR
AND [77
DCA IBLOCK /SET NEXT BLOCK
TAD I [IBUF10
AND [77
CLL RTL
RTL
RTL
TAD IBLOCK
DCA IBLOCK /SET NEXT BLOCK
TAD (IBUF10+3
DCA IPOINT /RESET POINTER
JMP ICHAR0
ICHARA, CLA CMA
TAD WORDS
DCA WORDS /COUNT DOWM ON NUMBER OF WORDS
TAD MODE /IMAGE MODE?
SNA
JMP ICHARB /NO
SMA CLA
JMP IC10A1
ISZ IPOINT /YES
ISZ IPOINT
TAD I IPOINT /GET WORD 3
ISZ IPOINT
AND [377 /USE 8 BITS
ICHARC, ISZ ICHR10 /2ND EXIT
CDF /BACK TO FIELD 0
JMP I ICHR10 /EXIT
ICHARB, TAD SAVELN /PRESERVE OPTION?
SZA CLA
JMP ICHARF /YES
CLL CLA CML RTL /NO
TAD IPOINT
DCA ICHARY /POINT TO WORD 3
TAD I ICHARY
CLL RAR
SNL CLA
JMP ICHARF /WORD O.K.
ISZ IPOINT
ISZ IPOINT /IGNORE THIS WORD
ISZ IPOINT
JMP ICHAR0
ICHARF, TAD I IPOINT
RTR
RTR /GET BITS 0-6
RAR
ICHARD, ISZ CHARNI /BUMP COUNTER
AND [177 /USE 7 BITS
TAD [200 /ADD BIT 8
JMP ICHARC
/INPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
ICHAR1, TAD MODE
SZA CLA
JMP IC10A1
TAD I IPOINT
AND [37
CLL RTL /GET BITS 7-11
DCA ICHARY
ISZ IPOINT /USE WORD 2 NOW
TAD I IPOINT
CLL RTL
RAL
AND [3 /GET BITS 0-1
ICHARE, TAD ICHARY /ADD IN OTHER BITS
JMP ICHARD
/INPUT CHARACTER #2 - BITS 2-8 WORD 2
ICHAR2, TAD MODE
SZA CLA
JMP IC10A3
TAD I IPOINT
RAR
RTR /GET BITS 2-8
JMP ICHARD
/INPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
ICHAR3, TAD I IPOINT
AND [7
CLL RTL
RTL /GET BITS 9-11
DCA ICHARY
ISZ IPOINT /USE WORD 3 NOW
TAD I IPOINT
RTL
RTL
RAL
AND [17 /GET BITS 0-3
JMP ICHARE
/INPUT CHARACTER #4 - BITS 4-10 WORD 3
ICHAR4, DCA CHARNI /RESET CHARACTER COUNT
TAD I IPOINT
ISZ IPOINT
RAR
JMP ICHARD+1
IC10A3, DCA CHARNI
SKP
IC10A1, ISZ CHARNI
TAD I IPOINT
ISZ IPOINT
JMP ICHARC
PAGE
/CLOSE A PDP-10 FILE
/
/CALL:
/ JMS CLOS10 /CLOSE A PDP-10 FILE
/ -RETURN-
CLOS10, 0 /CLOSE A PDP-10 FILE
TAD MODE /IMAGE MODE?
SPA CLA
JMP CLOS1A /YES - NO FILL NEEDED
TAD CHARNO
SNA CLA
JMP CLOS1A /CHARACTER NUMBER IS 0 - FILL DONE
JMS I (OCHR10 /0 FILL
JMP .-4 /LOOP
CLOS1A, TAD OUNIT
DCA UNIT10 /SET OUR UNIT
TAD OBLOCK
DCA .+3 /SET THE BLOCK
JMS I (WRITET /WRITE PDP-10 DECTAPE
OBUF10
0 /BLOCK IS SET
TAD (MOUTPU
JMS I (DELETE /DELETE THE OLD FILE
NOP /O.K. IF IT IS NOT THERE
TAD FREEP
DCA INDEX0 /POINT TO THE FREE SPOT
TAD [MOUTPU
DCA INDEX1 /POINT TO THE FILE NAME
CDF 10 /TO FIELD 1
TAD I INDEX1
DCA I INDEX0
TAD I INDEX1 /SET THE NAME
DCA I INDEX0
TAD I INDEX1
DCA I INDEX0
TAD INDEX0
TAD [77
DCA INDEX0 /POINT TO THE EXTENSION
TAD I INDEX1
DCA I INDEX0 /SET THE EXTENSION
TAD I INDEX1
DCA I INDEX0
TAD DATE
DCA I INDEX0 /SET THE DATE
JMS I (FIX75 /V3C SET HIGH ORDER BIT TOO
JMS I (WRITET /WRITE PDP-10 DECTAPE
DIRECT /DIRECTORY
144 /BLOCK 100 BASE 10
JMP I CLOS10 /EXIT
/OPEN A PDP-10 FILE FOR OUTPUT
/
/CALL:
/ JMS OOPN10 /OPEN A PDP-10 FILE
/ -RETURN-
OOPN10, 0 /OPEN A PDP-10 FILE
TAD (ZFREE-1
JMS I (FIND /FIND A FREE SPOT
JMP I (NOROOM /NO ROOM LEFT
DCA I (SLOTNO /SET THIS SLOT
TAD INDEX0
DCA FREEP /SAVE POINTER TO FREE SPOT
CLA CMA
DCA I (NEXTDI /SET DIRECTION = -1
TAD (144
JMS I (NEXTSL /FIND FIRST OPEN SLOT
DCA OBLOCK /AND SET IT
CDF 10
TAD I [MOUTPU
DCA OUNIT /SET UNIT
TAD OBLOCK
AND [17
CLL RTR
RTR
RAR
DCA I [OBUF10+2 /SET FIRST BLOCK POINTER
TAD OBLOCK
CLL RTR
RTR
AND [77
DCA I [OBUF10+1 /SET FIRST BLOCK POINTER
DCA I [OBUF10 /ZERO LINK POINTER
DCA CHARNO /RESET CHARACTER NUMBER
TAD (OBUF10+3
DCA OPOINT /RESET POINTER
CDF
JMP I OOPN10 /EXIT
/OPEN PDP-10 INPUT FILE
/
/CALL:
/ (AC) /POINT TO FILE NAME-1
/ JMS IOPN10 /OPEN PDP-10 INPUT FILE
/ -NO- /NOT THERE
/ (AC) /ANY BLOCK OF THE FILE
IOPN10, 0 /OPEN PDP-10 INPUT FILE
JMS I (FIND /FIND THE FILE
JMP I IOPN10 /NOT THERE
DCA IOPN1B /SAVE SLOT NUMBER
TAD (143
DCA IOPN1A
TAD (CLA CMA
DCA IOPN1D
IOPN1F, JMS I (FINDSL /FIND A SLOT
IOPN1A, 0 /SLOT TO FIND
CIA
TAD IOPN1B /IS IT US?
SNA CLA
JMP IOPN1C /YES
IOPN1D, CLA CMA
TAD IOPN1A /BUMP BLOCK NUMBER
SPA
JMP IOPN1E /TOO FAR
TAD [-1102
SMA
JMP I IOPN10 /TOO FAR - EXIT
TAD (1102
DCA IOPN1A /SET NEW BLOCK
JMP IOPN1F /RETRY
IOPN1B, 0 /SLOT THAT WE WANT
IOPN1E, CLA
TAD (CLA IAC
JMP IOPN1F-1 /CHANGE DIRECTION AND RETRY
IOPN1C, TAD IOPN1A
CDF
ISZ IOPN10
JMP I IOPN10 /EXIT
PAGE
/CONVERT OS8 DATE TO PDP-10 DATE
CVDATE, 0
SNA
JMP I CVDATE /0 CONVERTS TO 0
DCA TEMP1
TAD TEMP1 /V3C
RTR
RAR
AND [37
TAD (-1 /GET DAY
DCA DATE4 /V3C
TAD TEMP1
AND [7 /GET OS8 YEAR (-1970)
DECIMAL
TAD (1970-1964
OCTAL
DCA DATE1 /SAVE YEAR
TAD DATE1
CLL RAL /*2
TAD DATE1 /*2+1=*3
CLL RTL /*3*4=*12
DCA DATE1 /DATE1=DATE1*12
TAD TEMP1
RTL
RTL
RAL
AND [17 /GET MONTH
TAD (-1
TAD DATE1 /ADD IN MONTH
DCA DATE1
TAD DATE1
CLL RAL /*2
TAD DATE1 /*2+1=*3
DCA TEMP2
TAD TEMP2
CLL RTL /*3*4=*12
TAD TEMP2 /*12+*3=*15
CLL RAL /*15*2=*30
TAD DATE1 /*30+1=*31
TAD DATE4 /V3C ADD IN DAY
DCA DATE1 /DATE1=DATE1+MONTH-1 * 31
RAL /V3C LINK NOW HAS HIGH ORDER DATE BIT
DCA HIDATE /ONLY WITHIN RANGE OF OS/8
TAD DATE1 /RETURN LOW ORDER 12 BITS OF DATE
JMP I CVDATE
DATE1, 0
DATE4, 0
/TYPE A PDP-10 DATE
DATE10, 0
SZL /LINK HAD HIGH ORDER BIT
TAD (4 /IF ON, WANT ADDITIONAL 11 YEARS, 4 DAYS
DCA DATE1 /SAVE VALUE
RAL /V3C
DCA DATE75 /SAVE FACT THAT NEED 'NUTHER 11 YEARS
TAD (100 /V3C BASE IS (19)64
DCA DATE2 /WILL BE YEAR
DATE11, TAD DATE1
SMA CLA
JMP DATE12 /MUST BE POSITIVE
ISZ DATE2 /BUMP YEAR
TAD DATE1
TAD (-564 /-372 DECIMAL (DAYS PER YEAR)
DCA DATE1
JMP DATE11
DATE12, DCA DATE3 /WILL BE MONTH
TAD DATE1 /DIVIDE BY 31
TAD (-37
SPA
JMP .+4
ISZ DATE3 /BUMP MONTH
DCA DATE1
JMP .-6
CLA
ISZ DATE1 /+1 IS DAY
TAD DATE3 /DIVIDE BY 12
TAD (-14
SPA
JMP .+4
ISZ DATE2 /BUMP YEAR
DCA DATE3
JMP .-6
CLA
TAD DATE1
TAD (-12
SMA CLA
JMP DATE9
TAD ("0
JMS I OUTPUT /PRINT LEADING 0 IF NECESSARY
DATE9, TAD DATE1
JMS I (PRINT /PRINT DAY
TAD ("-
JMS I OUTPUT
TAD DATE3
TAD DATE3
TAD DATE3 /V3C MULTIPLY BY 3
TAD (MONTBL /ADD IN BASE OF MONTH NAMES
DCA MONPTR /POINT TO PROPER MONTH NAME
TAD I MONPTR /GET CHAR 1
JMS I OUTPUT /PRINT IT
ISZ MONPTR /POINT TO NEXT CHAR
TAD I MONPTR /GET CHAR 2
JMS I OUTPUT /PRINT IT
ISZ MONPTR /V3C
TAD I MONPTR
JMS I OUTPUT
TAD ("-
JMS I OUTPUT
TAD DATE75 /V3C
SZA CLA
TAD (13 /ADD 11 YEARS IF H.O. BIT ON
TAD DATE2
JMS I (PRINT /PRINT YEAR
JMP I DATE10
DATE2, 0 /YEAR
DATE3, 0 /MONTH
MONPTR, 0 /V3C POINTS TO MONTH NAME
PAGE
DECIMAL
PRINTL, -1000
-100
-10
OCTAL
PRINTZ, 0 /PRINT WITH LEADING SPACES
DCA PRINT0
TAD PRINTZ
DCA I (PRINT
TAD (240
JMP I (PRINT7
/ZERO A DIRECTORY (PDP-10)
ZERO10, 0 /ZERO THE PDP-10 DIRECTORY
TAD I [MOUTPU
AND [17
SZA CLA
JMP I (NOT10F /NOT A PDP-10
TAD I [MOUTPU
DCA UNIT10 /SET UNIT
TAD (DIRECT-1
DCA INDEX0 /POINT TO DIRECTORY
TAD (-600
DCA CNTR /COUNT OF 600
DCA I INDEX0 /ZERO THE DIRECTORY
ISZ CNTR
JMP .-2 /LOOP
TAD (7570
DCA I (DIRECT /SAVE BLOCKS 1 AND 2
TAD (170
DCA I (DIRECT+52 /SAVE BLOCK 144
TAD (777
DCA I (DIRECT+367 /SAVE BLOCKS 1102 ON UP
CLA CMA
DCA I (DIRECT+370
JMS I (WRITET /WRITE PDP-10 DECTAPE
DIRECT /DIRECTORY
144 /DIRECTORY BLOCK
CDF 10
JMP I ZERO10 /EXIT
/DELETE A PDP-10 FILE
DELE10, 0 /DELETE A PDP-10 FILE
TAD I [MOUTPU
AND [17
SZA
JMP DELOS8 /DELETE A OS8 FILE
TAD I [MOUTPU
DCA UNIT10 /SET UNIT
TAD [MOUTPU
CDF
JMS I (DELETE /DELETE THE PDP-10 FILE
JMP I (ERDELF /NOT THERE
JMS I (WRITET /WRITE PDP-10 DECTAPE
DIRECT
144 /DIRECTORY BLOCK
JMP I DELE10 /EXIT
DELOS8, CIF CDF 10
JMS I (DELPS1 /DELETE A OS8 FILE
JMP I DELE10
JMP I (ERDELF /ERROR DELETING THE FILE
PAGE
/GET THE NEXT INPUT FILE
NEXIFL, 0 /GET THE NEXT INPUT FILE
DCA CHARNI /RESET STUFF
DCA WORDS
CDF 10
CLA CMA
DCA I (INCHCT
DCA I (INEOF
TAD (INDEVH+1
DCA INDEVX
TAD I IXR /GET NEXT
SNA
JMP NEXIF2 /E.O.F
DCA IUNIT
TAD I IXR
DCA IBLOCK /SET START BLOCK
CDF
TAD IUNIT
AND [17
SNA
JMP NEXIF1 /PDP-10 FILE
CIF 10
JMS I [200
1
INDEVX, 0
JMP I (NOOFIL
CDF 10
TAD INDEVX
DCA I (INHNDL
TAD IBLOCK
DCA I (INREC
TAD IUNIT
AND [7760
SZA
TAD [17
CLL CML RTR
RTR
DCA I (INCTR
TAD (ICHRPS
JMP NEXIF3
NEXIF1, TAD IUNIT
DCA UNIT10
TAD IBLOCK
DCA .+3
JMS I (READT
IBUF10
0 /READ ANY BLOCK
CDF 10
TAD I [IBUF10+2
RTL
RTL
RAL
AND [17
DCA IBLOCK
TAD I [IBUF10+1
AND [77
CLL RTL
RTL
TAD IBLOCK
DCA IBLOCK /SET START BLOCK
TAD (ICHR10
NEXIF3, DCA INPUT /SET ROUTINE POINTER
ISZ NEXIFL
NEXIF2, CDF
JMP I NEXIFL /EXIT
ICHRPS, 0
CIF CDF 10
JMS I (ICHARP
SKP
ISZ ICHRPS
JMP I ICHRPS
OCHRPS, 0
CIF 10
JMS I (OCHARP
JMP I (IOERR
JMP I OCHRPS
PAGE
PIP10, CDF 10 /STARTS HERE - JUMPED TO FROM 200
DCA HIDATE /V3C
TAD I (MDATE /GET TODAY'S DATE
CDF
JMS I (CVDATE /CONVERT IT
DCA DATE /AND STORE IT
TAD (3401 /UNRESTARTABLE, DOESN'T DESTROY BATCH OR USR AREA
DCA I (JSBITS
PIPCD, CDF
JMS I (CD /COMMAND DECODE
CDF 10
TAD I (MPARAM
AND (2010
CLL RAL
DCA MODE /SET /I SWITCH
TAD I (MPARAM+1
AND (400
DCA SAVELN /SET /P SWITCH
TAD I (MPARAM
AND (101
SZA CLA
JMP I (LIST10 /EITHER /F OR /L
TAD I [MOUTPU
SZA CLA
JMP PIP001 /IS AN OUTPUT FILE
TAD I (MINPUT
SNA CLA
JMP PIPCD /NO OUTPUT OR INPUT FILES
JMP I (NOOOFL /INPUT, BUT NO OUTPUT
PIP001, CLL CLA CML RTR
AND I (MPARAM+2
SZA CLA
JMS I (ZERO10 /IT IS /Z OPTION
TAD (OUDEVH+1
DCA OUDEVX
TAD I [MOUTPU
AND [17
SZA
JMP PIPB /OUTPUT IS OS8
TAD I [MOUTPU
DCA UNIT10 /SET UNIT
JMS I (READT
DIRECT /GET DIRECTORY INTO CORE
144
PIPA, CDF 10
TAD OUDEVX
DCA I (OUHNDL
TAD I (MPARAM
AND (400
SZA CLA
JMS I (DELE10 /DELETE A PDP-10 FILE FIRST
CDF 10
TAD (MINPUT-1
DCA IXR
TAD I IXR
SNA CLA
JMP PIPCD /NO INPUT
TAD (MINPUT-1
DCA IXR /SET INPUT LIST
TAD I [MOUTPU
AND [17
CDF
SZA CLA
JMP PIPC /OUTPUT IS OS8
JMS I (OOPN10 /OPEN PDP-10 OUTPUT
TAD (OCHR10
PIPD, DCA OUTPUT /SET OUTPUT ROUTINE
PIPE, SZA CLA /IS IT ERROR OR EOF
JMP I (IOERR /ERROR
JMS I (NEXIFL /GET NEXT FILE
JMP PIPF /FINAL EOF
JMS I INPUT /GET INPUT
JMP PIPE /EOF OR ERROR
JMS I OUTPUT /OUTPUT
JMP .-3 /LOOP
PIPC, CIF CDF 10
JMS I (OOPNPS /OPEN OS8 OUTPUT
JMP I (NOOOFL
TAD (OCHRPS
JMP PIPD
PIPB, CDF 0
CIF 10
JMS I [200
1 /GET OS8 OUTPUT HANDLER
OUDEVX, 0
JMP I (NOOFIL
JMP PIPA
PIPF, CDF 10
TAD I [MOUTPU /NOW CLOSE THE OUTPUT FILE
AND [17
CDF
SZA CLA
JMP PIPG
JMS I (CLOS10
JMP PIPCD
PIPG, CIF CDF 10
JMS I (OCLOSE
JMP I (IOERR
JMP PIPCD
PAGE
LIST10, TAD (OUDEVH+1
DCA OUDEVY
TAD (OUDEVH+1
DCA OUDEVZ
TAD (3100 /RESET THINGS
DCA LISTDV+1
TAD I [MOUTPU
SZA
JMP LIST11 /OUTPUT FILE EXISTS
CDF 0
CIF 10
JMS I [200
1
LISTDV, TEXT /TTY/ /LOOKUP THE TTY:
OUDEVY, 0
JMP I (NOOOFL
CDF 10
TAD LISTDV+1
DCA I [MOUTPU /SET TTY: DEVICE NUMBER
TAD I [MOUTPU
LIST11, AND [17
SNA
JMP I (NOTPSF /NOT A OS8 FILE
CDF 0
CIF 10
JMS I [200
1 /LOOKUP DEVICE
OUDEVZ, 0
JMP I (NOOFIL
LIST12, CDF CIF 10
TAD OUDEVZ
DCA I (OUHNDL
JMS I (OOPNPS /OPEN OUTPUT FILE
JMP I (NOOOFL
TAD (OCHRPS
DCA OUTPUT /SET OUTPUT ROUTINE
CDF 10
TAD I (MINPUT
DCA UNIT10
CDF
TAD UNIT10
SNA
JMP I (PIPCD /NO INPUT
AND [17
SZA CLA
JMP I (NOT10F
JMS I (READT /READ THE DIRECTORY
DIRECT
144
TAD (LISTL-1
DCA INDEX0
TAD (-40
DCA CNTR
DCA I INDEX0 /CLEAR THE COUNTS
ISZ CNTR
JMP .-2
TAD (-1101
DCA LIST13
CLA IAC
DCA LIST14
JMS I (FINDSL /FIND ALL SLOTS
LIST14, 0
TAD (LISTL
DCA LIST15
ISZ I LIST15 /COUNT THE NUMBER IN EACH SLOT
ISZ LIST14
ISZ LIST13
JMP LIST14-1
JMS I (CRLF
TAD I (LISTL
JMS I (PRINTZ /PRINT FREE BLOCKS
TAD (LISTM1-1
DCA INDEX0
JMS I (ERROR4 /"FREE BLOCKS"
JMS I (CRLF
TAD (-26
DCA LIST13
TAD (DIRECT+370
DCA INDEX6
TAD (DIRECT+2 /HIGH ORDER BIT (4096'S) OCCURS AT END OF EACH
DCA XDATE /PDP-10 WORD AT BEGIN OF DIRECTORY
/THIS IS END OF EVERY 3RD PDP-8 WORD
LIST17, CDF 10 /MAIN LOOP
TAD I INDEX6
SNA
JMP I (LIST16 /DO NOT PRINT THIS BLANK ENTRY
JMS I (LIST18
TAD I INDEX6
JMS I (LIST18
TAD I INDEX6
JMS I (LIST18
CDF
TAD (".
JMS I OUTPUT
JMP I (LIST22
LIST13, 0
LIST15, 0
PAGE
LIST22, CDF 10
TAD INDEX6
TAD [77
DCA INDEX5
TAD I INDEX5 /GET EXTENSION
JMS LIST18
TAD I INDEX5
AND [7700
JMS LIST18
CLA IAC
AND I (MPARAM
SNA CLA
JMP LIST19 /NO EXTRA IF NOT /L
JMS LIST18
CDF
TAD I (LIST13
TAD (LISTL+27
DCA LIST23
TAD I LIST23 /GET NUMBER OF BLOCKS
JMS I (PRINTZ
JMS LIST18
TAD I XDATE /V3C
RAR /HIGH ORDER BIT OF DATE TO LINK
CLA
TAD I INDEX5
CDF
JMS I (DATE10
LIST19, CDF
JMS CRLF
LIST20, CDF
TAD XDATE /V3C
TAD (3 /POINT TO NEXT DATE H.O. BIT
DCA XDATE
ISZ I (LIST13
JMP I (LIST17 /LOOP
JMS CRLF
JMP I (PIPG /CLOSE THE FILE
LIST16, ISZ INDEX6
ISZ INDEX6
JMP LIST20
CRLF, 0
TAD [215
JMS I OUTPUT
TAD [212
JMS I OUTPUT
JMP I CRLF
LIST23, 0
LIST18, 0
CDF
DCA TEMP1
TAD TEMP1
RTR
RTR
RTR
JMS LIST21
TAD TEMP1
JMS LIST21
CDF 10
JMP I LIST18
LIST21, 0
AND [77
TAD [240
JMS I OUTPUT
JMP I LIST21
/FIND A PDP-10 ENTRY IN DIRECTORY
/
/CALL:
/ (AC) /POINT TO NAME-1 (FIELD 1)
/ JMS FIND /FIND A PDP-10 ENTRY
/ -NO- /NOT FOUND
/ (AC) /SLOT NUMBER IF FOUND
FIND, 0 /FIND A PDP-10 FILE
DCA FIND4 /SAVE POINTER
TAD (DIRECT+370
DCA INDEX0 /POINT TO DIRECTORY START
TAD (-26
DCA CNTR /22 DECIMAL FILES
CDF 10 /DIRECTORY IS IN FIELD 1
FIND2, TAD FIND4 /GET POINTER
DCA INDEX2 /POINT TO NAME,EXT
TAD I INDEX0
CIA
TAD I INDEX2 /CHECK WORD 1
SZA CLA
JMP FIND1 /NO
TAD I INDEX0
CIA
TAD I INDEX2 /CHECK WORD 2
SZA CLA
JMP FIND1+1 /NO
TAD I INDEX0
CIA
TAD I INDEX2 /CHECK WORD 3
SZA CLA
JMP FIND1+2 /NO
TAD INDEX0
TAD [77
DCA INDEX1 /POINT TO EXTENSIONS
TAD I INDEX1
CIA
TAD I INDEX2 /CHECK WORD 4
SZA CLA
JMP FIND1+2 /NO
TAD I INDEX1
AND [7700
CIA
TAD I INDEX2 /CHECK WORD 5
SZA CLA
JMP FIND1+2 /NO
CLL CLA CMA RTL
TAD INDEX0
DCA INDEX0 /POINT TO ENTRY AGAIN
TAD CNTR
TAD (27
ISZ FIND /WE FOUND IT - 2ND EXIT
FIND3, CDF /BACK TO FIELD 0
JMP I FIND /EXIT
FIND1, ISZ INDEX0 /EXTRA POINTER BUMPS
ISZ INDEX0
ISZ CNTR /MORE FILES?
JMP FIND2 /YES - LOOP
JMP FIND3 /NO - NOT FOUND
FIND4, 0 /POINTER TO NAME-1
PAGE
LINBUF=.
LISTL, ZBLOCK 105
LISTM1, TEXT / FREE BLOCKS PIP10 V/
VERLOC, *.-1
60+VERSION^100+SUBVER
3700
ERMES0, TEXT /_PIP10 CANNOT BE CHAINED TO_/
ERMES1, TEXT #_I/O ERROR_#
ERMES2, TEXT /_DEVICE FULL_/
ERMES3, TEXT /_NO SUCH DEVICE_/
ERMES4, TEXT /_NOT PDP-10 FILE_/
ERMES5, TEXT /_ERROR DELETING FILE_/
ERMES6, TEXT /_NOT OS8 FILE_/
ERMES7, TEXT /_OUTPUT FILE OPEN ERROR_/
ERMES8, TEXT /_SYNTAX ERROR_/
ERMES9, TEXT /_FILE NOT FOUND_/
/ROUTINE TO SET TD8E UNIT INFORMATION FROM UNIT10
TDUSET, 0
TAD UNIT10
CLL RTL
RAL
AND (7
TAD (DVCTBL
DCA DVCPTR
RAR
DCA TDUNIT /SAVE EVEN/ODD BIT
TAD (TDUTBL
DCA TDUPTR
TDULP, TAD I TDUPTR
SNA
JMP I TDUSET
DCA TDUT
TAD I TDUT
AND (7
TAD I DVCPTR
DCA I TDUT
ISZ TDUPTR
JMP TDULP
TDUPTR, 0
TDUT, 0
DVCPTR, 0
DVCTBL, 6770;6760;6750;6740
TDUTBL, DIO01
DIO02
DIO03
DIO04
DIO05
DIO06
DIO07
DIO08
DIO09
DIO10
DIO11
DIO12
DIO13
DIO14
DIO15
DIO16
DIO17
DIO18
DIO19
DIO20
DIO21
DIO22
IOTX1
IOTX2
IOTX3
IOTX4
IOTX5
IOTX6
IOTX7
IOTX8
0
PAGE
/GET A CHARACTER
GCH, 0
TAD I IXR /GET A CHAR
TAD (-240
SNA
JMP GCH+1 /IGNORE SPACES
TAD (240-"/
SNA
JMP SLASH
TAD ("/-"(
SNA
JMP OPENP
TAD ("(
JMP I GCH /EXIT
SLASH, TAD I IXR
JMS SLSHCH /GET OPTION
JMP GCH+1
OPENP, TAD I IXR
TAD (-")
SNA
JMP GCH+1 /END
TAD (")
JMS SLSHCH /GET OPTION
JMP OPENP
SLSHCH, 0
SNA
JMP I (SYNTAX /ERROR
DCA TEMP6
TAD (MPARAM-1
DCA TEMP5 /POINT TO PARAMETERS
JMS DECODE
JMP I (SYNTAX
SZL
TAD (32 /ADD
TAD (-14
ISZ TEMP5
SMA
JMP .-3 /FIND DIVIDED BY 12
DCA TEMP4
CLL CML
RAL
ISZ TEMP4
JMP .-2 /SHIFT A BIT
DCA TEMP4 /SAVE IT
CDF 10
TAD TEMP4
CMA
AND I TEMP5
TAD TEMP4 /OR IN THAT BIT
DCA I TEMP5
CDF
JMP I SLSHCH
DECODE, 0
TAD TEMP6
TAD (-"9-1
CLL
TAD ("9+1-"0
SZL
JMP DECOD1
TAD ("0-"Z-1
CLL CML
TAD ("Z-"A+1
SNL
DECOD1, ISZ DECODE
JMP I DECODE
EXA40, 0
TAD (CDNAME
DCA TEMP5
TAD (-5
DCA TEMP4
EXA401, CLL CLA CML RAR
TAD I TEMP5
AND [7700
CLL RAL
SZA
RAR
DCA TEMP3
TAD I TEMP5
TAD (40
AND [77
TAD (-40
SZA
TAD (40
TAD TEMP3
DCA I TEMP5
ISZ TEMP5
ISZ TEMP4
JMP EXA401
JMP I EXA40
PAGE
/GET A NAME ROUTINE
GNAME, 0
DCA CDDEV /CLEAR AREA
DCA CDDEV+1
CLA CMA
DCA DEVSW /ALLOW DEVICES
GNAME1, DCA CDNAME /CLEAR NAME,EXTENSION
DCA CDNAME+1
DCA CDNAME+2
DCA CDEXT
DCA CDEXT+1
CLA CMA
DCA PERSW /ALLOW EXTENSIONS
TAD (CDNAME
DCA POINT /SET POINTER
DCA CNTR /SET SWITCH
GNAME2, JMS I (GCH /GET A CHAR
DCA TEMP6
TAD TEMP6
SNA
JMP GNAME6 /END
TAD (-":
SNA
JMP GNAME5 /: IS DEVICE
TAD (":-".
SNA
JMP GNAME4 /. IS EXTENSION
TAD (".
DCA TEMP6 /SAVE THE CHAR
JMS I (DECODE
JMP GNAME6-1 /NOT 0-9 OR A-Z IS END
CLA
TAD TEMP6
AND [77 /GET TRIMMED ASCII
ISZ CNTR
JMP GNAME3 /LEFT HALF
TAD I POINT
DCA I POINT /SET RIGHT HALF
ISZ POINT
JMP GNAME2 /LOOP
GNAME3, CLL RTL
RTL
RTL
DCA I POINT /SET LEFT HALF
CLA CMA
DCA CNTR
TAD POINT
TAD (-CDEXT-2
SZA CLA
JMP GNAME2 /LOOP
JMP GNAME2-1 /LOOP - IGNORE
GNAME4, TAD CDNAME
SZA CLA
ISZ PERSW
JMP I (SYNTAX /ERROR
DCA CDEXT
DCA CDEXT+1 /CLEAR EXTENSION
TAD (CDEXT
JMP GNAME2-2 /GET EXTENSION
GNAME5, ISZ DEVSW
JMP I (SYNTAX /ERROR
ISZ PERSW
JMP I (SYNTAX /ERROR
TAD CDNAME
SNA
JMP I (SYNTAX /ERROR
DCA CDDEV
TAD CDNAME+1
DCA CDDEV+1 /SET DEVICE
JMP GNAME1 /NOW GET THE NAME
CLA
GNAME6, DCA CDEXT+2
TAD CDEXT+1
AND [7700
DCA CDEXT+1
ISZ PERSW
JMP I GNAME /EXIT
DCA CDEXT
DCA CDEXT+1 /CLEAR EXTENSION
JMP I GNAME /EXIT
PAGE
CD, 0
TAD [MOUTPU-1
DCA INDEX0
TAD (-47
DCA CNTR
CDF 10
DCA I INDEX0 /CLEAR AREAS
ISZ CNTR
JMP .-2
CDF
CIF 10
JMS I [200
13 /RESET TABLES
0
DCA INSEG /NO DIRECTORY IN CORE
DCA PDP10D /NO KNOWN PDP-10 DRIVES
DCA PDP10D+1
DCA PDP10D+2
DCA PDP10D+3
DCA PDP10D+4
DCA PDP10D+5
DCA PDP10D+6
DCA PDP10D+7
DCA CDCNT /ZERO INPUT COUNT
JMS I (GLINE /GET A LINE
TAD [LINBUF-1
DCA IXR
TAD I IXR
SNA
JMP NOBAKB /NO "<" IS LINE
TAD (-"<
SZA CLA
JMP .-5
TAD [LINBUF-1
DCA IXR
TAD XDSK
DCA CDDEVF /SET "DSK" AS DEFAULT
TAD XDSK+1
DCA CDDEVF+1
JMS I (GNAME /GET THE NAME
TAD TEMP6
TAD (-"[
SZA CLA
JMP CDX03 /NO SIZE SPECIFIED
CDX01, JMS I (GCH
TAD (-"]
SNA
JMP CDX02 /END OF SIZE
TAD ("]-"0
SPA
JMP I (SYNTAX /ERROR
DCA TEMP1
TAD CDEXT+2
CLL RTL
TAD CDEXT+2
RAL
TAD TEMP1
DCA CDEXT+2 /ADD IN NUMBER
TAD TEMP1
TAD (-11
SMA SZA CLA
JMP I (SYNTAX /ERROR
JMP CDX01
CDX02, JMS I (GCH
SKP
CDX03, TAD TEMP6
TAD (-"<
SZA CLA
JMP I (SYNTAX /ERROR
JMS I (CDOUTX /SET OUTPUT STUFF
NOBAKA, TAD (MINPUT-1
DCA INDEX6
TAD XDSK
DCA CDDEVF /SET DEFAULT
TAD XDSK+1
DCA CDDEVF+1
TAD IXR
DCA CDI04 /SAVE POINTER
JMS I (GCH
SNA CLA
JMP I CD /NO INPUT FILES
TAD CDI04
DCA IXR /RESET POINTER
CDI01, JMS I (GNAME /GET A FILE
ISZ DEVSW
JMP CDI02 /DEVICE SPECIFIED
TAD CDDEVF
DCA CDDEV
TAD CDDEVF+1
DCA CDDEV+1 /SET DEFAULT DEVICE
CDI02, TAD CDDEV
DCA CDDEVF
TAD CDDEV+1
DCA CDDEVF+1 /SET NEW DEFAULT
ISZ CDCNT /COUNT INPUT FILES
TAD CDCNT
TAD (-12
SMA CLA
JMP I (SYNTAX /TOO MANY FILES
JMS I (CDINX /SET INPUT STUFF
TAD TEMP6
SNA
JMP I CD /MAIN EXIT
TAD (-",
SNA CLA
JMP CDI01
JMP I (SYNTAX /ERROR
NOBAKB, TAD [LINBUF-1
DCA IXR
JMP NOBAKA
PAGE
CDOUTX, 0 /SET OUTPUT STUFF
ISZ DEVSW
JMP CDOUT9 /DEVICE SPECIFIED
TAD CDNAME
SNA CLA
JMP I CDOUTX /NO NAME AND NO DEVICE IS NOTHING
TAD CDDEVF
DCA CDDEV
TAD CDDEVF+1
DCA CDDEV+1 /SET DEFAULT DEVICE
CDOUT9, TAD (OUDEVH+1
DCA CDOUT2 /SET OUTPUT HANDLER ADDRESS
TAD [MOUTPU-1
DCA INDEX6
TAD CDDEV
DCA CDOUT1
TAD CDDEV+1
DCA CDOUT1+1 /SET DEVICE
CIF 10
JMS I [200
12 /FIND HANDLER
CDOUT1, 0
0
CDOUT2, 0
JMP I (NOOFIL
TAD CDOUT1+1
JMS I (GTDVTP /GET DEVICE TYPE AND COMPARE WITH TC08 AND TD8E
SZA CLA
JMP CDOUT3 /NOT DECTAPE
TAD (OUDEVH+1
DCA CDOUT5
TAD CDOUT1+1
CIF 10
JMS I [200
1 /GET HANDLER
CDOUT5, 0
JMP I (NOOFIL
TAD CDOUT5
JMS SETUNT /SET UP PHYSICAL UNIT FROM HANDLER ENTRY POINT
JMS I (ROCK /CHECK THE TAPE
JMP CDOUT3 /NOT PDP-10 DECTAPE
JMS I (EXA40 /EXCESS 40 CONVERSION
TAD UNIT10
JMP CDOUT4 /SET PARAMETERS
CDOUT3, DCA CDEXT+1
TAD CDEXT+2 /GET LENGTH
TAD (-400
SPA CLA
TAD CDEXT+2 /O.K. - USE LENGTH
CLL RTL
RTL
AND [7760 /8 BIT LENGTH
TAD CDOUT1+1 /ADD IN DEVICE NUMBER
CDOUT4, CDF 10
DCA I INDEX6 /SET DEVICE
TAD CDNAME
DCA I INDEX6 /SET NAME
TAD CDNAME+1
DCA I INDEX6
TAD CDNAME+2
DCA I INDEX6
TAD CDEXT
DCA I INDEX6
TAD CDEXT+1
DCA I INDEX6
CDF
JMP I CDOUTX /EXIT
SETUNT, 0
STL
TAD (-7607
SZA /IF IT IS 7607,
TAD (7 /ITS UNIT 0
AND (7
CLL CML RTR
RTR
DCA UNIT10
TAD DVTYPE
AND (10
SNA CLA
JMP I SETUNT /TC08 - FINISHED
CLL
TAD UNIT10
AND (7000 /TD8E ENTRY POINTS ARE STRANGE -
TAD UNIT10 /MUST ROTATE UNIT NUMBER LEFT 1
SZL
TAD (1000
DCA UNIT10
JMS I (TDUSET /SET UP TD8E OPCODES
JMP I SETUNT
PAGE
CDINX, 0 /SET INPUT STUFF
TAD (OUDEVH+1
DCA CDIN1
TAD CDDEV
DCA CDIN2 /SET DEVICE
TAD CDDEV+1
DCA CDIN2+1
CIF 10
JMS I [200
1 /GET HANDLER
CDIN2, 0
0
CDIN1, 0
JMP I (NOOFIL
TAD CDIN2+1
JMS GTDVTP /COMPARE DCB ENTRY WITH TC08 OR TD8E
SZA CLA
JMP CDIN3 /NOT DECTAPE
TAD CDIN1
JMS I (SETUNT /SET UP UNIT NUMBER
JMS I (ROCK /CHECK THE TAPE
JMP CDIN3 /NOT PDP-10 DECTAPE
JMS I (EXA40 /DO EXCESS 40
TAD INSEG
CIA
TAD UNIT10 /IS DIRECTORY IN CORE?
SNA CLA
JMP CDIN8 /YES - NO READ
TAD CDNAME
SNA CLA
JMP CDIN7 /NO NAME - NO READ
JMS I (READT
DIRECT /READ DIRECTORY
144
TAD UNIT10
DCA INSEG /SET DIRECTORY IN CORE
CDIN8, TAD (-5
DCA CNTR
TAD (CDNAME-1
DCA INDEX0
TAD (CDINXX-1
DCA INDEX1
TAD I INDEX0
CDF 10
DCA I INDEX1
CDF
ISZ CNTR
JMP .-5
TAD (CDINXX-1
JMS I (IOPN10 /OPEN THE PDP-10 FILE
JMP I (FNOTFD
CDIN7, DCA CDIN4
TAD UNIT10
JMP CDIN6
CDIN3, TAD (CDNAME
DCA CDIN4
TAD CDNAME
SNA CLA
JMP CDIN9 /NO LOOKUP IF NO NAME
TAD CDIN2+1
CIF 10
JMS I [200
2
CDIN4, CDNAME /LOOKUP
CDIN5, 0
JMP I (FNOTFD
TAD CDIN5
TAD (400
SPA
CLA
CLL RTL
RTL
AND [7760 /GET LENGTH
TAD CDIN2+1 /ADD DEVICE
CDIN6, CDF 10
DCA I INDEX6
TAD CDIN4
DCA I INDEX6 /SET BLOCK STARTING
CDF
JMP I CDINX
CDIN9, DCA CDIN4
JMP CDIN6-1
GTDVTP, 0
TAD (DCB-1
DCA TEMP1
CDF 10
TAD I TEMP1 /GET DCB ENTRY
CDF
DCA DVTYPE
TAD DVTYPE
AND (770
TAD (-210
SZA
TAD (30
JMP I GTDVTP
PAGE
ROCK, 0
JMS GET10D /GET ENTRY IN TAPE TYPE TABLE
SNA
JMP ROCK4 /UNKNOWN - ROCK IT
SMA CLA
ISZ ROCK
JMP I ROCK /EXIT
GET10D, 0
TAD UNIT10
CLL RTL
RTL
TAD (PDP10D
DCA TEMP5 /POINT TO KNOWN TABLE
TAD I TEMP5
JMP I GET10D
ROCK4, CLA CMA
DCA I TEMP5
TAD DVTYPE
AND (10
SZA CLA /WHAT KIND OF TAPE?
JMP TDCHK /TD8E
TAD (OBUF10-1
DCA I (7755
TAD (10
DTLB
ROCK1, RTL
RAL
SZL CLA
TAD (-400
TAD UNIT10
TAD (210
DTCA DTXA
ROCK2, JMS DTWAIT
ROCK3, SPA
JMP ROCK1
CLA
TAD (OBUF10-1
DCA I (7755
TAD (-600
DCA I (7754
TAD (30
DTXA
DTSF DTRB
JMP .-1
SPA CLA
JMP ROCK4 /RETRY
TAD [200
DTXA /STOP DRIVE
TAD I (7754
SZA CLA
JMP I ROCK /OS8 UNIT
CLA IAC
SET10, DCA I TEMP5
ISZ ROCK
JMP I ROCK /PDP-10 UNIT
DTWAIT, 0 /WAIT FOR DECTAPE FLAG
DTSF DTRB
SKP CLA
JMP I DTWAIT
KSF
JMP DTWAIT+1
TAD [200
KRS
TAD (-203
SZA CLA
JMP DTWAIT+1
TAD [200
DTXA /STOP THE TAPE
JMP I [7600
TDCHK, CLA STL RTR
TAD TDUNIT
IOTX1, SDLC
CLA
IOTX2, SDRC
AND (100 /CHECK FOR TAPE NOT READY
SZA CLA
JMP TDCHK /WAIT FOR TAPE TO COME UP
TAD TDUNIT
TAD (1000
IOTX3, SDLC
JMS SKIP4
JMS SKIP4
IOTX4, SDSS
JMP .-1
IOTX5, SDRC
AND [77
TAD (-26
SZA CLA /WAIT FOR GUARD
JMP IOTX4
DCA TDT
TDCLP, JMS SKIP4
ISZ TDT
AND [77
TAD (-51 /SEARCH FOR SOME CRAP NEAR END OF RECORD
SZA CLA
JMP TDCLP
TAD I (UNIT
IOTX6, SDLC /STOP TAPE
CLA
TAD TDT
TAD (-611 /9 WORDS FOR GOOD LUCK
SZA CLA
JMP I ROCK
STL RTL /SET TABLE ENTRY TO 2 FOR TD8E TAPE
JMP SET10
SKIP4, 0
IOTX7, SDSQ
JMP .-1
IOTX8, SDRC
JMP I SKIP4
TDT, 0
PAGE
FIELD 0 /DUMP PG 0 LITERALS HERE
/TD8E DECTAPE ROUTINE
/VERSION 01
/JULY 2 1971 GB/RL/EF
/COPYRIGHT 1971 DIGITAL EQUIPMENT CORP.
/ MAYNARD, MASS.
/ABSTRACT--
/ THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
/WHICH IS COMPATIBLE WITH PS/8 DEVICE HANDLER CALLING
/SEQUENCES.
/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
/CONTROL:
/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
/B) THE ORIGIN OF THE TWO PAGE ROUTINE
/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
/DEC VERSION OF THIS ROUTINE:
DRIVE=10 /UNITS 0 AND 1 SELECTED
ORIGIN=6200 /ENTRIES AT 6200 AND 6204
AFIELD=0 /INITIAL FIELD SETTING
MFIELD=00 /AFIELD*10=MFIELD
WDSBLK=600 /384 WORDS PER BLOCK
/THE USE OF THE PARAMETERS IS AS FOLLOWS:
/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
/ DRIVE=10 IMPLIES UNITS 0 &1
/ DRIVE=20 IMPLIES UNITS 2&3
/ DRIVE=30 IMPLIES UNITS 4&5
/ DRIVE=40 IMPLIES UNITS 6&7
/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
/ MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
/THAT THIS IS A TWO PAGE ROUTINE.
/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
/ LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
/ THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
/ THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE
/ IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
/ 128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
/ BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
/ FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
/ FORMATTED TO CONTAIN.
/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
/PER BLOCK, THE PARAMETERS WOULD BE:
/ DRIVE=20
/ ORIGIN=3000
/ AFIELD=2
/ MFIELD=20
/ WDSBLK=400
/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
/CALLING SEQUENCE FOR PS/8 DEVICE HANDLERS.
/THE CALLING SEQUENCE IS:
/ CDF CURRENT
/ CIF MFIELD /MFIELD=FIELD ASSEMBLED IN
/ JMS ENTRY /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
/AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
/ ARG1
/ ARG2
/ ARG3
/ ERROR RETURN
/ NORMAL RETURN
/THE ARGUMENTS ARE:
/ARG1: FUNCTION WORD BIT0: 0=READ, 1=WRITE
/ BITS 1-5: # BLOCKS IN OPERATION
/ BITS 6-8: FIELD OF BUFFER AREA
/ BIT 9: UNUSED
/ BIT 10: # OF WORDS/BLOCK.
/ 0= WDSBLK, 1=WDSBLK-1
/ BIT 11: 1=START FORWARD, 0=REVERSE
/ARG2: BUFFER ADDRESS FOR OPERATION
/ARG3: STARTING BLOCK FOR OPERATION
/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
/ TOO GREAT A BLOCK NUMBER
/ FATAL ERRORS TAKE ERROR RETURN WITH THE
/ AC=4000.
/B) NON-FATAL- SELECT ERROR.
/ IF NO PROPER UNIT IS SELECTED, THE ERROR
/ RETURN IS TAKEN WITH CLEAR AC.
/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
/THE TD8E IOT'S ARE:
SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
SDST=7002-DRIVE /SKIP ON TIMING ERROR
SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
SDLC=7004-DRIVE /LOAD COMMAND REGISTER
SDLD=7005-DRIVE /LOAD DATA REGISTER
SDRC=7006-DRIVE /READ COMMAND REGISTER
SDRD=7007-DRIVE /READ DATA REGISTER
/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
/THE OTHERS CONTROL UNITS 2-7.
BLOCK=DTA1
FIELD AFIELD
*ORIGIN
DTA0, 0 /ENTRY POINT FROM UNIT 0
CLA CLL /0 TO LINK
JMP DTA1X
C1000, 1000
DTA1, 0 /UNIT 2 ENTRY
CLA CLL CML /1 TO LINK
TAD DTA1
DCA DTA0 /PICK UP ARGS AT DTA0
DTA1X, RAR
DCA UNIT /LINK TO UNIT POSITION
RDF
TAD C6203 /GET DATA FIELD AND SETUP RETURN
DCA LEAVE
TAD I DTA0 /GET FUNCTION WORD
DIO01, SDLD /PUT FUNCTION INTO DATA REGISTER
CLL RTR /AC STILL HAS FUNCTION. PUT # WORDS PER
/BLOCK INTO LINK
SZL CLA /KNOCK ONE OFF WDSBLK?
IAC /YES
TAD MWORDS
DCA WCOUNT /STORE MASTER WORD COUNT
ISZ DTA0 /TO BUFFER
TAD I DTA0
DCA BUFF
ISZ DTA0 /TO BLOCK NUMBER
TAD I DTA0
DCA BLOCK
ISZ DTA0 /POINT TO ERROR EXIT
CIF CDF MFIELD /TO ROUTINES DATA FIELD
DIO02, SDRD /GET FUNCTION INTO AC
CLL RAL
AND CM200 /GET # PAGES TO XFER
DCA PGCT
DIO03, SDRD
C374, AND C70 /GET FIELD FOR XFER
TAD C6203 /FORM CDF N
DCA XFIELD /IF=0 AND DF=N AT XFER.
CLA CLL CMA RTL
DCA TRYCNT /3 ERROR TRIES
TAD UNIT /TEST FOR SELECT ERROR
DIO04, SDLC
DIO05, SDRC
AND C100
SZA CLA
JMP FATAL-1
DIO06, SDRD /PUT FUNCT INTO XFUNCT IN SECOND PG.
DCA I CXFUN
TAD WCOUNT
DCA I CXWCT
DIO07, SDRD /GET MOTION BIT TO LINK
CLL RAR
JMP GO /AND START THE MOTION.
DIO08,
RWCOM, SDST /ANY CHECKSUM ERRORS?
SZA CLA /OR CHECKSUM ERRORS?
JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS
/SET AT RWCOM. GETCHK SETS IT.
TAD PGCT /NO ERROR..FINISHED XFER?
TAD CM200
SNA
JMP EXIT /ALL DONE. GET OUT
DCA PGCT /NEW PAGE COUNT
ISZ BLOCK /NEXT BLOCK TO XFER
TAD WCOUNT /FORM NEXT BUFFER ADDRESS
CIA
TAD BUFF
DCA BUFF
CLL CML /FORCES MOTION FORWARD
GO, CLA CML RTR /LINK BECOMES MOTION BIT
TAD C1000
TAD UNIT /PUT IN 'GO' AND UNIT #
DIO09, SDLC /LOOK FOR BLOCK NO.
JMS I CRDQUD /WAIT AT LEAST 6 LINES TO LOOK
JMS I CRDQUD
CM200, 7600 /COULD HAVE SAVED A LOC. HERE
DIO10,
SRCH, SDSS
JMP .-1 /WAIT FOR SINGLE LINE FLAG
DIO11, SDRC
CLL RTL /DIRECTION TO LINK. INFO BITS
/ARE SHIFTED.
AND C374 /ISOLATE MARK TRACK BITS
TAD M110 /IS IT END ZONE?
SNA /THE LINK STAYS SAME THRU THIS
JMP ENDZ
TAD M20 /CHECK FOR BLOCK MARK
SZA CLA
JMP SRCH
DIO12, SDRD /GET THE BLOCK NUMBER
SZL /IF WE ARE IN REVERSE, LOOK FOR 3
/BLOCKS BEFORE TARGET BLOCK. THIS
/ALLOWS TURNAROUND AND UP TO SPEED.
TAD C3 /REVERSE
CMA
TAD BLOCK
CMA /IS IT RIGHT BLOCK?
SNA
JMP FOUND /YES..HOORAY!
M110, SZL SNA CLA /NO, BUT ARE WE HEADED FOR IT?
/ABOVE SNA IS SUPERFLUOUS.
JMP SRCH /YES
DIO13,
ENDZ, SDRC /WE ARE IN THE END ZONE
CLL RTL /DIRECTION TO LINK
/V3C SZL CLA /ARE WE IN REVERSE?
JMP GO /YES..TURN US AROUND
/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
TRY3, CLA CLL /V3C
ISZ TRYCNT
JMP GO /TRY 3 TIMES
JMP FATAL /LINK OFF MEANS AC=4000 ON RETURN
EXIT, ISZ DTA0
CLL CML /AC=0 ON NORMAL RETURN
FATAL, TAD UNIT
DIO14, SDLC /STOP THE UNIT
CLA CML RAR
LEAVE, HLT
JMP I DTA0
C6203, 6203
CRDQUD, RDQUAD
WCOUNT, 0
BUFF, 0
MWORDS, -WDSBLK
UNIT, 0
CXFUN, XFUNCT
M20, -20
PGCT, 0
CXWCT, XWCT
C100, 100
TRYCNT, -3
*ORIGIN+170
FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION?
JMP GO /WRONG..TURN AROUND
TAD UNIT /PUT UNIT INTO LINK
CLL RAL /AC IS NOW 0
C70, 70 /********DON'T MOVE THIS!!!!******
C3, 3
TAD BUFF /GET BUFFER ADDRESS
XFIELD, HLT /INTO NEXT PAGE
*ORIGIN+200
CIF MFIELD
DCA XBUFF /SAVE ADDRESS
RAR /NOW GET UNIT #
DCA XUNIT
SDRC /V3C
SDLC /V3C
TAD XWCT
DCA DWORDS /WORD COUNTER
DIO15,
REVGRD, SDSS
JMP .-1 /LOOK FOR REVERSE GUARD
DIO16, SDRC
AND K77
TAD CM32 /IS IT REVERSE GUARD?
SZA CLA
JMP REVGRD /NO.KEEP LOOKING
TAD XFUNCT /GET FUNCTION READ OR WRITE
K7700, SMA CLA
JMP READ /NEG. IS WRITE
DIO17,
WRITE, SDRC
AND C300 /CHECK FOR WRITE LOCK AND SELECT ERROR
CLL CML /LOCK OUT AND SELECT ARE AC 0 ERRORS
SZA CLA
JMP I CFATAL /FATAL ERROR. LINK MUST BE ON
/ JMS RDQUAD /NO ONE EVER USES THIS WORD!
/ CLA
STA /V3C HACK FOR PDP-6
JMS WRQUAD /V3C 7777 FOR REV CHECKSUM AND SKIP OVER LOCK
TAD C1400
TAD XUNIT /INITIATE WRITE MODE
DIO18, SDLC
CLA CMA
JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM
CLA CMA
DCA CHKSUM
WRLP, TAD I XBUFF /GLORY BE! THE ACTUAL WRITE!
JMS WRQUAD
ISZ XBUFF /BUMP CORE POINTER
K77, 77 /ABOVE MAY SKIP
ISZ DWORDS /DONE THIS BLOCK?
JMP WRLP /NOT YET..LOOP A WHILE
TAD XFUNCT /IS THE OPERATION FOR WDSBLK PER BLOCK?
CLL RTR /IF NO, WRITE A 0 WORD
SZL CLA
JMS WRQUAD /WRITE A WORD OF 0
JMS GETCHK /DO THE CHECK SUM
JMS WRQUAD /WRITE FORWARD CHECKSUM
JMS WRQUAD /ALLOW CHECKSUM TO BE WRITTEN
JMS WRQUAD /V3C WRITE REST OF CHECKSUM [PDP-6]
JMP I CRWCOM
READ, JMS RDQUAD
JMS RDQUAD
JMS RDQUAD /SKIP CONTROL WORDS
AND K77
TAD K7700 /TACK 7700 ONTO CHECKSUM.
DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY
RDLP, JMS RDQUAD
JMS EQUFUN /COMPUT CHECKSUM AS WE GO
DCA I XBUFF /IT GETS CONDENSED LATER
ISZ XBUFF
C300, 300 /PROTECTION
ISZ DWORDS /DONE THIS OP?
JMP RDLP /NO SUCH LUCK
TAD XFUNCT /IF OP WAS FOR WDSBLK-1, READ AND
CLL RTR /CHECKSUM THE LAST TAPE WORD
SNL CLA
JMP RDLP2
JMS RDQUAD /NOT NEEDED FOR WDSBLK/BLOCK
JMS EQUFUN /CHECKSUM IT
RDLP2, JMS RDQUAD /READ CHECKSUM
AND K7700
JMS EQUFUN
JMS GETCHK /GET SIX BIT CHECKSUM
JMP I CRWCOM
WRQUAD, 0 /WRITE OUT A 12 BIT WORD
JMS EQUFUN /ADD THIS TO CHECKSUM
DIO19, SDSQ /SKIP ON QUADLINE FLAG
JMP .-1
DIO20, SDLD /LOAD DATA ONTO BUS
CLA /SDLD DOESN'T CLEAR AC
JMP I WRQUAD
RDQUAD, 0 /READ A 12 BIT WORD
DIO21, SDSQ
JMP .-1
DIO22, SDRD /READ DATA
JMP I RDQUAD
EQUFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
CMA
DCA EQUTMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
TAD EQUTMP /EQUIVALENCE OF ALL WORDS IN A RECORD
AND CHKSUM /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
CIA /IS ASSOCIATIVE, WE CAN DO IT 12
CLL RAL /BITS AT A TIME AND CONDENSE LATER.
TAD EQUTMP /THIS ROUTINE USES THESE IDENTITIES:
TAD CHKSUM /A+B=(A.XOR.B)+2*(A.AND.B)
DCA CHKSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
TAD EQUTMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
CMA
JMP I EQUFUN
GETCHK, 0 /FORM 6 BIT CHECKSUM
CLA
TAD CHKSUM
CMA
CLL RTL
RTL
RTL
JMS EQUFUN
CLA CLL CML /FORCES LINK ON AT RWCOM
TAD CHKSUM
AND K7700
JMP I GETCHK
CFATAL, FATAL
CRWCOM, RWCOM
XFUNCT, 0
CM32, -32
C1400, 1400
CHKSUM, 0
DWORDS, 0
XBUFF, 0
XWCT, 0
EQUTMP, 0
XUNIT, 0
PAGE
FIELD 1
*2000
ZFREE, ZBLOCK 5
INCTR, 0
INHNDL, 0
INPTR, 0
DELPS1, 0
JMS I (200
4
MOUTPU+1
0
ISZ DELPS1
CIF CDF 0
JMP I DELPS1
ICHARP, 0
ISZ INJMP
ISZ INCHCT
INJMPP, JMP INJMP
TAD INEOF
SZA CLA
JMP INEXIT
INGBUF, TAD INCTR
CLL
TAD (INRECS
SNL
DCA INCTR
SZL
ISZ INEOF
CLL CML CMA RTR
RTR
RTR
TAD (INCTL+1
DCA INCTLW
CIF 0
JMS I INHNDL
INCTLW, 0
INBUFP, INBUF
INREC, 0
JMP INERRX
INBREC, TAD INREC
TAD (INRECS
DCA INREC
TAD INCTLW
AND (7600
CLL RAL
TAD INCTLW
AND (7600
CMA
DCA INCHCT
TAD INJMPP
DCA INJMP
TAD INBUFP
DCA INPTR
JMP ICHARP+1
INERRX, ISZ INEOF
SMA CLA
JMP INBREC
INERR, CLL CLA CML RAR
JMP INEXIT
INJMP, HLT
JMP INCHR1
JMP INCHR2
INCHR3, TAD INJMPP
DCA INJMP
TAD I INPTR
AND (7400
CLL RTR
RTR
TAD INCTLW
RTR
RTR
ISZ INPTR
JMP INCOMN
INCHR2, CDF 0
TAD I (MODE
CDF 10
SMA SZA CLA
JMP IC8A1
TAD I INPTR
AND (7400
DCA INCTLW
ISZ INPTR
IC8A2, TAD I INPTR
INCOMN, AND (377
TAD (-232
SNA
JMP INEXIT
TAD (232
ISZ ICHARP
INEXIT, CIF CDF 0
JMP I ICHARP
INEOF, 1
INCHCT, -1
INCHR1, CDF 0
TAD I (MODE
CDF 10
SPA SNA CLA
JMP IC8A2
IC8A3, TAD I INPTR
ISZ INPTR
JMP INEXIT-1
IC8A1, TAD INJMPP
DCA INJMP
ISZ INCHCT
JMP IC8A3
PAGE
OOPNPS, 0
TAD (MOUTPU+1
DCA OUBLK
TAD I (MOUTPU
JMS I (200
3
OUBLK, 0
OUELEN, 0
JMP OUEFAL
DCA OUCCNT
JMS I (OUSETP
ISZ OOPNPS
OUEEXT, CIF CDF 0
JMP I OOPNPS
OUEFAL, TAD I (MOUTPU
AND (7760
SNA CLA
JMP OUEEXT
TAD I (MOUTPU
AND (17
DCA I (MOUTPU
JMP OOPNPS+1
OUHNDL, 0
OUTDMP, 0
DCA OUCTLW
TAD OUCCNT
SNA
ISZ OUCTLW
TAD OUBLK
DCA OUREC
TAD OUCTLW
CLL RTL
RTL
RTL
AND (17
TAD OUCCNT
DCA OUCCNT
TAD OUCCNT
CLL CML
TAD OUELEN
SNL SZA CLA
JMP I OUTDMP
CIF 0
JMS I OUHNDL
OUCTLW, 0
OUBUF
OUREC, 0
JMP I OUTDMP
ISZ OUTDMP
JMP I OUTDMP
OCLOSE, 0
CDF 0
TAD I (MODE
CDF 10
SMA SZA CLA
JMP OULLLP+2
JMS I (OTYPE
AND (770
TAD (-PTP
SZA CLA
TAD (232
JMS I (OCHARP
JMP OURET
JMS I (OCHARP
JMP OURET
OULLLP, JMS I (OCHARP
JMP OURET
JMS I (OTYPE
SPA CLA
TAD (100
TAD (77
AND I (OUDWCT
SZA CLA
JMP OULLLP
TAD I (OUDWCT
TAD (OUCTL&3700
SNA
JMP OUDUMP
TAD (4010
JMS OUTDMP
JMP OURET
OUDUMP, TAD I (MOUTPU
JMS I (200
4
MOUTPU+1
OUCCNT, 0
SKP
ISZ OCLOSE
OURET, CIF CDF 0
JMP I OCLOSE
PAGE
OUTEMP, 0
OUJMP, HLT
JMP OCHR1
JMP OCHR2
OCHR3, TAD OUTEMP
CLL RTL
RTL
AND (7400
TAD I OUPOLD
DCA I OUPOLD
TAD OUTEMP
CLL RTR
RTR
RAR
AND (7400
TAD I OUPTR
OC8A1, DCA I OUPTR
TAD OUJMPP
DCA OUJMP
ISZ OUPTR
ISZ OUDWCT
JMP OUCOMN
TAD (OUCTL
JMS I (OUTDMP
JMP OUCRET
JMS OUSETP
JMP OUCOMN
OUSETP, 0
TAD (OUCTL&3700
CIA
DCA OUDWCT
TAD (OUBUF
DCA OUPTR
TAD OUJMPP
DCA OUJMP
JMP I OUSETP
OCHARP, 0
DCA OUTEMP
RDF
TAD (CIF CDF 0
DCA OUCRET
CDF 0
TAD I (MODE
SMA SZA CLA
JMP .+4
TAD OUTEMP
AND (377
DCA OUTEMP
CDF 10
ISZ OUJMP
OUJMPP, JMP OUJMP
OCHR2, CDF 0
TAD I (MODE
CDF 10
SMA SZA CLA
JMP OC8A2
TAD OUPTR
DCA OUPOLD
ISZ OUPTR
OCHR1, TAD OUTEMP
DCA I OUPTR
OUCOMN, ISZ OCHARP
OUCRET, CIF CDF 0
JMP I OCHARP
OUPOLD, 0
OUPTR, 0
OUDWCT, 0
OTYPE, 0
TAD I (MOUTPU
AND (17
TAD (DCB-1
DCA OUSETP
TAD I OUSETP
JMP I OTYPE
CDINXX, ZBLOCK 5
OC8A2, ISZ OUPTR
TAD OUTEMP
JMP OC8A1
PAGE
$-$-$