Trailing-Edge
-
PDP-10 Archives
-
klad_sources
-
klad.sources/devldr.mac
There are no other files named devldr.mac in the archive.
SUBTTL DEVICE BUFFER PARAMETERS
LDBF= 27000 ;USER LOAD BUFFER
TAB= LDBF+2 ;DECTAPE DIRECTORY BUFFER
RBUF= TAB ;DISK RIB BUFFER
LDBF1= RBUF+201 ;USER LOAD BUFFER # 2
DBUF= LDBF1+2 ;DATA BUFFER
LDBF2= DBUF+201 ;USER LOAD BUFFER # 3
HBUF= LDBF2+2 ;HOME BUFFER
SUBTTL DEVICE SELECTION
DEVSEL: SETZM PPN
SETZM DEVICE
SETZM VDTAFLG#
SETZM KLDCPF#
SETZM SRCHF
SETZM PTFLG#
SKIPE USER
JRST DEVUSR
SETZM DEVTYP
PMSG <^DEV:T,K,D,V,P - >
GO TT2CHR
JRST DEVSEL ;ONLY A CR
CAIN "K"
JRST KLDCPS ;KLDCP - THRU THE PDP-11
CAIN "D"
JRST DTUNIT ;DECTAPE
CAIN "V"
JRST VDTA ;PDP-11 FORMAT DECTAPE
CAIN "P"
JRST PPNIN ;DISK PACK
CAIN "T"
JRST PTAPE ;PAPER TAPE
JRST DEVSEL ;ERROR
KLDCPS: SKIPN KLFLG
JRST DEVSEL ;NOT A KL10
SETOM KLDCPF
SETOM DEVTYP
RTN
DEVUSR: SETOM DEVTYP
RTN
VDTA: SETOM VDTAFLG
JRST DTUNIT
;*DTUNIT - SELECT DTA UNIT, READ IN DIRECTORY
DTUNIT: PMSG <UNIT # - >
GO TT2CHR
RTN ;IF CR, USE SAME DECTAPE
CAIN "S" ;IF S, SEARCH ALL DECTAPES
JRST DTSRCH
DTUNI1: CAIL 60 ;MUST BE 0-7
CAILE 67
JRST DTUNIT ;ERROR
ANDI 0,7 ;CONVERT TO OCTAL
LSH ^D9 ;LEFT JUSTIFY FOR CONO
MOVEM TAPENO ;SAVE AS TAPE NUMBER
SKIPE VDTAFLG
RTN
SETOM PGMGO
GO LDDIR ;SELECT TAPE, READ DIRECTORY
SETZM PGMGO
RTN
DTSRCH: SETOM SRCHF ;SET DECTAPE SEARCH FLAG
MOVE [TAB,,TAB+1]
SETZM TAB
BLT TAB+177 ;CLEAR PRESENT IN-CORE DIRECTORY
RTN
;*PTAPE - PAPER TAPE SELECTION
PTAPE: SETOM DEVTYP
SETOM PTFLG ;SET FOR PAPER-TAPE READER
RTN
;*PPNIN - DISK AND PROJ PROGRAMMER SPECIFICATION
PPNIN1: GO CRLF1
PPNIN: MOVEI 1
MOVEM DEVTYP ;SET DEVICE TYPE TO DISK PACK
MOVEI [ASCIZ/DISK:[P,PN] - /]
PNTAL
HRRZS DATAOW
SETZM F
PPNLP: MOVE S,PPNPTR
SETZB N,W
PPNCHR: MOVEM F,C
TTICHR
EXCH F,C
CAIN C,177
JRST PPNIN1 ;RUBOUT
CAIG C,"Z"
CAIGE C,"A"
SKIPA
JRST PPNLTR ;LETTER
CAIG C,"9"
CAIGE C,"0"
JRST PPN0 ;NO, BREAK CHARACTER
LSH N,3 ;BUILD OCTAL NUMBER
ADDI N,-60(C) ;ADD IN THIS DIGIT
PPNLTR: TRC C,40 ;MAKE IT SIXBIT
TLNE S,770000 ;ONLY SIX CHARACTERS
IDPB C,S ;STORE CHAR IN W
JRST PPNCHR ;LOOP FOR MORE
PPN0: CAIE C,":" ;UNIT DELIMITER ?
JRST PPN1 ;NO
MOVEM W,DEVICE ;YES, SAVE NAME OF DEVICE
JRST PPNLP
PPN1: CAIE C,"]" ;END OF PPN ?
JRST PPN2 ;NO
HRRM N,PPN ;YES, SAVE PROGRAMMER NUMBER
TLZN F,L.CMA ;CLEAR PPN COMMA FLAG
JRST PPNIN1 ;IT WASN'T ON, BAD !
JRST PPNLP
PPN2: TLNN F,L.LBK!L.CMA ;ANY SYNTAX REQUESTS ?
JRST PPN5 ;NO
TLZE F,L.LBK ;PPN REQUEST ?
HRLM N,PPN ;YES, STORE PROJ NO.
TLZE F,L.CMA ;PPN PART 2 ?
HRRM N,PPN ;YES, STORE PROG NO.
PPN5: CAIN C,12
RTN ;CR(LF) - COMPLETED
PPN3: CAIE C,"["
JRST PPN4
TLO F,L.LBK ;PPN REQUEST
JRST PPNLP
PPN4: CAIE C,","
JRST PPNIN1 ;ILLEGAL CHAR
TLO F,L.CMA ;COMMA, PART OF PPN
JRST PPNLP
;*LIST1 - LIST FILES
LIST1: SKIPE KLDCPF
JRST SELECT ;ILLEGAL IN KLDCP MODE
SETOM LSTFLG
JRST RUNPRG
;*DIRECT - PRINT DIRECTORY
DIRECT: SKIPE USER ;ILLEGAL IN USER MODE
JRST SELECT
SKIPE KLDCPF ;ILLEGAL IN KLDCP MODE
JRST SELECT
SKIPE PTFLG
JRST SELECT ;ILLEGAL FROM PAPER-TAPE
SWITCH
TLNE LPTSW
SETOM LPTFLG
GO DTECLR
SKIPE DEVTYP
JRST DSKDIR ;DISK DIRECTORY
JRST FDIR ;DECTAPE DIRECTORY
SUBTTL PROGRAM FILE SELECTION
;*FSELECT - "SUBRTN" FILE SELECTION
FSELECT:SETOM SPECIAL# ;SET SPECIAL MODE
SETZM NOCMNT
MOVEM 0,IP ;SET POINTER TO FILE SPEC
JRST DIAGLD+2
;*DIAGLD - "DIAMON" FILE SELECTION
SETOM NOFNF# ;SET DON'T REPORT IF CAN'T FIND
SETOM NOCMNT
JRST .+6
SETOM NOCMNT# ;INHIBIT COMMENT PRINTING
JRST .+2
DIAGLD: SETZM NOCMNT
SETZM SPECIAL ;SET NORMAL MODE
SETZM NOFNF
SETZM A10FLG#
SETZM LDEVICE#
HLRZ 0,1(IP)
CAIN 0,(SIXBIT/A10/)
SETOM A10FLG
SKIPE USER
JRST USERLD ;USER MODE
SKIPE KLDCPF
JRST KLDCPL ;LOAD FROM KLDCP
SKIPE PTFLG
JRST PTLD ;LOAD FROM PAPER-TAPE
SKIPE VDTAFLG
JRST VDTALD ;LOAD FROM PDP-11 FORMAT DECTAPE
SKIPN DEVTYP
JRST DTALD ;DECTAPE
SKIPN KLFLG ;KL10 ?
JRST DSKLD ;NO, DISK PACK
MOVEI 540027 ;SET DIAMON BUFFERS UNCACHED
HRRM 613
CONI PAG,0 ;READ PAGING SYSTEM
TRO TRPENB ;SET TRAP ENABLE
CONO PAG,@0 ;RESET PAGING SYSTEM
JRST DSKLD ;NOW LOAD FROM DISK
;*RFILE - FILE FOUND AND SETUP
RFILE: SETZM Q ;CLEAR FILE READ WORD COUNTER
MOVEI M,5 ;SET LDACHR BYTE COUNTER
SETOM FBSAV# ;SET 8 BIT READ FILE BYTE COUNTER
MOVEM 13,SAV13#
MOVEM 14,SAV14#
SKIPN SPECIAL ;FILE FOUND
JRST RFILE1 ;NORMAL OPERATION
;*FSELF - "SUBRTN" FILE FOUND RETURN
FSELF: MOVEM 0,ACSAVE ;SAVE ACS
MOVE 0,[1,,ACSAVE+1]
BLT ACSAVE+16
MOVE 0,LDEVICE ;RETURN DEVICE TYPE
AOS (P)
RTN ;SKIP RETURN TO "SUBRTN"
;*NFERR - FILE NOT FOUND
NFERR: SKIPE NOFNF ;REPORT NOT FOUND ?
RTN ;NO
SKIPN SPECIAL ;NOT FOUND
JRST NFERR1 ;NORMAL OPERATION
;*FSELNF - "SUBRTN" FILE NOT FOUND
FSELNF: MOVE 0,LDEVICE ;"FSELECT" - NOT FOUND
RTN ;NON-SKIP, ERROR RETURN
SUBTTL "SUBRTN" PROGRAM FILE READ
;*FREAD - DETERMINE READ TYPE
FREAD: MOVEM 0,FRDTYP#
MOVS [1,,ACSAVE+1]
BLT 16 ;RESTORE "DIAMON" ACS
MOVE ACSAVE
SKIPGE FRDTYP
JRST FRD36 ;READ 36 BIT WORDS
SKIPE FRDTYP
JRST FRD8 ;READ 8 BIT WORDS
;*FREAD3 - CHARACTER READ
FREAD3: GO LDACHR ;LOAD AN ASCII CHARACTER
JRST FREAD2 ;EOF
SKIPN PTFLG ;PAPER TAPE ?
JRST FREAD1 ;NO, PASS ALL CHARS
CAIN 16,";"
JRST LDCMNT ;COMMENT, FILE CONTROL LINE
FREAD1: MOVEM 0,ACSAVE ;RESAVE "DIAMON" ACS
MOVE 0,[1,,ACSAVE+1]
BLT ACSAVE+16
MOVE 0,16 ;PUT ASCII BYTE IN AC0
AOS (P)
RTN ;SKIP RETURN
;*FREAD2 - END OF FILE
FREAD2: SKIPN DEVTYP ;EOF
CONO DTC,DTSTOP ;IF DECTAPE, STOP IT
SETZM 0 ;EOF CODE = 0
RTN ;NON-SKIP RETURN
;*FRD36 - 36 BIT WORD READ
FRD36: SKIPE VDTAFLG
JRST FREAD2 ;PDP-11 DTA ILLEGAL
SKIPN PTFLG ;PTR ILLEGAL
GO RWORD ;READ 36 BIT WORDS
JRST FREAD2 ;EOF
MOVE 16,W ;PUT 36 BIT WORD IN AC16
JRST FREAD1 ;REST AS ABOVE
;*LDACHR - ASCII CHARACTER PROCESS
LDACHR: SKIPE PTFLG
JRST LDACPT ;LOAD A CHAR FROM PAPER-TAPE
SKIPE VDTAFLG
JRST LDACD11 ;PDP-11 DECTAPE
CAIE M,5 ;USED ALL OF THIS 36 BIT WORD ?
JRST LDACH1 ;NOT YET
SETZM M ;YES, READ NEXT 36 BIT WORD
EXCH 13,SAV13
EXCH 14,SAV14
GO RWORD
JRST LDAEOF ;EOF
EXCH 13,SAV13
EXCH 14,SAV14
LDACH1: LDB 16,[POINT 7,W,6
POINT 7,W,13
POINT 7,W,20
POINT 7,W,27
POINT 7,W,34](M) ;GET ASCII BYTE
AOS M ;COUNT IT
LDACH2: JUMPE 16,LDACHR ;IF NULL, IGNORE
AOS (P) ;SKIP RETURN
RTN
LDACD11:EXCH 13,SAV13
EXCH 14,SAV14
GO D11CHR ;GET PDP-11 8 BIT BYTE
JRST LDAEOF ;EOF
EXCH 13,SAV13
EXCH 14,SAV14
JRST LDACH2
LDAEOF: EXCH 13,SAV13
EXCH 14,SAV14
RTN
;*FRD8 - 8 BIT WORD READ
FRD8: GO G8BYT ;GET AN 8 BIT BYTE
JRST FREAD2 ;EOF
JRST FREAD1 ;8 BIT BYTE IN AC16
LD8PT: CONSO PTR,400 ;READER OUT OF TAPE ?
RTN ;YES, EOF
CONSZ PTR,20
JRST .-1
DATAI PTR,16 ;INPUT CHAR FROM READER
JRST CPOPJ1
LD8D11: EXCH 13,SAV13
EXCH 14,SAV14
GO D11CHR ;GET PDP-11 8 BIT BYTE FROM DTA
JRST LDAEOF ;EOF
EXCH 13,SAV13
EXCH 14,SAV14
JRST CPOPJ1
G8BYT: SKIPE KLDCPF
JRST KLDCP8 ;KLDCP 8 BIT READ
SKIPE PTFLG
JRST LD8PT ;PAPER TAPE 8 BIT READ
SKIPE VDTAFLG
JRST LD8D11 ;11 FORMAT DECTAPE 8 BIT READ
AOS M,FBSAV ;ADVANCE FILE BYTE
ANDI M,3 ;(MOD 4)
JUMPN M,G8BY2 ;NEED A NEW WORD ?
GO RWORD ;YES
RTN ;EOF
G8BY1: MOVEM W,BYTSAV# ;SAVE WORD
G8BY2: LDB 16,[POINT 8,BYTSAV,17
POINT 8,BYTSAV,9
POINT 8,BYTSAV,35
POINT 8,BYTSAV,27](M)
JRST CPOPJ1 ;LOAD & SKIP RETURN WITH BYTE
SUBTTL LDA10 - LOAD PDP-10 ASCIIZED ".A10" FILE
;*PDPROC - FORMAT CONTROL PROCESS
LDA10:
LDPROC: SETZM LDOCTF#
SETZM LDZBLK#
GO LDACHR ;GET FILE TYPE CHAR
GO LERR2 ;EOF
CAIN 16,";"
JRST LDCMNT ;LINE STARTS WITH ;, COMMENT
SETZM LDTBLK#
CAIN 16,"A" ;A, PDP-10 SUPER A10 FILE
JRST .+6
CAIN 16,"T" ;T, PDP-10 ".A10" FILE
JRST [SETOM LDTBLK
JRST .+4]
CAIE 16,"Z" ;Z, ".A10" CORE ZERO
GO LERR3
SETOM LDZBLK
GO LDACHR ;GET FORMAT CHAR
GO LERR2 ;EOF
CAIN 16," " ;SPACE, ASCIIZED
JRST .+4
CAIE 16,"O" ;O, OCTAL
GO LERR4
SETOM LDOCTF
MOVE 16,[LDCNT,,LDCNT+1]
SETZM LDCNT
BLT 16,LDATAE ;CLEAR LOAD STORAGE
MOVEI 13,LDCNT ;SETUP CONVERTED STORAGE POINTER
;*LDCNV - CONVERT ASCIIZED BACK INTO BITS
LDCNV: SETZM 14 ;CLEAR CONVERTED WORD FORMER
LDCNV1: GO LDACHR ;LOAD AN ASCII CHAR
GO LERR2 ;EOF
CAIN 16,15 ;CR, IGNORE
JRST LDCNV1
CAIN 16,12 ;LF, END OF LINE
JRST LDEOL
CAIN 16,54 ;COMMA, FIELD SEPARATOR
JRST LDCMA
SKIPE LDOCTF
JRST LDCNV3 ;LOADING OCTAL FORMAT
CAIL 16,"5" ;5 TO : ?
CAILE 16,":"
JRST .+6 ;NO
SUBI 16,"5" ;YES, INSERT SUPPRESSED ONES
LSH 14,6
TRO 14,77
SOJGE 16,.-2
JRST LDCNV1
CAIL 16,"0" ;0 TO 4 ?
CAILE 16,"4"
JRST .+5 ;NO
ANDI 16,7 ;YES, INSERT SUPPRESSED ZEROS
LSH 14,6
SOJGE 16,.-1
JRST LDCNV1
LSH 14,6 ;SHIFT WORD FORMER LEFT 6
ANDI 16,77 ;KEEP ASCIIZED OIT BITS
LDCNV2: OR 14,16 ;INSERT NEW OIT
JRST LDCNV1
LDCNV3: LSH 14,3 ;SHIFT WORD FORMER LEFT 3, OCTAL
ANDI 16,7 ;KEEP OCTAL OIT BITS
JRST LDCNV2
LDCMA: MOVEM 14,(13) ;STORE CONVERTED WORD
AOJA 13,LDCNV ;COUNT AND GO FOR NEXT WORD
;*LDEOL - END OF LINE, CHECKSUM LOAD LINE
LDEOL: MOVEM 14,(13) ;STORE CHECKSUM
SKIPE LDOCTF
JRST LDTEN ;OCTAL, NO CHECKSUM
MOVEI 13,LDCNT ;CHECKSUM LOAD STORAGE
SETZM 14
ADD 14,(13)
CAIE 13,LDATAE
AOJA 13,.-2
TRNE 14,177777 ;16 BIT CHECKSUM = 0 ?
GO LERR5 ;NO, CHECKSUM ERROR
;*LDTEN - CREATE LOAD ADDRESS AND WORD COUNT
LDTEN: LDB 13,[POINT 2,LDCNT,27]
LSH 13,^D16
OR 13,LDADR ;CREATE PDP-10 LOAD ADDRESS
LDB 14,[POINT 8,LDCNT,35] ;WORD COUNT
SKIPN LDZBLK
JRST LDTEN1 ;LOAD TEN DATA WORDS
;*LDTENZ - CLEAR TEN CORE, JOB START TO JOB FIRST FREE
LDTENZ: JUMPE 14,LDPROC ;WC=0, NO ZEROING
MOVEM 13,JOBSAW ;SETUP JOB START ADDRESS
ADD 13,LDATA-1(14)
SOJG 14,.-1 ;ADD UP ZERO COUNT
MOVEM 13,JOBFFW ;SETUP JOB FIRST FREE ADDRESS
GO CLRCOR ;CLEAR PDP-10 CORE
JRST LDPROC
;*LDTEN1 - TRANSFER TEN WORDS TO MEMORY
LDTEN1: SKIPN LDTBLK
MOVE 13,LDADR
JUMPE 14,LDDONE ;WC=0, TRANSFER BLOCK
MOVEI 15,LDATA ;SETUP PICKUP POINTER
LDTEN2: MOVE 16,(15) ;GET 36 BIT WORD
SKIPN LDTBLK
JRST .+6
MOVE 16,2(15) ;BITS 0 TO 7
LSH 16,^D16
OR 16,1(15) ;BITS 8 TO 23
LSH 16,^D16
OR 16,0(15) ;BITS 24 TO 35
MOVEM 16,(13) ;STORE 36 BIT WORD IN MEMORY
AOS 13 ;INCREMENT PDP-10 ADDRESS
ADDI 15,1 ;BUMP PICKUP POINTER
SKIPE LDTBLK
ADDI 15,2
SUBI 14,1 ;DECREMENT WORD COUNT
SKIPE LDTBLK
SUBI 14,2
JUMPG 14,LDTEN2 ;DO TILL ALL WORDS USED
JRST LDPROC ;CONTINUE TILL TRANSFER BLOCK
;*LDDONE - COMPLETED, GO TO START ROUTINE
LDDONE: MOVE W,13 ;SETUP START ADDRESS
JRST STARTQ ;GO TO START ROUTINE
;*LDCMNT - LOAD FILE COMMENT LINE
LDCMNT: SETZM PNT ;GET 1ST 3 COMMENT CHARS
GO LDACHR
GO LERR2 ;ILLEGAL EOF
DPB 16,[POINT 7,PNT,6]
GO LDACHR
GO LERR2
DPB 16,[POINT 7,PNT,13]
GO LDACHR
GO LERR2
DPB 16,[POINT 7,PNT,20]
CAMN PNT,[ASCII/EOT/]
JRST PTCNTL ;PAPER TAPE END OF TAPE
PUT 0
SETZM PNT1 ;NO, PRINT 1ST 3 COMMENT CHARS
MOVEI 0,PNT
SKIPN NOCMNT
PNTAL
GO CMNPNT ;PRINT REST OF COMMENT LINE
GET 0
SKIPE SPECIAL
JRST FREAD3
JRST LDPROC
;*CMNPNT - PRINT COMMENT LINE
CMNPNT: GO LDACHR
JRST LERR2
CAIN 16,12 ;LINE FEED ?
JRST .+4 ;YES
SKIPN NOCMNT
GO PNT16 ;PRINT COMMENT LINE
JRST CMNPNT
SKIPN NOCMNT
GO PNT16
RTN
SUBTTL PROGRAM CORE AREA SETUP
T0=4 ;W
T1=5 ;Q
T2=7 ;M
T3=6 ;N
T4=3 ;C
;*PRGCOR - SETUP CORE ZEROING FOR ".SAV" FILES
PRGCOR: SKIPE A10FLG
JRST LDA10 ;LOAD ".A10" FILE
SETZM Q
GO RWORD ;READ FIRST BLOCK/WORD
GO ERR2 ;EOF, ILLEGAL
MOVEM T0,SAVT0#
MOVEM T1,SAVT1#
MOVEM T2,SAVT2#
MOVEM T3,SAVT3#
MOVEM T4,SAVT4#
SKIPN USER
SOS SAVT1 ;EXEC, BACKUP POINTER
SKIPL T0
GO ERR6 ;FIRST WORD NOT POINTER
MOVEI T2,^D126(T0)
MOVEI T3,137 ;FIRST POINTER LEGAL ?
CAMGE T2,T3
GO ERR6 ;NO
HRRZ T1,SAVT1
MOVEI T3,JOBSA
GO RMS1 ;GET 'JOBSA'
HRRZM T0,JOBSAW#
SKIPN T1,JOBSAW
GO ERR7 ;NO STARTING ADDRESS
CAIN T1,140
GO ERR7 ;PROGRAMS CAN'T START AT 140
HRRZ T1,SAVT1
MOVEI T3,JOBFF
GO RMS1 ;GET 'JOBFF'
MOVEM T0,JOBFFW#
GO CLRCOR ;CLEAR PROGRAM'S CORE AREA
SKIPN USER
AOS SAVT1 ;EXEC, RE-ADVANCE POINTER
MOVE T0,SAVT0
MOVE T1,SAVT1
MOVE T2,SAVT2
MOVE T3,SAVT3
MOVE T4,SAVT4
JRST RFILL3 ;NOW GO LOAD PROGRAM
RMS2: SUB T1,T4
AOJ T1,
RMS1: MOVE T0,(T1) ;GET POINTER
HRRZ T2,T0 ; X
HLRO T4,T0 ; -N
SUB T2,T4 ; X+N IN T2
CAMGE T2,T3 ;THIS POINTER TO REQ DATA ?
JRST RMS2 ;NO, GET NEXT POINTER
SUBI T3,(T0) ;YES, HOW FAR FROM POINTER ?
ADD T1,T3 ;INCREMENT POINTER
MOVE T0,(T1) ;GET REQ DATA
RTN
;*CLRCOR - CLEAR CORE FOR DIAGNOSTIC SEGMENT
;* CLEARS CORE FROM 'JOBSA' TO 'JOBFF'
CLRCOR: SKIPN USER ;USER MODE ?
JRST CLRCR1 ;NO
MOVE JOBREL ;YES, PRESENT JOBREL LT DIAMON'S ?
CAMG SVJBREL
JRST .+4 ;YES
MOVE SVJBREL ;NO, REDUCE CORE TO DIAMON'S
CORE
JRST ERR10
MOVE JOBFFW ;THIS PRG NEED MORE THAN DIAMON'S ?
CAMG SVJBREL
JRST .+3 ;NO
CORE ;YES, EXPAND CORE FOR PROGRAM
JRST ERR10
CLRCR1: MOVEM Q,SAVQ#
MOVE Q,JOBSAW
CAIL Q,START ;DO NOT, REPEAT NOT, CLEAR "DIAMON" !
CAIL Q,DIAGNOS
SETZM (Q)
CAMGE Q,JOBFFW
AOJA Q,.-4
MOVE Q,SAVQ
RTN
SUBTTL KL10 KLDCP MODE LOADER
;*KLDCPL - LOOKUP FILE USING THE CONSOLE LOAD DEVICES
KLDCPL: SETOM A10FLG ;MUST BE .A10 FORMAT
MOVEI 0,26 ;FLUSH KLDCP OUTPUT BUFFER
GO $DTEXX
MOVE A,(IP)
GO SIXBP ;SEND KLDCP NAME
MOVEI "."
GO PRINT
HLLZ A,1(IP)
SKIPE A ;IF NO EXT, USE .A10
CAMN A,[SIXBIT/SAV/] ;IF EXT .SAV, CHANGE TO .A10
MOVE A,[SIXBIT/A10/]
GO SIXBP ;SEND KLDCP EXT
MOVEI 0,406 ;FILE LOOKUP COMMAND
GO $DTEXX ;SEND TO KLDCP
ANDI 0,177777
MOVE A,0
ANDI 0,177 ;SAVE ONLY DEVICE CODE
MOVEM 0,LDEVICE
TRNE A,177400
JRST NFERR ;NON-ZERO, NOT FOUND
JRST RFILE ;FOUND & SETUP
;*KLDCPW - KLDCP READ WORD
KLDCPW: MOVEI 0,407 ;FILE READ COMMAND
GO $DTEXX ;SEND TO KLDCP
MOVE W,0
CAME W,[-1] ;-1 = END OF FILE
AOS (P) ;OTHERWISE, SKIP RETURN
RTN ;WITH 5 CHARS IN W
;*KLDCP8 - KLDCP READ 8 BIT BYTE
KLDCP8: MOVEI 0,414 ;FILE READ 8 BIT COMMAND
GO $DTEXX ;SEND TO KLDCP
MOVE 16,0
CAME 16,[-1] ;-1 = END OF FILE
AOS (P) ;OTHERWISE, SKIP RETURN
ANDI 16,377 ;WITH 8 BIT BYTE IN AC16
RTN
SUBTTL USER MODE LOADER
;*USERLD - LOOKUP FILE ON THE USERS DISK
USERLD: MOVEI 5
MOVEM LDEVICE
SETZM LDBUF+1
SETZM LDBUF+2
OPEN LDCHN,LDBLK ;SETUP INPUT FILE
GO ERR8
MOVE [400000,,LDBF+1]
MOVEM LDBUF ;SETUP BUFFER POINTER
MOVE [201,,LDBF1+1]
MOVEM LDBF+1 ;CLEAR BUFFER USE BITS
MOVE [201,,LDBF2+1]
MOVEM LDBF1+1
MOVE [201,,LDBF+1]
MOVEM LDBF2+1
MOVE (IP)
MOVEM LDNAME ;SETUP FILE NAME
HLLZ 1(IP)
JUMPE USLD1 ;IF NO EXT, TRY A10 & SAV
GO USLKUP ;LOOKUP FILE
JRST RFILE ;FOUND
JRST NFERR ;NOT FOUND
USLD1: MOVSI (SIXBIT/SAV/)
GO USLKUP ;LOOKUP "SAV"
JRST RFILE ;FOUND
MOVSI (SIXBIT/A10/)
GO USLKUP ;LOOKUP "A10"
JRST RFILE ;FOUND
JRST NFERR ;COUNDN'T FIND EITHER
USLKUP: MOVEM LDNAME+1
LOOKUP LDCHN,LDNAME
JRST CPOPJ1 ;NOT FOUND
HLRZ LDNAME+1
CAIN (SIXBIT/A10/)
SETOM A10FLG ;LOADING "A10" FILE
RTN
;*URWD - USER MODE READ WORD
URWD: SOSLE LDBUF+2
JRST URWD1
IN LDCHN,
JRST URWD1
STATZ LDCHN,740000
GO ERR9
RTN
URWD1: ILDB W,LDBUF+1
MOVE Q,LDBUF+1
JRST CPOPJ1
;*USRINT - USER MODE INIT, SETUP MINIMUM OF 32K OF CORE
USRINT: MOVEI <^D32*^D1024>-1
CAMG SVJBREL ;DO WE HAVE 32K MINIMUM ?
RTN ;YES
CORE ;NO, EXPAND CORE TO 32K
GO ERR10
MOVE JOBREL
MOVEM SVJBREL ;SAVE MAX CORE NOW
RTN
SUBTTL PAPER TAPE LOADER
PTLD: MOVEI 4
MOVEM LDEVICE
SETZM NOCMNT
SETOM A10FLG ;ASCII READ ONLY
MOVSI (SIXBIT/A10/)
SKIPN 1(IP) ;ANY EXTENSION ?
MOVEM 0,1(IP) ;NO, USE ".A10"
GO CRLF1
GO NAMPNT ;PRINT FILE REQUESTED
PMSG <PLACE TAPE IN READER, TYPE CR WHEN READY^>
TTICHR
CAIE 12 ;YOU GET LF
JRST .-2
DATAI PTR,0
CONSO PTR,400 ;TEST TAPE BIT
JRST PTLD ;TAPE IN READER FLAG NOT SET
JRST RFILE ;OK, GO
PTCNTL: PMSG <END OF TAPE>
GO CMNPNT ;PRINT REST OF COMMENT LINE
PTCNT1: PMSG <^PLACE NEXT PART IN READER, TYPE CR WHEN READY^>
TTICHR
CAIE 12
JRST .-2
DATAI PTR,0
CONSO PTR,400 ;TEST TAPE BIT
JRST PTCNT1 ;TAPE IN READER FLAG NOT SET
SKIPE SPECIAL
JRST FREAD3
JRST LDPROC
LDACPT: CONSO PTR,400 ;READER OUT OF TAPE ?
RTN ;YES, EOF
CONSZ PTR,20
JRST .-1
DATAI PTR,16 ;INPUT CHAR FROM READER
ANDI 16,177 ;MAKE 7 BITS
JRST LDACH2
SUBTTL DECTAPE LOAD ONLY ROUTINE
;*DECTAPE CONTROL BITS
DTSTOP=400000 ;DTC, STOP
DTFWD=200000 ;DTC, GO FORWARD
DTRVS=100000 ;DTC, GO REVERSE
DTSEL=020000 ;DTC, SELECT
DTDSEL=010000 ;DTC, DESELECT
DTDREQ=000001 ;DTS, DATA REQUEST
DTFSTP=000001 ;DTS, FUNCTION STOP
DTJBDN=100000 ;DTS, JOB DONE
DTRALL=000100 ;DTC, READ ALL
DTRBN=000200 ;DTC, READ BLOCK NUMBERS
DTREAD=300 ;DTC, READ
DTEND=20000 ;DTS, END ZONE
DTREV=400000 ;F, TAPE MOVING IN REVERSE
DTERR=653300 ;DTS, ERROR; PARITY,DATA MISS,ILL OP,BLK MISS
; WM SW,MK TRK ER,SEL ERR
;*ACCUMULATOR ASSIGNMENTS
F=0 ;TEMP
A=1 ;TEMP
B=2 ;TEMP
C=3 ;HOLDS BITS FOR DECTAPE CONO DURING I/O
W=4 ;WORD RETURNED BY RWORD
Q=5 ;COUNTER, DATA WORD BUFFER
N=6 ;COUNTER, SEARCH & DTABLK
M=7 ;MEMORY AOBJN POINTER, DATA TO CORE
FILN=10 ;NUMBER OF FILE IN DIRECTORY, 1 TO 26 OCTAL
TABADR=11 ;DIRECTORY SLOT ADDRESSER
PNTR=12 ;POSITIONER FOR BYTE TABLE IN DIRECTORY
BLKNO=13 ;BLOCK NUMBER SEARCHED FOR ON TAPE
PNT=15 ;LISTING AC'S
PNT1=16
;*DTALD - INITIAL ENTRY TO LOAD TAPE
DTALD: MOVEI 1
MOVEM LDEVICE
SETOM DIRSRC ;SETUP FOR TAPE SEARCH
SETZM DOSRCH
SETZB TABADR,PNTR ;SETUP DIR SLOT POINTERS
CONO DTC,DTSTOP ;STOP TAPE DRIVE
MOVE A,(IP) ;GET REQUESTED FILE NAME
HLLZ C,1(IP)
MOVSI FILN,-26 ;FILE NAME SPECIFIED
LUP: HLLZ B,TAB+151(FILN) ;LOOK IT UP
CAME A,TAB+123(FILN)
JRST .+3
JUMPE C,LUP3
CAME C,B
LUP1: AOBJN FILN,LUP ;NOT FOUND, KEEP LOOKING
LUP2: JUMPL FILN,FNFND ;IF FOUND JUMP
JRST NF ;NOT FOUND
LUP3: GO EXTCK ;CHECK EXT FOR EITHER "A10" OR "SAV"
JRST LUP1 ;NOT FOUND
JRST LUP2 ;FOUND
FNFND: MOVEI FILN,1(FILN) ;FILN IS FILE #+1, CLR LH
SETZB Q,BLKNO
MNLUP: AOS BLKNO
SKIPA ;SEARCH DIRECTORY BLK # SLOTS
HRROI PNTR,-^D36
ADDI PNTR,5 ;ILDB SUBSTITUTION
SKIPL PNTR ;FOR ILDB B,PNTR
AOJA TABADR,.-3 ;PNTR ORIG = [POINT 5,TAB]
MOVE B,TAB-1(TABADR)
LSH B,(PNTR)
ANDI B,37
CAIN B,37
JRST BLKERR ;BLOCK NUMBER ERROR
CAIE FILN,(B) ;THIS BLK ASSIGNED TO CURRENT
JRST MNLUP ;FILE OR IN USE BY ANOTHER
RFILL: GO RDDTA1 ;READ THE DATA BLOCK TO FIND FBN
JRST ERR ;SHOULD NEVER GET HERE
MOVE A,DBUF ;GET FIRST BLOCK OF FILE
LSH A,-^D8 ;LDB SUBSTITUTION FOR:
ANDI A,1777 ;LDB A,[POINT 10,DBUF,27]
HRLM A,DBUF ;PUT IN LINK SLOT TO BE READ NEXT
JRST RFILE
;*NF - NOT FOUND DIRECTORY SEARCH SEQUENCE
NF: SKIPN SRCHF ;SEARCHING ?
JRST NFERR ;NO, NOT FOUND ERROR
MOVEM P,SAVEP ;SAVE PUSHDOWN POINTER
NF1: MOVE P,SAVEP ;RESTORE PUSHDOWN POINTER
AOS A,DIRSRC ;INCREMENT SEARCH TAPE NUMBER
CAIL A,10 ;DECTAPES ARE 0-7
JRST NFERR ;SEARCHED THEM ALL
SETOM DOSRCH ;SET DOING SEARCH
LSH A,^D9
MOVEM A,TAPENO ;MAKE A TAPE NUMBER
SKIPE VDTAFLG
JRST VDIR+1 ;PDP-11 FORMAT TAPE
GO LDDIR ;SELECT TAPE, READ DIRECTORY
JRST DTALD+4 ;LOOK UP IN THIS DIRECTORY
;*PROCBK - READ A BLOCK OF TAPE
PROCBK: GO SEARCH ;FIRST FIND THE BLOCK
MOVEI N,200 ;NUMBER OF WORDS IN BLOCK
TLNE F,DTREV ;WHICH DIRECTION ?
ADDI A,177 ;BACKWARDS, GO FROM TOP
CONO DTC,DTREAD ;READ
PROCLP: CONSZ DTS,DTERR!DTEND
JRST ERR ;TROUBLE, QUIT
CONSO DTS,DTDREQ ;DATA AVAILABLE ?
JRST PROCLP ;NO, WAIT SOME MORE
DATAI DTC,(A) ;READ DATA TO BUFFER
ADDI A,1 ;COUNT BUFFER POINTER
TLNE F,DTREV ;GOING BACKWARDS ?
SUBI A,2 ;YES, COUNT POINTER BACKWARDS
SOJG N,PROCLP ;TRANSFERRED WHOLE BLOCK ?
CONO DTS,1 ;CHECKSUM AND QUIT
CONSO DTS,DTJBDN ;DONE ?
JRST .-1 ;NOT YET, WAIT
RTN
;*SEARCH - FIND THE BLOCK
SEARCH: MOVE C,TAPENO ;GET DRIVE NUMBER
CONSZ DTC,DTFWD!DTRVS ;TAPE GOING ?
JRST SRCHC ;YES
TRO C,DTFWD ;NO, MAKE IT GO FORWARD
TLZ F,DTREV ;SET FLAG FOR THAT
SRCHC: CONO DTC,DTRBN!DTSEL(C) ;SEARCH
SRCHW: CONSZ DTS,DTEND ;AT END ZONE ?
JRST SRCHTA ;YES, TURN AROUND
CONSZ DTS,DTERR ;ANY ERRORS ?
JRST ERR ;YES, QUIT
CONSO DTS,DTDREQ ;BLOCK NUMBER FOUND ?
JRST SRCHW ;NO, WAIT FOR IT
DATAI DTC,N ;WHAT BLOCK ARE WE AT ?
ANDI N,7777 ;MASK JUNK
SUBI N,(BLKNO) ;GET DISTANCE TO GO
JUMPE N,CPOPJ ;FOUND, RTN WITH TAPE ROLLING INTO BLK
TLNE F,DTREV ;NOT THERE, WHICH DIRECTION ?
MOVNS N ;BACKWARDS, NEGATE
JUMPL N,SEARCH ;IF SHOULD CONTINUE, ITS MINUS
SRCHTA: CONO DTC,DTFWD!DTRVS ;MUST TURN AROUND (END ZONE OR PASSED)
TLC F,DTREV ;COMPLEMENT DIRECTION FLAG
JRST SEARCH ;SEARCH SOME MORE
;*EXTCK - FILE EXTENSION CHECK
EXTCK: CAMN B,[SIXBIT/SAV/]
JRST CPOPJ1 ;FILE EXT IS "SAV"
CAME B,[SIXBIT/A10/]
RTN ;NEITHER
SETOM A10FLG ;SET FOR "A10" LOAD
JRST CPOPJ1
;*ERR - DECTAPE ERROR ROUTINES
ERR: SKIPE DOSRCH ;DOING A SEARCH ?
JRST NF1 ;YES, MOVE ON TO NEXT DRIVE
CONI DTS,C ;GET DECTAPE STATUS
CONO DTC,DTSTOP ;STOP DECTAPE
PMSG <^DECTAPE ERROR, DTS = >
MOVE 0,C
GO PNTOCT
ERR1: MOVEI " "
GO PRINT
GO NAMPNT
SKIPN ONCE ;INITIAL LOAD ERROR ?
JRST SELX1 ;YES
SKIPE PGMGO
JRST SELECT
JRST RUN
BLKERR: CONO DTC,DTSTOP
GO ERR13
;*LDDIR - READ TAPE DIRECTORY
LDDIR: MOVEI BLKNO,^D100 ;BLOCK ON TAPE TO READ
SETZM F
CONO DTC,DTSEL!DTDSEL ;CLEAR DECTAPE
MOVEI A,TAB ;SETUP WHERE TO PUT IT
GO DTABLK ;READ IT
JRST ERR ;SHOULD NEVER GET HERE
CONO DTC,DTSTOP ;STOP TAPE
RTN
;*FDIR - PRINT DIRECTORY OF DECTAPE
FDIR: GO CRLF1
SKIPE VDTAFLG
JRST VDIR ;PDP-11 FORMAT DECTAPE DIRECTORY
PMSG <TAPE ID: >
MOVE A,TAB+177 ;GET TAPE ID
GO SIXBP
GO CRLF1
MOVSI N,-26 ;26 FILES OCTAL
FILDL: SKIPN A,TAB+123(N) ;GET NAME
JRST FILDN ;BLANK, LOOK FOR NEXT
GO SIXBP ;PRINT FILE NAME
HLLZ A,TAB+151(N) ;GET EXTENSION
JUMPE A,NOEXT ;BLANK
MOVEI F,"."
GO PRINT ;TYPE DOT
GO SIXBP ;PRINT EXTENSION
FILD1: GO PNTTAB
MOVE A,CHRCTR
CAIGE A,20 ;TABBED FAR ENOUGH ?
GO PNTTAB ;NO, DO ANOTHER TAB
GO DTBLKC ;COMPUTE NUMBER OF BLOCKS PER FILE
GO PNTDEC
GO CRLF1 ;CR-LF
FILDN: AOBJN N,FILDL ;LOOP FOR ALL NAMES
JRST START
NOEXT: PMSG < >
JRST FILD1
XLIST
REPEAT 0,<
DATOUT: MOVE 2,TAB+151(N) ;GET ENTRY DATE
ANDI 2,7777 ;MASK
JUMPE 2,CPOPJ ;DON'T PRINT IF NONE
IDIVI 2,^D31
ADDI 3,1
MOVE 0,3
GO PNTDEC ;PRINT DAY
IDIVI 2,^D12
MOVEM 2,PNT
MOVE A,[SIXBIT/-JAN-/
SIXBIT/-FEB-/
SIXBIT/-MAR-/
SIXBIT/-APR-/
SIXBIT/-MAY-/
SIXBIT/-JUN-/
SIXBIT/-JUL-/
SIXBIT/-AUG-/
SIXBIT/-SEP-/
SIXBIT/-OCT-/
SIXBIT/-NOV-/
SIXBIT/-DEC-/](3)
GO SIXBP ;PRINT MONTH
MOVE 2,PNT
MOVEI 0,^D64(2)
GO PNTDEC ;PRINT YEAR
RTN
>
LIST
;*DTBLKC - COMPUTE NUMBER OF BLOCKS USED PER FILE
DTBLKC: SETZB 0,TABADR
HRROI PNTR,-^D36 ;ILDB SUBSTITUTION
ADDI PNTR,5 ;FOR ILDB B,PNTR
SKIPL PNTR ;PNTR ORIG = [POINT 5,TAB]
AOJA TABADR,.-3
MOVE B,TAB(TABADR) ;GET BLOCK SLOT DATA
LSH B,(PNTR)
ANDI B,37
CAIN B,37 ;SEARCHED ALL SLOTS
RTN ;YES
CAIN B,1(N) ;BLOCK BELONG TO THIS FILE ?
AOS 0 ;YES
JRST DTBLKC+2
;*LSTPNT - LIST FILES (ASCIZ)
LSTPNT: SETOM SPECIAL
PUSH P,0
SWITCH
TLNE LPTSW
SETOM LPTFLG
GO DTECLR
POP P,0
LSTPN1: GO LDACHR ;READ A CHAR
JRST START ;EOF
GO PNT16 ;PRINT IT
JRST LSTPN1
STOP: SKIPN DEVTYP ;SKP IF NOT DECTAPE
CONO DTC,DTSTOP ;STOP THE DECTAPE
RTN
;*VDTALD - LOAD FROM PDP-11 FORMAT DECTAPE
VC= 10
VT= 11
VT1= 12
VT2= 13
VDIRF= 15
VDTALD: MOVEI 3
MOVEM LDEVICE
SETOM DIRSRC ;SET FOR TAPE SEARCH
CONO DTC,DTSTOP
SETZB VDIRF,DOSRCH
SETOM A10FLG ;CAN ONLY PROCESS ASCII
MOVE A,(IP) ;SETUP REQUESTED FILE NAME.EXT
MOVEM A,VNAM#
HLLZ A,1(IP)
SKIPN A
MOVSI A,(SIXBIT/A10/)
MOVEM A,VEXT#
JRST VDIR+1
;*VDIR - PRINT PDP-11 FORMAT DECTAPE DIRECTORY
VDIR: SETOM VDIRF ;SET DOING DIRECTORY FLAG
MOVEI BLKNO,102 ;FIRST 11 DIR BLOCK
GO LDDIR+1 ;READ IT
SETZM DOSRCH
VDIRL2: MOVEI VC,0 ;START OF DIRECTORY BLOCK
VDIRL1: MOVEI VT,0 ;GET 1ST HALF OF NAME
GO GTVDWD
JUMPE VT,VDIRL4 ;BLANK ?, IF SO, SKIP FILE
GO R5VSIX ;CONVERT RAD50 TO SIXBIT
MOVS A,VT
MOVEI VT,1 ;GET 2ND HALF OF NAME
GO GTVDWD
GO R5VSIX
HRR A,VT
JUMPE VDIRF,VDTAL1 ;FILE LOAD ?
GO SIXBP ;NO, PRINT NAME
MOVEI F,"."
GO PRINT
VDIRL3: MOVEI VT,2 ;GET EXTENSION
GO GTVDWD
GO R5VSIX
MOVS A,VT
JUMPE VDIRF,VDTAL2 ;FILE LOAD ?
GO SIXBP ;NO, PRINT EXTENSION
GO PNTTAB
MOVE A,CHRCTR
CAIGE A,20
GO PNTTAB
MOVEI VT,6 ;GET SIZE OF FILE
GO GTVDWD
MOVE 0,VT
GO PNTDEC ;PRINT FILE BLOCKS
GO CRLF1
VDIRL4: MOVEI VT,^D9 ;SEE IF NEXT FILE EXISTS
ADDI VC,(VT)
MOVE VT1,VC
ADDI VT1,(VT)
CAIGE VT1,377 ;OFF END OF BLOCK ?
JRST VDIRL1 ;NO, DO NEXT ENTRY
HLRZ VT,TAB ;YES, SEE IF LINK
JUMPE VT,.+3 ;NO
MOVEM VT,BLKNO ;SAVE AS NEXT DIRECTORY BLOCK NUMBER
JRST VDIR+2
JUMPE VDIRF,NF ;FILE LOAD ?
JRST START ;NO
VDTAL1: CAME A,VNAM ;CORRECT NAME ?
JRST VDIRL4 ;NO
JRST VDIRL3 ;YES
VDTAL2: CAME A,VEXT ;CORRECT EXTENSION ?
JRST VDIRL4 ;NO
MOVEI VT,5 ;YES, GET FILE FIRST BLOCK ADDRESS
GO GTVDWD
HRLM VT,DBUF ;SETUP FOR FILE READ
SETZM D11C1#
SETZM D11W#
JRST RFILE ;NOW GO FILE LOAD
;*GTVDWD - GET WORD FROM PDP-11 DIRECTORY
;* CALL WITH INDECIES IN VT & VC SUCH THAT ADDING THEM GIVES
;* NUMBER OF PDP-11 WORDS INTO DESIRED DIRECTORY
GTVDWD: MOVEI VT1,1(VT)
ADDI VT1,(VC)
ROT VT1,-1
MOVE VT,TAB(VT1)
SKIPL VT1
MOVS VT,TAB(VT1)
ANDI VT,177777
RTN
;*D11CHR - DECTAPE PDP-11 FORMAT CHARACTER READ
D11CHR: SKIPE D11C1 ;HAVE A BYTE LEFT ?
JRST D11CH1 ;YES
GO D11WD ;NO, READ A HALF WORD
RTN ;EOF
MOVEM W,D11CHW# ;STORE REMAINING HALF WORD
LDB 16,[POINT 8,W,35] ;GET 1ST (RIGHT) BYTE
SETOM D11C1 ;FLAG ONE LEFT
JRST CPOPJ1
D11CH1: LDB 16,[POINT 8,D11CHW,27] ;GET 2ND (LEFT) BYTE
SETZM D11C1 ;NEED NEW WORD NEXT TIME
JRST CPOPJ1
;*D11WD - DECTAPE PDP-11 FORMAT WORD READ
D11WD: SOSLE D11W ;ANY DATA LEFT IN BLOCK ?
JRST D11WD1 ;YES
D11WD2: HLRZ BLKNO,DBUF ;SETUP LINK TO NEXT BLOCK
TRNE BLKNO,100000 ;NEGATIVE ?
TRO BLKNO,600000 ;YES, EXTEND SIGN
HRRES BLKNO
MOVEM BLKNO,D11BLK# ;SAVE
JUMPE BLKNO,CPOPJ ;QUIT ON EOF
MOVM BLKNO,D11BLK
CAILE BLKNO,1077 ;LEGAL BLOCK NUMBER ?
JRST BLKERR ;NO
MOVEI A,DBUF ;READ DTA BLOCK INTO DBUF
GO DTABLK
HALT .
SKIPGE D11BLK ;WHICH DIRECTION ?
GO D11SWP ;BACKWARDS, SWAP DATA AROUND
MOVEI VT,377
MOVEM VT,D11W ;SETUP # OF 16 BIT WORDS
MOVE VT,[POINT 18,DBUF,17]
MOVEM VT,D11PNT# ;SETUP BYTE POINTER
D11WD1: ILDB W,D11PNT ;READ A 16 BIT WORD
JRST CPOPJ1
D11SWP: MOVSI N,-100 ;TURN DATA BUFFER OVER
MOVS VT,DBUF(N) ;ALSO SWAPPING WORD HALVES
MOVNI VT1,(N)
EXCH VT,DBUF+177(VT1)
MOVSM VT,DBUF(N)
AOBJN N,.-4
RTN
;*R5VSIX - RAD50 CONVERTER
R5VSIX: SETZM W
MOVE VT2,[POINT 6,W,17]
ANDI VT,177777
IDIVI VT,3100
PUSH P,VT1
GO R5VOU1
POP P,VT
IDIVI VT,50
PUSH P,VT1
GO R5VOU1
POP P,VT
GO R5VOU1
MOVE VT,W
RTN
R5VOU1: IDIVI VT,6
LDB B,R5VOU2(VT1)
IDPB B,VT2
RTN
R5VOU2: POINT 6,R5VTAB(VT),5
POINT 6,R5VTAB(VT),11
POINT 6,R5VTAB(VT),17
POINT 6,R5VTAB(VT),23
POINT 6,R5VTAB(VT),29
POINT 6,R5VTAB(VT),35
R5VTAB: SIXBIT \ ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789?\
SUBTTL DSKLDR DISK PACK LOAD ONLY ROUTINE
;*I/O DEVICE PARAMETERS
DF22B= 20 ;RP10 DF22 BIT MODE BIT
DPC= 250 ;DEVICE CODE FOR RP10
DPC2= 254 ;SECOND RP10
O.SEEK= 4 ;DISK OP FOR RP10 SEEK
O.READ= 0 ;DISK OP FOR RP10 READ
DHX= 270 ;DEVICE CODE FOR RH10/RP04/5/6
DHX2= 274 ;SECOND
DHX3= 360 ;THIRD
DHX4= 364 ;FOURTH
DHX5= 370 ;FIFTH
DHX6= 374 ;SIXTH
DHZ= 540 ;FIRST RH20/RP04/5/6
DHZ2= 544 ;SECOND
DHZ3= 550 ;THIRD
DHZ4= 554 ;FOURTH
DHZ5= 560 ;FIFTH
DHZ6= 564 ;SIXTH
DHZ7= 570 ;SEVENTH
DHZ8= 574 ;EIGHTH
DH.RD= 71 ;DISK OP FOR RH10 READ
DH.WRT= 61 ;DISK OP FOR RH10 WRITE
DF22RH= 4000 ;RH10 DF22 BIT MODE BIT
LOWCMD= 22 ;DF-10 LOCATION
;*FLAGS, LEFT HALF OF F
L.LBK=2 ;LEFT BRACKET
L.CMA=4 ;COMMA
;*FLAGS, RIGHT HALF OF F
R.KDEV=177 ;BITS 29-35, DEVICE CODE
R.TYPE=200 ;TYPE OF UNIT
R.DSKW=400 ;WILD DISK NAME, TRY ALL
R.SRIB=1000 ;NEED TO SKIP A BLOCK (RIB AT START)
;*SYSTEM PARAMETERS, MUST AGREE WITH MONITOR
HOMBK1= 1 ;ADDRESS OF HOME BLOCKS
HOMBK2= ^D10
CODHOM= 707070 ;VERIFICATION CODE OF HOME BLOCK
CODRIB= 777777 ;VERIFICATION CODE OF RIB BLOCK
BLKCOD= 176 ;WORD ADDRESS OF VERIF CODE
BLKSLF= 177 ;WORD ADDRESS OF SELF POINTER
RIBFIR= 0 ;WORD ADDRESS OF RIB AOBJN POINTER
RIBNAM= 2 ;WORD ADDRESS OF NAME OF FILE IN RIB
RIBEXT= 3 ;WORD ADDRESS OF EXT
RIBSIZ= 5 ;LENGTH OF FILE IN WORDS
HOMSNM= 4 ;STRUCTURE NAME IN SIXBIT
HOMLUN= 10 ;LOGICAL UNIT NUMBER (OCT) IN STR
HOMBSC= 14 ;BLOCKS PER SUPERCLUSTER IN HOME BLOCK
HOMSCU= 15 ;SUPERCLUSTERS PER UNIT
HOMCNP= 16 ;POINTER TO CLUSTER COUNT IN A RET PTR
HOMCKP= 17 ;POINTER TO CHECKSUM IN A RET PTR
HOMCLP= 20 ;POINTER TO CLUSTER ADDRESS IN A RET PTR
HOMBPC= 21 ;BLOCKS PER CLUSTER
HOMREF= 23 ;NEED TO REFRESH IF NON-ZERO
HOMCRS= 41 ;LBN IN STR OF CRASH.SAV RIB
HOMMFD= 46 ;LBN IN STR OF MFD RIB
;*ACCUMULATORS
F=0 ;FLAGS
A=1 ;GENERAL AC'S
B=2
C=3
W=4 ;WORD RETURNED BY RWORD OR SIXBRD
NAME=12 ;NAME OF FILE OR UFD BEING SEARCHED FOR
EXT=13 ;EXTENSION
Q=5 ;COUNTER TO STEP THRU BUFFER OF 200 DATA WORDS
S=11 ;COUNTER TO STEP THRU BUFFER OF 200 RIB WORDS
N=6 ;NUMBER ASSEMBLER IN TYPE IN
M=7 ;MEMORY AOBJN PTR, DATA TO CORE
K=14 ;INDEX OF CONTROLLER TYPE
LBN=10 ;LOGICAL BLOCK NUMBER TO READ
;*DSKLD - INITIAL ENTRY TO LOAD FROM DISK PACK
DSKLD: MOVEI 2 ;LDEV = 2
MOVEM LDEVICE
SETZM F ;DISK PACK
GO LOOK ;TRY TO FIND FILE
JRST NFERR ;NOT THERE, FAIL
JRST RFILE ;FOUND FILE
;*RFILE1 - HERE WHEN FILE FOUND
RFILE1: SKIPE LSTFLG
JRST LSTPNT ;LISTING FILE
SKIPE DEVFLG ;READING CMD LIST FILE ?
JRST DEVCM2 ;YES
JRST PRGCOR ;SETUP PROGRAM'S CORE AREA
RFILL1: GO RWORD ;READ POINTER OR TRANSFER WORD
GO ERR2 ;EOF, ERROR
RFILL3: SKIPL M,W ;WHICH IS IT?
JRST STARTQ ;TRANSFER WORD
RFILL2: GO RWORD ;READ DATA WORD
GO ERR2 ;EOF, ERROR
MOVEM W,1(M) ;STORE IT IN CORE
AOBJN M,RFILL2 ;COUNT THE CORE POINTER
JRST RFILL1 ;IT RAN OUT, GET ANOTHER
;*RWORD - READ DATA WORD FROM FILE
RWORD1: MOVE Q,DBUFP ;PREPARE TO COUNT DATA WORDS
SKIPN DEVTYP
AOBJN Q,.+1 ;DECTAPE
RWORD: SKIPE USER
JRST URWD
SKIPE KLDCPF
JRST KLDCPW ;GET KLDCP WORD
JUMPGE Q,RWNXTB ;NEED ANOTHER BLOCK?
MOVE W,(Q) ;NO, GET A WORD
AOBJN Q,.+1 ;COUNT IT
JRST CPOPJ1 ;RETURN
RWNXTB: GO RDDATA ;READ NEXT BLOCK IF ANY
RTN ;EOF
JRST RWORD1 ;READ FROM THIS BLOCK
;*RDDATA - READ NEXT BLOCK OF DATA INTO DBUF
RDDATA: SKIPN DEVTYP
JRST RDDTA ;DECTAPE
RDDSK: SKIPGE LENGTH ;ANY DATA LEFT
RTN ;NO
MOVNI A,200 ;SEE IF ANY LEFT
ADDB A,LENGTH ;COUNT FILE SIZE DOWN
GO SELBLK ;SELECT NEXT DATA BLOCK OF FILE
RTN ;NONE LEFT
MOVSI A,-200
SETZM DBUF(A) ;CLEAR DATA BUFFER
AOBJN A,.-1
MOVEI A,DBUF-1 ;SELECT DATA BUFFER
JRST DSKBLK ;READ THE BLOCK AND RETURN
RDDTA: HLRZ BLKNO,DBUF ;LINK
JUMPE BLKNO,CPOPJ ;JUMP IF END OF FILE
RDDTA1: MOVEI A,DBUF ;SELECT DATA BUFFER
DTABLK: GO PROCBK ;PROCESS A BLOCK
SKIPE SPECIAL
CONO DTC,DTSTOP
JRST CPOPJ1
;*STARTQ - HERE ON TRANSFER WORD
STARTQ: SKIPE USER
RELEASE LDCHN,
SKIPN DEVTYP
CONO DTC,DTSTOP ;STOP DECTAPE
HRRM W,SADR ;SAVE STARTING ADDRESS
TRNN W,-1 ;ANY ADDRESS ?
GO ERR7 ;NO, MUST NOT HAVE RIGHT FILE
SETOM MONTEN ;SET LOADED BY TEN FLAG
MOVEI START ;SETUP RETURN TO DIAMON
MOVEM RETURN
HRRM 120 ;SETUP JOB DATA AREA ALSO
SKIPN PGMGO ;LOAD & GO ?
JRST CPOPJ1 ;NO, BACK TO MONITOR
SKIPE ALTMFLG
RTN ;ALTMODE, RETURN TO LOADER
SADRQ: GO DTECLR ;EXEC & KL10, CLEAR DTE
MOVE A,@SAVEIP
SKIPE USER
SETNAM A, ;USER, IDENTIFY PROGRAM RUNNING
SKIPE JOBREL
JRST .+3
MOVE SVJBREL ;SET JOBREL AS "DIAMON" RUN SIZE
MOVEM JOBREL
GO ZEROAC ;CLEAR AC'S
SETZM 17
SADR: JRST 0 ;YES, GO
;*LOOK - SUBROUTINE TO LOOK FOR FILE
LOOK: MOVS A,DEVICE ;GET DEVICE NAME
SKIPE A ;BLANK
CAIN A,(SIXBIT/DSK/) ;OR JUST DSK?
TROA F,R.DSKW ;YES, FLAG WILD DISK NAME
JRST LOOK1 ;NO, USE SUPPLIED NAME
MOVE A,[SIXBIT/KLAD/] ;START AT KLAD
MOVEM A,DEVICE ;STORE NAME AWAY
JRST LOOK1
LOOK2: MOVEI A,010000 ;INCREMENT WILD DSK NAME
ADDB A,DEVICE
TRNE A,200000 ;TRIED UP TO DSKO?
JRST NOTFN1 ;YES, GIVE UP
LOOK1: MOVE A,DEVICE ;DEVICE NAME TO LOOK FOR
MOVEM A,STRUCT ;TO ARG OF SEARCH ROUTINE
SETZM SLUNIT ;CLEAR LOGICAL UNIT NUMBER
GO FNDUNI ;TRY TO FIND SUCH A UNIT
JRST NOTFND ;NOT THERE
LOOK3: SKIPN NAME,PPN ;FIRST SEARCH FOR THE UFD
MOVE NAME,DIAGPPN ;IF NONE, USE DIAG AREA
MOVSI EXT,(SIXBIT/UFD/) ;EXT IS UFD FOR FILE DIRECTORY
MOVE A,HBUF+HOMMFD ;LBN IN STR OF MFD RIB
GO SRCHFD ;SEARCH FOR REQUESTED UFD
JRST NOTFND ;NOT THERE
SKIPE DDIRFLG
JRST LOOK5 ;DOING DIRECTORY
MOVE NAME,(IP) ;NAME OF FILE TO SEARCH FOR
HLLZ EXT,1(IP) ;EXTENSION
LOOK4: HRRZ A,1(A) ;SUPERCLUSTER ADDRESS OF THE UFD
IMUL A,HBUF+HOMBSC ;MAKE IT A BLOCK NUMBER
GO SRCHFD ;SEARCH FOR THE FILE IN UFD
JRST NOTFND ;NO SUCH FILE
HRRZ LBN,1(A) ;SUPERCLUSTER OF START OF FILE
IMUL LBN,HBUF+HOMBSC ;CONVERT TO LOGICAL BLOCK NUMBER
GO SETRIB ;GET THE RIB, CHECK IT
JRST NOTFND ;NO LUCK, ASSUME FILE NOT THERE
HLLZ B,RBUF+RIBEXT ;GET THE EXTENSION FROM RIB
CAME NAME,RBUF+RIBNAM ;DESIRED NAME?
JRST .+3 ;NO
JUMPE EXT,LOOK6 ;NO EXT GIVEN
CAME B,EXT ;DESIRED EXTENSION?
GO ERR11 ;NO, QUIT. RIB BAD
JRST CPOPJ1 ;SUCCESSFUL RETURN
LOOK5: SETOM DDIRF1 ;SET PRINT DIRECTORY
JRST LOOK4
LOOK6: GO EXTCK ;CHECK FOR "A10" OR "SAV"
GO ERR11 ;NEITHER
JRST CPOPJ1 ;OK
NOTFND: TRNE F,R.DSKW ;WILD DEVICE ARGUMENT
JRST LOOK7 ;YES, INCREMENT IT
NOTFN1: RTN ;NOT FOUND, ERROR RETURN
LOOK7: MOVE A,DEVICE ;DID'NT FIND KLAD
CAME A,[SIXBIT/KLAD/]
JRST LOOK2
MOVE A,[SIXBIT/DSK@/] ;TRY DSKA THRU DSKO
MOVEM A,DEVICE
JRST LOOK2
;*SETRIB - SUBROUTINE TO SETUP A RIB BLOCK AND CHECK IT
SETRIB: GO LBNSEL ;MAKE SURE ON RIGHT UNIT
RTN ;NOT THERE
MOVEI A,RBUF-1 ;ADDRESS OF THE RIB BUFFER
GO DSKBLK ;READ THE FILE'S RIB
RTN ;COULDN'T READ IT
SETZM CLUCNT ;NO CLUSTERS LEFT
SETZM BLKCNT ;NO BLOCKS LEFT IN CLUSTER
MOVE A,RBUF+RIBSIZ ;LENGTH OF FILE
MOVEM A,LENGTH ;SAVE FOR EOF TEST
MOVE A,RBUF+BLKCOD ;CHECK THE CODE WORD
TRO F,R.SRIB ;WANT TO SKIP RIB WHEN READING
MOVE S,RBUF+RIBFIR ;POINTER TO REAL RIB DATA
JRST CPOPJ1 ;SUCCESSFUL RETURN
;*DSKDIR - DISK PACK DIRECTORY ROUTINE
DSKDIR: GO CRLF1
SETZM TABCTR# ;CLEAR ENTRY'S PER LINE COUNTER
SETOM DDIRFLG ;SET DIRECTORY FLAG
SETZM F
GO LOOK ;DO DIRECTORY
JRST SELECT ;DONE
DDIRPNT:MOVE IP,A ;SETUP POINTER
PUSH P,0
SKIPN (IP)
JRST DDIRP1 ;BLANK NAME
MOVE A,(IP) ;PRINT NAME & EXT
GO SIXBP
MOVEI "."
GO PRINT
HLLZ A,1(IP)
GO SIXBP
AOS A,TABCTR ;DONE 8 ENTRIES ON THIS LINE ?
TRNE A,3
JRST .+3 ;NO
GO CRLF1 ;YES, DO CRLF
JRST DDIRP1
GO PNTTAB
ANDI A,3 ;ENTRIES LINE UP ?
IMULI A,^D16 ;COMPUTE AFTER TAB POSITION
CAME A,CHRCTR ;CARRIAGE IN CORRECT PLACE ?
GO PNTTAB ;NO, TAB AGAIN
DDIRP1: POP P,0
MOVE A,IP
JRST SCHN2
;*SRCHFD - SUBROUTINE TO SEARCH A UFD OR MFD FOR FILE & EXT
;* RIB LBN IN STR OF THE FD IN A
SRCHFD: SKIPG LBN,A ;STORE BLOCK TO READ RIB FROM
GO ERR12 ;SHOULDN'T BE EOF
GO SETRIB ;SET UP THE RIB
RTN ;CAN'T READ IT
SCHL1: GO RDDATA ;READ THE FILE DIR DATA FROM THIS FD
RTN ;ERROR RETURN
MOVE A,DBUFP
SKIPE DDIRF1
JRST DDIRP2
SCHL2: SKIPE DDIRF1
JRST DDIRPNT ;PRINT DIRECTORY
MOVE B,(A) ;GET A FILE NAME
CAME B,NAME ;IS NAME RIGHT?
JRST SCHN2 ;NO, MOVE ON
HLLZ B,1(A) ;CHECK THE EXTENSION
JUMPE EXT,SCHL2A ;NO EXT, CHECK FOR "A10" OR "SAV"
CAMN B,EXT ;IS IT RIGHT TOO?
JRST CPOPJ1 ;YES. GOOD RETURN, ANSWER IN (A)
SCHN2: AOBJN A,.+1 ;MOVE ON TO NEXT FILE IN FD
AOBJN A,SCHL2 ;COUNT FILE + EXT, CHECK NEXT FILE IN FD
SCHN1: JRST SCHL1 ;READ ON
SCHL2A: GO EXTCK ;CHECK EXT
JRST SCHN2 ;NO MATCH
JRST CPOPJ1 ;OK
;*LBNSEL - SUBROUTINE TO SELECT CORRECT UNIT FROM LBN
LBNSEL: MOVE A,LBN ;GET DESIRED BLOCK NUMBER
MOVE B,HBUF+HOMBSC ;COMPUTE SIZE OF UNIT
IMUL B,HBUF+HOMSCU
IDIV A,B ;SCALE LBN INTO A UNIT AND LOCAL LBN
MOVE LBN,B ;LBN WITHIN THE UNIT?
CAMN A,HBUF+HOMLUN ;ALREADY AT THIS UNIT?
JRST CPOPJ1 ;YES, NO NEED TO CHANGE UNITS
MOVEM A,SLUNIT ;NO, NEED TO FIND IT
PUSH P,LBN ;SAVE THE LBN WITHIN DESIRED UNIT
GO FNDUNI ;FIND THE UNIT
SOS -1(P) ;NOT THERE, SET FOR NON-SKIP RETURN
POP P,LBN ;RESTORE UNIT LBN
JRST CPOPJ1 ;AND SKIP RETURN
DDIRP2: LDB B,[POINT 6,DBUF,5] ;IF 1ST WORD IS POINTER
CAIN B,77 ;MUST BE SPARE RIB - DONE
RTN
JRST SCHL2
;*SELBLK - SUBROUTINE TO SELECT NEXT BLOCK OF DATA
;* THE DATA IS FOUND USING RIB'S STARTING AT 0(S), OR
;* IF STUFF LEFT OVER FROM CURRENT RIB, VIA CLUCNT,BLKCNT,CLBN
SELBLK: AOS LBN,CLBN ;ASSUME WILL USE NEXT BLOCK
SOSL BLKCNT ;ANY BLOCKS LEFT IN CURRENT CLUSTER?
JRST SEL1 ;YES, GO PICK ONE
SOSL CLUCNT ;ANY CLUSTERS LEFT IN CURRENT RET PTR?
JRST SEL2 ;YES, PICK ONE
SEL4L: SKIPGE S ;FAIL IF OUT OF POINTERS
SKIPN A,RBUF(S) ;NEED ANOTHER RET PTR. EOF YET?
RTN ;YES, FAIL RETURN
AOBJN S,.+1 ;COUNT POINTER FOR NEXT RIB
MOVE C,HBUF+HOMCNP ;GET THE COUNT POINTER
GO RIBBYT ;GET COUNT OF CURRENT RET PTR
JUMPN B,SEL3 ;IF NON-ZERO, GO GET CLUSTER
MOVE C,HBUF+HOMCLP ;NEW UNIT, GET UNIT LOGICAL NUMBER
GO RIBBYT
CAMN B,HBUF+HOMLUN ;IS THIS UNIT RIGHT ALREADY?
JRST SEL4 ;YES, DON'T SEARCH
MOVEM B,SLUNIT ;NO, SAVE LOG UNIT NUMBER FOR SEARCH
GO FNDUNI ;FIND THE UNIT
RTN ;NOT FOUND, ERROR
SEL4: JRST SEL4L ;READ NEXT RIB ON NEW UNIT
SEL3: SUBI B,1 ;COUNT CLUSTER ABOUT TO BE USED
MOVEM B,CLUCNT ;AND SAVE REMAINDER
MOVE C,HBUF+HOMCLP ;GET THE CLUSTER ADDRESS
GO RIBBYT
IMUL B,HBUF+HOMBPC ;CONVERT TO AN LBN
MOVEM B,LBN ;PUT IN CORRECT AC
SEL2: MOVE A,HBUF+HOMBPC ;BLOCKS IN A CLUSTER
SUBI A,1 ;MINUS THE ONE ABOUT TO BE READ
MOVEM A,BLKCNT ;SAVE THIS COUNT
SEL1: MOVEM LBN,CLBN ;SAVE CURRENT LBN
TRZE F,R.SRIB ;SKIP RIB?
JRST SELBLK ;YES, GO THRU THIS ROUTINE AGAIN
JRST CPOPJ1 ;SUCCESSFUL RETURN
;*FNDUNI - SUBROUTINE TO FIND A PARTICULAR LOGICAL UNIT IN THE SYSTEM
;* ARGUMENTS ARE: STRUCTURE NAME (SIXBIT) IN STRUCT
;* : UNIT NUMBER WITHIN STRUCTURE IN SLUNIT
;* SKIP RETURN IF FOUND
FNDUNI: SETZM TTYPE ;CLEAR SEARCH TEMPS
FNDUL1: SETZM TUNIT
FNDUL2: MOVE K,TTYPE ;GET CONTROLLER TYPE
MOVE N,TUNIT ;AND UNIT NUMBER
GO HOME ;TRY TO READ ITS HOME BLOCK
JRST FNDUNX ;NO GOOD, ON TO NEXT
MOVE A,HBUF+HOMSNM ;FOUND THIS UNIT, IS IT DESIRED ONE?
MOVE B,HBUF+HOMLUN
CAMN A,STRUCT ;CHECK AGAINST SUPPLIED ARGS
CAME B,SLUNIT
JRST FNDUNX ;NO GOOD, ON TO NEXT
JRST CPOPJ1 ;CORRECT, SKIP RETURN
FNDUNX: AOS A,TUNIT ;COUNT TO NEXT UNIT ON CONTROLLER
CAIG A,UNIMAX ;TOO BIG?
JRST FNDUL2 ;NO, GO CHECK THIS ONE
AOS A,TTYPE ;YES, COUNT TO NEXT TYPE OF CONTROLLER
CAIG A,TYPMAX ;ALL OF THOSE GONE BY?
JRST FNDUL1 ;NO,TRY THIS ONE
RTN ;ALL TRIED, GIVE FAIL RETURN
RIBBYT: HRRI C,A ;WHERE THE WORD IS
LDB B,C ;GOT THE DESIRED BYTE
RTN ;AND RETURN
;*HOME - SUBROUTINE TO DETERMINE WHETHER A UNIT EXISTS, AND IF SO,
;* READ ITS HOME BLOCK INTO THE HOME BUFFER
;* CALL SEQUENCE:
;* K/ CONTROLLER TYPE INDEX
;* N/ UNIT NUMBER, 0-7
;* GO HOME
;* NOT THERE RETURN
;* OK RETURN
;*AT THIS POINT, ANY NEEDED UNIT PARAMETERS ARE SAVED
;*SUCH AS: R.TYPE & THE HOME BLOCK IN HBUF
HOME: TRZ F,R.TYPE ;ASSUME UNIT TYPE RP02
MOVEM N,CUNIT ;SAVE CURRENT UNIT TYPE
MOVEM K,CTYPE ;SAVE CONTROLLER TYPE
MOVEI C,UNIINI ;ABS ADR OF INI TABLE BASE (ARG FOR SETCHN)
TLO C,K ;SET INDEX FIELD FOR RELOCATION BY K(CONT TYPE)
LDB A,[POINT 7,@C,9] ;CONTROLLER DEVICE CODE FROM INI TABLE
SETZM RH20F#
CAIL A,DHZ ;IS THIS RH20 DEVICE CODE ?
CAILE A,DHZ8
JRST .+4 ;NO
SETOM RH20F ;YES, SET FLAG
SKIPN KLFLG ;ARE WE ON A KL10 ?
RTN ;NO
TRZ F,R.KDEV ;CLEAR CONTROLLER FIELD
TRO F,(A) ;SET CONTROLLER FIELD
MOVEI LBN,HOMBK1 ;WANT TO READ FIRST HOME BLOCK
MOVEI A,DBUF-1 ;BUFFER FOR TEST I/O
GO SETCHN ;SETUP CHAN CMD LIST & INITIALIZE CONTROLLER
RTN ;ERROR, NOT THERE
HOM1: MOVEI A,HBUF-1 ;READ HOME BLOCK INTO ITS BUFFER
GO DSKBLK ;TRY TO READ THE HOME BLOCK
JRST HOM2 ;CAN'T READ THAT ONE
MOVE A,HBUF+BLKCOD ;GET THE CODE WORD
CAIN A,CODHOM ;IS IT RIGHT?
SKIPE HBUF+HOMREF ;AND NOT NEEDING REFRESHING?
JRST HOM2 ;NO GOOD
JRST CPOPJ1 ;OK RETURN
HOM2: CAIN LBN,HOMBK2 ;TRIED BOTH BLOCKS?
RTN ;YES, GIVE FAIL RETURN
MOVEI LBN,HOMBK2 ;NO, TRY ANOTHER ONE
JRST HOM1 ;READ SECOND HOME BLOCK
;*DPCINI - INITIALIZATION FOR PACKS
DPCINI: CAILE N,7 ;LEGAL DRIVE NUMBER?
RTN ;NO, NON-EXISTENT RETURN
SETZM DF22F ;CLEAR DF10 22 BIT MODE FLAG
DPB N,PDRIVE ;SAVE FOR I/O
MOVEI A,37 ;A BAD SURFACE FOR ALL PACKS
DPB A,PSURF ;STORE FOR DATAO
DPB A,PSEC ;STORE FOR DATAO
MOVE C,[DATAO DATAOW] ;SETUP A DATAO TO PACKS
GO IOXCT ;DATAO ON RIGHT DEVICE
GO IOWAIT ;TIMEOUT OR DONE FLAG
JUMPLE B,CPOPJ ;TIMED OUT?
MOVEI A,2000 ;DRIVE NOT THERE?
GO IOCNSZ
RTN ;NOT THERE, ERROR RETURN
MOVE C,[DATAI A]
GO IOXCT
TRNE A,2000
TRO F,R.TYPE ;FLAG AS RP03
MOVE C,[CONI A]
GO IOXCT
TLNE A,DF22B ;IF 22BIT DF10 ?
SETOM DF22F ;SET FLAG
JRST CPOPJ1 ;SUCCESSFUL RETURN
IOWAIT: SETOB A,B ;LOOK FOR ALL FLAG BITS
GO IOCNSO ;ANYTHING THERE?
RTN ;NO SUCH DEVICE AT ALL
MOVEI B,^D50000 ;TIMEOUT
MOVEI A,10 ;DONE FLAG, ALL CONTROLLERS
GO IOCNSO ;LOOK FOR DONE
SOJG B,.-2 ;NOT YET, COUNT DOWN AND LOOP
RTN ;DONE OR TIMED OUT
;*DSKBLK - ROUTINE TO READ A BLOCK FROM THE DEVICE AND UNIT IN
;* CTYPE & CUNIT INTO THE BUFFER AT (A)+1, FROM LOGICAL BLOCK
;* NUMBER IN LBN SKIP RETURN IF SUCCESSFUL, NON-SKIP IF ANY
;* HARDWARE ERRORS
DSKBLK: JSP C,SETCHN ;SETUP CHN CONTROL WORD & CALL PROPER READ ROUTINE
DHXRED ;RH10/RP04/5/6
DHXRED ;SECOND RH10/RP04/5/6
DHXRED ;3RD
DHXRED ;4TH
DHXRED ;5TH
DHXRED ;6TH
DHXRED ;1ST RH20/RP04/5/6
DHXRED ;2ND RH20/RP04/5/6
DHXRED ;3RD RH20/RP04/5/6
DHXRED ;4TH RH20/RP04/5/6
DHXRED ;5TH RH20/RP04/5/6
DHXRED ;6TH RH20/RP04/5/6
DHXRED ;7TH RH20/RP04/5/6
DHXRED ;8TH RH20/RP04/5/6
DPCRED ;RP10
DPCRED ;SECOND RP10
;*UNIINI - INITIALIZE CONTROLLER ROUTINES
; (CONSO IRRELEVANT-USED TO GET DEVICE CODE)
UNIINI: CONSO DHX,DHXINI ;FIRST RH10/RP04/5/6
CONSO DHX2,DHXINI ;SECOND
CONSO DHX3,DHXINI ;3RD
CONSO DHX4,DHXINI ;4TH
CONSO DHX5,DHXINI ;5TH
CONSO DHX6,DHXINI ;6TH
CONSO DHZ,DHZINI ;FIRST RH20/RP04/5/6
CONSO DHZ2,DHZINI ;2ND
CONSO DHZ3,DHZINI ;3RD
CONSO DHZ4,DHZINI ;4TH
CONSO DHZ5,DHZINI ;5TH
CONSO DHZ6,DHZINI ;6TH
CONSO DHZ7,DHZINI ;7TH
CONSO DHZ8,DHZINI ;8TH
CONSO DPC,DPCINI ;FIRST DPC
CONSO DPC2,DPCINI ;SECOND DPC
TYPMAX=.-UNIINI-1 ;MAXIMUM CONTROLLER ROUTINE
UNIMAX=7 ;MAX NUMBER OF UNITS ON A CONTROLLER
;*SETCHN - SUBROUTINE TO SETUP CHANNEL, THEN DISPATCH TO DEVICE
;* DEPENDENT ROUTINE
;* CALL: MOVEI A, ABS ADR OF FIRST DATA WORD-1
;* HRRI C, ABS ADR OF FIRST WORD IN DISPATCH TABLE
;* GO SETCHN
;* ERROR RETURN
;* OK RETURN
SETCHN: MOVEM A,BUFS# ;BUFFER START ADR FOR ECC
AOS BUFS
SKIPE RH20F ;RH20 ?
JRST SETCH1 ;YES
HRLI A,-200 ;MAKE IOWD FOR THE CHANNEL
SKIPE DF22F ;DF10 IN 22BIT MODE ?
HRLI A,<-200_4> ;YES
MOVEM A,CHNCMD ;STORE IT
SETZM CHNCMD+1 ;END OF CHANNEL CMD LIST
MOVEI A,CHNCMD ;SETUP LOW CORE FOR CHANNEL
MOVEM A,LOWCMD
SETZM LOWCMD+1 ;ALSO CLEAR FINAL CONTROL WORD ADDR
SETCMN: SKIPG A,LBN ;GET AND CHECK BLOCK NUMBER
GO ERR13 ;SHOULD BE GT 0
MOVE K,CTYPE ;WHAT CONTROLLER
ADDI C,(K) ;FROM ABS. ADR. OF PROPER DISPATCH TABLE ENTRY
JRST @(C) ;CALL DISPATCH ENTRY
SETCH1: AOS A
TDO A,[1B0!1B1!200B13] ;COMPLETE THE CCW
MOVEM A,CHNCMD ;SAVE IT
MOVE K,CTYPE ;CALCULATE EPT LOC FOR ICWA
LDB K,[POINT 3,UNIINI(K),9] ;GET CHAN NUMBER
LSH K,2 ;MULTIPLY BY 4
PUT 0
MOVE 417 ;SAVE C(417)
MOVEM $SV417#
MOVEI 540000 ;RELOCATE THRU ADR 377000 TO
HRRM 417 ;GET TO RH20 CHANNEL AREA
CONI PAG,0
TRO 0,TRPENB
CONO PAG,@0
MOVEM A,377000(K) ;PUT ICWA IN PHYSICAL MEMORY
MOVE $SV417
MOVEM 417 ;RESTORE C(417)
CONI PAG,0
CONO PAG,@0
GET 0
JRST SETCMN ;TO COMMON CODE
;*DHYINI - INITIALIZATION FOR RH10/RP04/5/6
DHYINI: CAILE N,7 ;SEE IF LAST DRIVE
RTN ;YES, EXIT
SETZM DF22F ;CLEAR DF10 22 BIT MODE FLAG
MOVSI A,60000(N) ;SETUP DRIVE TYPE
GO IODTI ;READ DRIVE TYPE REGISTER
LDB B,[POINT 9,A,35]
MOVE C,[TLNE A,2000]
SKIPE RH20F
MOVE C,[TLNN A,(1B10)]
XCT C
JRST RHINIT ;DRIVE DOESN'T EXIST
CAIL B,20 ;RP04=20, RP05=21, RP06=22, RM01=24
CAILE B,24
RTN ;NO DEVICE OR NOT AN RP04/5/6
MOVSI A,4000(N) ;SELECT CONTROL REGISTER
HRRI A,23 ;PACK ACK COMMAND
GO IODTO
SKIPE RH20F
JRST CPOPJ1 ;DONE IF RH20
MOVE C,[CONI A]
GO IOXCT
TLNE A,DF22RH ;RH10/DF10 IN 22BIT MODE ?
SETOM DF22F ;YES
JRST CPOPJ1
;*DHXINI - RH20/RP04/RP05/RP06 INITIALIZATION
DHZINI: SETOM RH20F
DHXINI: GO RHINIT
JRST DHYINI
RHINIT: MOVEI A,734330 ;INITIALIZE RH10
SKIPE RH20F
MOVEI A,5730 ;INITIALIZE RH20
MOVE C,[CONO @A] ;CLEAR
GO IOXCT
RTN
;*IODTI - RH10/RH20 DATAO/DATAI ROUTINES
IODTI: MOVE C,[DATAO A]
GO IOXCT
TLZA C,100 ;TURN IT INTO A DATAI
IODTO: MOVE C,[DATAO A]
JRST IOXCT
;*DHXRED - READ ROUTINE FOR RH10/RP04/5/6 & RH20/RP04/5/6
;* ENTRY: A/ LOGICAL BLOCK NUMBER
;* N/ DRIVE NUMBER
;* EXIT: +1 FOR ERROR
;* +2 SUCESSFUL
DHXRED: PUSH P,C
MOVE C,[CONO 10] ;CLEAR DONE
SKIPE RH20F
TRO C,400
GO IOXCT
POP P,C
TLO N,DH.RD ;N/ FUNCTION,,DRIVE
IDIVI A,^D380 ;380 SECTORS/CYLINDER
HRLI A,124000(N) ;SELECT DESIRED CYLINDER
GO IODTO
IDIVI B,^D20 ;20 SECTORS/SURF
DPB B,[POINT 5,C,27]
MOVSI A,54000(N)
HRR A,C
GO IODTO ;DESIRED SECTOR, SURFACE
MOVS A,N
SKIPE RH20F ;RH20 ?
TDOA A,[716200,,377700] ;YES
TDO A,[404000,,200000!LOWCMD_6]
GO IODTO ;START THE IO, LOAD RH CNTRL REG
GO IOWAIT
JUMPLE B,CPOPJ
MOVSI A,10000(N)
GO IODTI ;READ STATUS REGISTER
TRNN A,40000 ;COMPOSITE ERROR ?
JRST NODRER ;NO DRIVE ERROR
GO TRYECC ;YES. GO SEE IF CORRECTABLE
RTN ;+1 NOT CORRECTABLE
NODRER: MOVEI A,536320 ;+2 DATA HAS BEEN CORRECTED
SKIPE RH20F ;RH20 ?
MOVEI A,575000 ;YES. GET DIFFERENT STATUS WORD
JRST IOCNSZ ;CHECK FOR ERRORS OTHER THAN EXCEPTION
;* SUBROUTINE TO ATTEMPT TO DO ECC CORRECTION
;* GOT HERE BECAUSE WE GOT A COMPOSITE ERROR IN THE DRIVE, IF
;* DCK=1 AND ECH=0 WE CAN CORRECT USING ECC. THIS ROUTINE LOOKS
;* IN "BUFS" FOR BUFFER STARTING ADDRESS. "BUFS" IS SET UP IN THE
;* "SETCHN" ROUTINE.
;* CALL SEQ:
;* GO TRYECC ;CALL THE ROUTINE
;* RTN+1 ;CAN'T CORRECT
;* RTN+2 ;DATA HAS BEEN CORRECTED IN MEMORY
TRYECC: MOVSI A,020000(N) ;WANT TO READ DRIVE ER1
GO IODTI ;READ IT
TRC A,100000 ;TEST FOR DCK=1 & HCI=0
TRNE A,100100 ; THIS DOES IT
RTN ;NOT CORRECTABLE. EXIT
MOVSI A,160000(N) ;NEED ECC POSITION REGISTER
GO IODTI ;READ IT.
ANDI A,177777 ;SAVE 16 BIT DATA FIELD
SKIPN B,A ;CHECK POS AND GET IT TO B
RTN ;YES. ECC BROKEN. DON'T CORRECT
CAILE A,^D4608+^D32-^D11 ;SEE IF POSITION IS WITHIN RANGE
RTN ;ECC BROKEN. DON'T CORRECT
AOS (P) ;WE CAN CORRECT. ADJUST STACK FOR +2 RTN
SUBI A,1 ;NORMALIZE THE POSITION COUNT
MOVEM A,ECCPOS# ;FOR FUTURE USE
MOVSI A,170000(N) ;WE NEED ECC PATTERN REG
GO IODTI ;READ IT
LDB 0,[POINT 11,A,35] ;GET THE 11 BIT BURST PATTERN
SUBI B,^D4607-^D11 ;SEE IF POSITION EXCEEDS DATA FIELD
JUMPLE B,NORM ;IF + . WE OVERLAP AND MUST ADJ. PATTERN
; MODIFY ECC PATTERN IF CORRECTION SPILLS OVER THE DATA FIELD
LSH 0,^D25(B) ;THROW AWAY APPROPRIATE BITS
MOVNS B,B ;WANT TO SHIFT LEFT NEXT
LSH 0,-^D25(B) ;NOW HAVE CORRECT PATTERN LENGTH
; THE ACTUAL CODE TO CORRECT THE DATA ERROR
NORM: SETZ A, ;AND CLEAR ADJACENT AC
MOVE B,ECCPOS ;GET THE POSITION BACK AGAIN
IDIVI B,^D36 ;GET BUFFER OFFSET PLUS REMAINDER
ADD B,BUFS ;POINTS TO 1ST WORD NEEDING CORRECTION
ROTC 0,(C) ;SLIDE THE PATTERN INTO PLACE
MOVSS 0,0 ;HALVES MUST BE SWAPPED
MOVSS 1,1 ; BECAUSE OF RP0X DATA PATH MAPPING
XORM 0,(B) ;CORRECT THE FIRST WORD
XORM 1,1(B) ;CORRECT THE SECOND WORD
RTN ;THEN EXIT TO RTN-1
;*DPCRED - READ ROUTINE FOR THE DISK PACKS
DPCRED: GO DPCCNV ;CONVERT AND SEEK FOR BLOCK
RTN ;BAD BLOCK NUMBER
MOVEI A,O.READ ;SET OPERATION TO READ BLOCK
JRST DPCOPR ;READ THE BLOCK (CHANNEL ALL SET)
DPCCNV: IDIVI A,12 ;GET SECTOR NUMBER
DPB B,PSEC ;SAVE IT
IDIVI A,24 ;GET SURF AND CYL
DPB B,PSURF ;STORE SURFACE
DPB A,PCYL ;STORE CYLINDER
HRRZI B,200000
TRZE A,400
IORM B,DATAOW ;EXTEND CYL ADR IF RP03
MOVE N,CUNIT ;CURRENT UNIT
DPB N,PDRIVE ;STORE THAT TOO
TRNN F,R.TYPE
CAIG A,^D202
CAILE A,^D405 ;MAKE SURE CYLINDER IS ON DISK?
GO ERR14 ;TOO BIG A LBN
MOVEI A,O.SEEK ;MAKE DISK SEEK TO THE CYLINDER
DPCOPR: DPB A,OPPNT ;STORE THE OPERATION
MOVE C,[DATAO CLRATN] ;SETUP DATAO?
GO IOXCT ;DO DATAO WITH RIGHT DEVICE
HRRI C,DATAOW ;NEW ADDRESS
XCT C ;SEND THIS WORD TOO
;*DPCWAT - SUBROUTINE TO WAIT FOR I/O AND CHECK ERRORS
DPCWAT: GO IOWAIT ;WAIT FOR DONE FLAG OR TIMEOUT
JUMPLE B,CPOPJ ;IF TIMED OUT, GIVE UP
MOVEI A,177720 ;ANY ERRORS
IOCNSZ: SKIPA C,[CONSZ (A)] ;SETUP I/O INST
IOCNSO: MOVSI C,(CONSO (A)) ;SETUP I/O INST
IOXCT: DPB F,[POINT 7,C,9] ;PUT IN I/O DEVICE FIELD
XCT C ;DO THE I/O
RTN ;NO SKIP RETURN
JRST CPOPJ1 ;SKIP RETURN
PDRIVE: POINT 3,DATAOW,5 ;DRIVE NUMBER FOR DATAO
PCYL: POINT 8,DATAOW,13 ;CYLINDER NUMBER
PSURF: POINT 5,DATAOW,18 ;SURFACE NUMBER
PSEC: POINT 5,DATAOW,23 ;SECTOR NUMBER
OPPNT: POINT 3,DATAOW,2 ;OPERATION
DBUFP: -200,,DBUF ;POINTER TO DATA BLOCK
CLRATN: 500000,,776 ;CLEAR ATTENTION FLAGS
DATAOW: LOWCMD ;LOW CORE ADDRESS FOR DF10
PPNPTR: POINT 6,W ;POINTER FOR PPN INPUT
DIAGPPN: 6,,10 ;DEFAULT FOR DIAG AREA ??
;*ERROR - ERROR REPORTING
ERROR: SETZM RCOVRY#
PUSH P,1
GO CRLF1
POP P,1
GO SIXBP
PMSG < ERROR AT >
MOVE 0,(P)
SOS
GO PNTOCT ;PRINT PC OF ERROR
SKIPN RCOVRY ;ATTEMPT RECOVERY ?
JRST ERR1 ;NO, CONSULT LISTING FOR ERRORS
SKIPN PTFLG ;PAPER TAPE ?
JRST ERR1 ;NO
POP P,0 ;RESTORE STACK
PMSG <^BACKUP TAPE TO ATTEMPT RECOVERY, TYPE CR WHEN READY^>
TTICHR
CAIE 12
JRST .-2
JRST LDPROC
;*NFERR1 - PROGRAM NOT FOUND ERROR
NFERR1: PMSG <^PROGRAM NOT FOUND - >
GO NAMPNT
RTN
;*ERROR REPORT MESSAGES
LERR2: MOVE A,[SIXBIT/ILLEOF/]
SETOM RCOVRY
JRST ERROR+1
LERR3: MOVE A,[SIXBIT/FLTYPE/]
JRST LERR2+1
LERR4: MOVE A,[SIXBIT/FORMAT/]
JRST LERR2+1
LERR5: MOVE A,[SIXBIT/CKSUM/]
JRST LERR2+1
ERR2: MOVE A,[SIXBIT/ILLEOF/]
JRST ERROR
ERR3: MOVE A,[SIXBIT/FLTYPE/]
JRST ERROR
ERR4: MOVE A,[SIXBIT/FORMAT/]
JRST ERROR
ERR5: MOVE A,[SIXBIT/CKSUM/]
JRST ERROR
ERR6: MOVE A,[SIXBIT/1STPTR/]
JRST ERROR
ERR7: MOVE A,[SIXBIT/STADR/]
JRST ERROR
ERR8: MOVE A,[SIXBIT/OPEN/]
JRST ERROR
ERR9: MOVE A,[SIXBIT/RDERR/]
JRST ERROR
ERR10: MOVE A,[SIXBIT/CORE/]
JRST ERROR
ERR11: MOVE A,[SIXBIT/BADRIB/]
JRST ERROR
ERR12: MOVE A,[SIXBIT/RIBEOF/]
JRST ERROR
ERR13: MOVE A,[SIXBIT/BLKNBR/]
JRST ERROR
ERR14: MOVE A,[SIXBIT/CYLNBR/]
JRST ERROR
SUBTTL STORAGE ASSIGNMENTS
LIT
VAR
PGNAME: SIXBIT /DIAMON/ ;PROGRAM NAME
PLIST: BLOCK 40 ;PUSH LIST
PGMGO: 0 ;LOAD & GO FLAG
TAPEPF: 0 ;PRINT TAPE FLAG
DEVFLG: 0 ;CMD LIST FROM DEVICE FLAG
DINFLG: 0 ;DEVICE IN FLAG
LPTFLG: 0 ;LINE PRINTER FLAG
LSTFLG: 0 ;LISTING FLAG
DDIRFLG:0 ;DISK DIRECTORY FLAG
DDIRF1: 0
ALTMFLG:0 ;ALTMODE FLAG
CLKFLG: 0
USRFLG: 0
CNSFLG: 0
MGNONC: 0
MGNCNT: 0
MGNWRD: 0
MGNADR: 0
RACKF: 0
SCFLAG: 0 ;PROCESSING COMMENT FLAG
DEVTYP: 0 ;DEVICE TYPE INDICATOR
DF22F: 0 ;22BIT DF10 FLAG
SAVEP: 0 ;PUSHDOWN POINTER SAVE
SAVEIP: 0 ;COMMAND LIST POINTER SAVE
RUNCTL: 0 ;RUN CONTROL
CHRCTR: 0 ;PRINT CHAR COUNTER
SAVAC0: 0 ;AC SAVE
SAVAC1: 0 ; "
SAVAC2: 0 ; "
FCRCNT: 0 ;CR FILLER COUNT
FLFCNT: 0 ;LF FILLER COUNT
LENGTH: 0 ;LENGTH OF DATA
STRUCT: 0 ;STRUCTURE
SLUNIT: 0 ;LOGICAL UNIT
BLKCNT: 0 ;BLOCK COUNT
CLBN: 0 ;CURRENT LBN
CLUCNT: 0 ;CURRENT CLUSTER COUNT
TAPENO: ;CURRENT TAPE NUMBER
TTYPE: 0 ;TEMP TYPE
DIRSRC: ;SEARCH TAPE NUMBER
TUNIT: 0 ;TEMP UNIT
DOSRCH: ;PRESENTLY DOING SEARCH FLAG
CTYPE: 0 ;CURRENT TYPE
SRCHF: ;DECTAPE SEARCH FLAG
CUNIT: 0 ;CURRENT UNIT
DEVICE: 0 ;DISK NAME
PPN: 0 ;PROJ-PROG NO.
SELSTR: ;COMMAND SELECTION STORE
LDCNT: 0 ;A10 LOAD COUNT
LDADR: 0 ;A10 LOAD ADDRESS
LDATA: BLOCK ^D34-16 ;A10 DATA STORAGE
ACSAVE: BLOCK 16
LDATAE: 0 ;A10 END OF DATA STORAGE
0
LDNAME: SIXBIT/NAME/
SIXBIT/EXT/
0
0
LDBLK: 13
SIXBIT/DSK/
LDBUF
LDBUF: BLOCK 3
INLIST: 0
SUBTTL SPECIAL STARTUP MESSAGES AND INITIALIZATION
;*HEADER
DEFINE PTITLE (MCNVER,DECVER) <
ASCIZ %
* DIAMON [DDQDC] - DECSYSTEM DIAGNOSTIC MONITOR - VER MCNVER'.'DECVER *
%>
HEADER: PTITLE \MCNVER,\DECVER
;*HELP
HELP: ASCIZ %
NORMAL START = 20000
RESTART/ABORT = 20001
PRINT TEST TITLE = 20002
RESTART CURR TEST = 20003
DEVICES;
T=PAPER TAPE, K=KLDCP, D=DTA, V=11DTA, P=DISK PACK
COMMANDS;
STD=START DIAGNOSTIC
STM=REINITIALIZE START
STL=START LOADER
START=START DIAGNOSTIC
SFSTRT=SPECIAL FEATURE START
PFSTRT=POWER FAIL START
REE=REENTER
DDT=DDT
START1=SPECIAL START 1
START2=SPECIAL START 2
START3=SPECIAL START 3
START4=SPECIAL START 4
START5=SPECIAL START 5
R=RESELECT, X=XPN, I=INTERNAL, T=TTY, D=DEVICE,
S=SINGLE, F=DIR, L=LIST, G=GO
%
;*TYBAUD - COMPUTE CR & LF FILLERS REQUIRED FOR DIFFERENT BAUD RATES
TYBAUD: SKIPE USER
RTN
MOVEI 1,60
CONO APR,1000 ;CLEAR AND WAIT FOR CLOCK
CONSO APR,1000
JRST .-1
CONO APR,1000
SETZB 0,2
TYBD1: DATAO TTY,2 ;COUNT # OF CHARS SENT IN 1 SEC
AOS
TYBD2: CONSO TTY,10
JRST TYBD3
JRST TYBD1 ;TTY DONE, SEND ANOTHER CHAR
TYBD3: CONSO APR,1000 ;HAS CLOCK TICKED ?
JRST TYBD2 ;NO
CONO APR,1000 ;YES, COUNT DOWN JIFFIES
SOJGE 1,TYBD2
TYBD4: CONSO TTY,10 ;WAIT TILL TTY GETS DONE
JRST .-1
MOVEI 1,5 ;5 = 2400 BAUD
CAIG 0,^D122
SOS 1 ;4 = 1200 BAUD
CAIG 0,^D62
SOS 1 ;3 = 600 BAUD
CAIG 0,^D32
SOS 1 ;2 = 300 BAUD
CAIG 0,^D16
SOS 1 ;1 = 150 BAUD
CAIG 0,^D12
SOS 1 ;0 = 110 BAUD
MOVEM 1,TTYSPD ;SAVE
TYBD5: SETZM 2
CAIN 1,5
MOVEI 2,4 ;4 FILLERS @ 2400
CAIN 1,4
MOVEI 2,2 ;2 FILLERS @ 1200
CAIN 1,3
MOVEI 2,1 ;1 FILLER @ 600
MOVEM 2,FCRCNT ;FOR CR
MOVEM 2,FLFCNT ;FOR LF
CAIE 1,2 ;IF 300 BAUD
RTN
MOVEI 2,^D9 ;USE 9 FILLERS FOR CR
MOVEM 2,FCRCNT ;IN CASE LA30
RTN
END JRST ONETIM