CONSTSTRING (15) VSN="7A 19/10/82"
! AMENDMENT RECORD
!****************
! VSN 7A dated 19th November 1982
! 1) Restart stack lengthened to X'1800'
! (to allow greater 'CALL' depth for auto IPL)
! ( S series writeout may encroach onto LP buffer)
! 2) PST moved to segment 11
! 3) ISTs in segments 0-3
!
! VSN 6E DATED 23/10/81
! 1) AMENDED FOR IMP80
!
! VSN 6D DATED 30/3/81
! 1) IST MOVED TO RA X8200
! (ALLOWS 16 ENTRIES FOR "S" SERIES VECTORED INTERRUPTS)
!
! VSN 6C DATED 11/2/81
! 1) SYSERRS MASKED ON ENTRY TO CHOPSUPE
! (IN CASE OF SUCCESSFUL RETRY)
!
! VSN 6B DATED 19/09/80
! 1) RESTART STACK MOVED FROM RA X1800 TO X3000
! LENGTH SHORTENED TO 4K
! (DUAL OCP PHOTO USES X1800)
! 2) 'PARM' VALUES PRESERVED
!
! VSN 6A DATED 26/06/80
! 1) MAIN DBOOT CODE NOW AT X'14000' - X'15000'
! 2) 1ST CHOPSUPE CODE CHUNK AT X'15000'
! 3) DBOOT DESCRIPTOR SET UP TO ADDRESS & LENGTH OF OVERLAYS
!
! VSN 5G DATED 25MAR80
! 1) LNB SF AND PSTB FOR BOOT LOADER NOT NOW SET UP
! THIS IS FOR DBOOT15S&SEQ (MAPLE WRITTEN VSNS)
! VSN 5F DATED 9TH NIV79
! 1) INCREASE IN PST FOR 16 SMACS
! VSN 5E DATED 06/08/79
! 1) CODE ADDED TO DETECT UNUSED EXTERNAL PROCEDURES
! 2) CODE ADDED TO ACCEPT MICROPROGRAM AS A FILE NAME
! 3) MUCH HISTORIC MATERIAL DELETED
!
! VSN 5D DATED 12/12/78
! 1) PST CORRECTED TO 255 SEGMENNT AND BASED ON CONSTINTEGERS
! 2) POST MORTEM SEGMENT INITIALISE ABANDONED
! 3) HEADER OF 'CHOPIPL' IS CORRECT USEFULE LENGTH
! 4) NEW MPROG REMOVED TO SEPARATE FILE
! 5) ABLE TO WORK WITHOUT AN OCP MICROPROGRAM FILE
! 6) CODE FIXUPS PERMITTED WITHOUT "FUNNY RELOC" MESSAGE
!*
! OCP MICROPROGRAM & MICROPROGRAM OVERLAYS RESIDE IN FILE OCPMPRG
! VERSION:- "MP7000P0070C" WITH PATCHES 1-C
!*
! PUBLIC SEGMENT TABLE LAYOUT
! ==========================
! 0-4 ISTs for up to 4 processors
! 4&5 SUPERVISOR STACK +SSN+1
! 6&7 RESTART STACK & SSN+1
! 8 SUPERVISOR CODE
! 9 SUPERVISOR GLA
! 10 TEMP COMMS AREA FOR GROPE
! 11 Public segment table
! 12 UP FREE FOR GLOBAL TABLES
! 20 EXTENDABLE SEGMENT FOR PARAM TABLE
! 21 & 22 EXTENDABLE PAIR OF SEGMENTS FOR AMT & POINTERS
! 23 Store table (extensible)
! 44 CHOPSUPE CODE
! 45 CHOPSUPE GLA
! 46&47 STACK & SSN+1 FOR CHOPSUPE
! 48 COMMUNICATION SEGMENT FOR CONFIGURATION DETAILS
! 49-63 DEVICE COMMS AREA QUEUE SPACE ETC
! 64 UP VIRTUAL-REAL MAPPINGS
SYSTEMROUTINESPEC PSYSMES(INTEGER ROOT, FLAG)
RECORDFORMAT CONRECF(INTEGER CONAD, FILETYPE, RELSTART, RELEND)
SYSTEMROUTINESPEC CONNECT(STRING (31) S, C
INTEGER M, H, P, RECORD (CONRECF)NAME R, INTEGERNAME F)
SYSTEMROUTINESPEC MOVE(INTEGER LEN, FROM, TO)
EXTERNALSTRINGFNSPEC DATE
EXTERNALSTRINGFNSPEC TIME
EXTERNALROUTINESPEC PARM(STRING (255) S)
SYSTEMROUTINESPEC PHEX(INTEGER I)
SYSTEMROUTINESPEC OUTFILE(STRING (31) F, C
INTEGER S, H, P, INTEGERNAME C, F)
RECORDFORMAT OBJF(INTEGER NEXTFREEBYTE, CODERELST, PSIZE, C
FILETYPE, SUM, DATETIME, LDRELST, OFM)
EXTERNALROUTINESPEC DEFINE(STRING (63) S)
EXTERNALROUTINESPEC COPY(STRING (63) S)
EXTERNALROUTINESPEC DESTROY(STRING (63) S)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER N)
CONSTINTEGER MAXSEG=32
!
!
INTEGERFN NWFILEAD(STRING (15) S,INTEGER PGS)
INTEGER I,FLAG
FLAG=1
IF 0<LENGTH(S)<=15 THEN OUTFILE(S,PGS<<12,X'40000',0,I,FLAG)
IF FLAG#0 START
SELECT OUTPUT(0)
PRINTSTRING("OUTFILE flag for ".S." =")
WRITE(FLAG,1)
I=0
STOP
FINISH
RESULT =I
END ; ! NWFILEAD
INTEGERFN RDFILEAD(STRING (63) S)
RECORD (CONRECF) R
INTEGER I,FLAG
! CONNECT IN A SUITABLE MODE
FLAG=1
R=0
IF 0<LENGTH(S)<=31 THEN CONNECT(S,0,X'40000',0,R,FLAG)
IF FLAG#0 THEN START
SELECT OUTPUT(0)
PRINTSTRING("
Connect of ".S." fails, flag =")
WRITE(FLAG,1)
NEWLINE
FINISH
I=R_CONAD
I=0 IF FLAG#0
RESULT =I
END ; ! RDFILEAD
INTEGERFN WRFILEAD(STRING (31) S)
RECORD (CONRECF) R
INTEGER I,FLAG
! CONNECT IN WRITE MODE
FLAG=1
R=0
IF 0<LENGTH(S)<=31 THEN CONNECT(S,3,X'40000',0,R,FLAG)
IF FLAG#0 THEN START
SELECT OUTPUT(0)
PRINTSTRING("Connect of ".S." fails, flag =")
WRITE(FLAG,1)
NEWLINE
STOP
FINISH
I=R_CONAD
I=0 IF FLAG#0
RESULT =I
END ; ! WRFILEAD
ROUTINE FIX(STRING (31) IN, OUT, C
INTEGER CODESTART, GLASTART)
!THIS VERSION BASED ON FIX USED BY SUPFIX ETC. AS AT 28/8/78
!**** RECORD FORMATS ****
RECORDFORMAT RF(INTEGER AREALOC, BASELOC)
RECORDFORMAT RELF(INTEGER LINK, N, RECORD (RF)ARRAY R(1:1000))
RECORDFORMAT OFMF(INTEGER START, L, PROP)
RECORDFORMAT CENTF(INTEGER LINK, LOC, STRING (31) IDEN)
RECORDFORMAT DENTF(INTEGER LINK, DISP, L, A, C
STRING (31) IDEN)
RECORDFORMAT CREFF(INTEGER LINK, REFLOC, STRING (31) IDEN)
RECORDFORMAT DREFF(INTEGER LINK, REFARRAY, L, C
STRING (31) IDEN)
INTEGER AREACODE, AREADISP, BASECODE, BASEDISP, N, DR0, DR1
INTEGER UNSATCODE, UNSATDATA, RLINK
INTEGER FLAG, INBASE, OUTBASE, LOC, I, LINK, LEN, AD, REFARRAY
INTEGERARRAY BASE(1:7); !AREA START ADDRESSES IN FILE 'OUT'
INTEGERARRAY LBASE(1:7); !AREA START ADDRESSES WHEN LOADED
INTEGERARRAYFORMAT LDATAAF(0:14)
INTEGERARRAYFORMAT REFLOCAF(1:1000)
INTEGERARRAYNAME LDATA, REFLOC
RECORD (CENTF)NAME CENT
RECORD (DENTF)NAME DENT
RECORD (OFMF)ARRAYFORMAT OFMAF(1:7)
RECORD (OFMF)ARRAYNAME OFM
RECORD (CREFF)NAME CREF
RECORD (DREFF)NAME DREF
RECORD (RELF)NAME REL
RECORD (CONRECF) RR
STRING (31) IDEN
ROUTINESPEC FAIL(STRING (100)S)
ROUTINESPEC FINDCODEEP(STRING (31) ENTRY,INTEGERNAME DR0,DR1,FLAG)
ROUTINESPEC FINDDATAEP(STRING (31) ENTRY,INTEGERNAME AD, FLAG)
PRINTSTRING("FIX called at ".TIME." on ".DATE)
NEWLINES(2)
PRINTSTRING("Input: ".IN)
NEWLINE
PRINTSTRING("Output: ".OUT)
NEWLINE
PRINTSTRING("Codestart: ")
PHEX(CODESTART+32)
NEWLINE
PRINTSTRING("Glastart: ")
PHEX(GLASTART)
NEWLINES(2)
UNSATCODE=0
UNSATDATA=0
CONNECT(IN,0,0,0,RR,FLAG); !CONNECT INPUT FILE - READ
->ERR IF FLAG#0
IF INTEGER(RR_CONAD+12)#1 THEN FAIL("INVALID FILETYPE")
INBASE=RR_CONAD
LEN=RR_RELEND
OUTFILE(OUT,LEN+4096,0,0,OUTBASE,FLAG)
->ERR IF FLAG#0
MOVE(LEN,INBASE,OUTBASE); !COPY FILE TO 'OUT'
LDATA==ARRAY(INBASE+INTEGER(INBASE+24),LDATAAF)
!LOAD DATA
OFM==ARRAY(INBASE+INTEGER(INBASE+28)+4,OFMAF)
!OBJECT FILE MAP
CYCLE I=1,1,5
BASE(I)=OUTBASE+OFM(I)_START
REPEAT
LBASE(1)=OFM(1)_START+CODESTART; !START OF LOADED CODE
LBASE(2)=GLASTART; !START OF LOADED GLA
LBASE(4)=OFM(4)_START+CODESTART; !START OF LOADED SST
LBASE(5)=OFM(2)_L+GLASTART; !START OF LOADED UST
!NOW GO THROUGH CODE REFS FILLING IN INFO
LINK=LDATA(7); !STATIC CODE REFS
WHILE LINK#0 CYCLE
CREF==RECORD(LINK+INBASE)
FINDCODEEP(CREF_IDEN,DR0,DR1,FLAG)
LOC=BASE(CREF_REFLOC>>24)+CREF_REFLOC&X'FFFFFF'
INTEGER(LOC)=DR0
INTEGER(LOC+4)=DR1
LINK=CREF_LINK
REPEAT
!NOW DEAL WITH DATA REFS
LINK=LDATA(9)
WHILE LINK#0 CYCLE
DREF==RECORD(LINK+INBASE)
REFARRAY=(DREF_REFARRAY&X'7FFFFFFF')+INBASE
!AND OFF COMMON BIT
N=INTEGER(REFARRAY)
REFLOC==ARRAY(REFARRAY+4,REFLOCAF)
FINDDATAEP(DREF_IDEN,AD,FLAG)
CYCLE N=1,1,N
LOC=BASE(REFLOC(N)>>24)+REFLOC(N)&X'FFFFFF'
INTEGER(LOC)=INTEGER(LOC)+AD
REPEAT
LINK=DREF_LINK
REPEAT
! NOW DEAL WITH RELOCATION REQUESTS
LINK=LDATA(14)
WHILE LINK#0 CYCLE
REL==RECORD(LINK+INBASE)
CYCLE N=1,1,REL_N; !NO OF RELOCATION ENTRIES IN THIS BLOCK
AREACODE=REL_R(N)_AREALOC>>24
AREADISP=REL_R(N)_AREALOC&X'FFFFFF'
BASECODE=REL_R(N)_BASELOC>>24
BASEDISP=REL_R(N)_BASELOC&X'FFFFFF'
LOC=BASE(AREACODE)+AREADISP
INTEGER(LOC)=INTEGER(LOC)+LBASE(BASECODE)+BASEDISP
REPEAT
LINK=REL_LINK
REPEAT
!
! NOW PRINT MAP OF ENTRY POINTS
!
NEWLINES(2)
PRINTSTRING("Name entry point")
NEWLINES(2)
LINK=LDATA(1); !HEAD OF CODE EP LIST
WHILE LINK#0 CYCLE
CENT==RECORD(INBASE+LINK)
PRINTSTRING(CENT_IDEN)
SPACES(32-LENGTH(CENT_IDEN))
LOC=BASE((CENT_LOC>>24)&X'F')+CENT_LOC&X'FFFFFF'
PHEX(INTEGER(LOC+4))
NEWLINE
LINK=CENT_LINK
REPEAT
!NOW PRINT MAP OF DATA ENTRIES IF ANY
LINK=LDATA(4); !HEAD OF DATA EP LIST
IF LINK#0 START
NEWLINES(2)
PRINTSTRING( C
"Name length address")
NEWLINES(2)
WHILE LINK#0 CYCLE
DENT==RECORD(INBASE+LINK)
PRINTSTRING(DENT_IDEN)
SPACES(32-LENGTH(DENT_IDEN))
WRITE(DENT_L,10)
SPACES(5)
PHEX(LBASE(DENT_A)+DENT_DISP)
NEWLINE
LINK=DENT_LINK
REPEAT
FINISH
SELECTOUTPUT(0)
!NOW CHECK FOR UN-USED ENTRIES
LINK=LDATA(1); !LIST HEAD OF CODE ENTRIES
WHILE LINK#0 CYCLE
CENT==RECORD(INBASE+LINK)
IDEN=CENT_IDEN
RLINK=LDATA(7); !HEAD OF CODE REF LIST
WHILE RLINK#0 CYCLE
CREF==RECORD(INBASE+RLINK)
EXIT IF IDEN=CREF_IDEN; !ENTRY IS USED
RLINK=CREF_LINK
REPEAT
IF RLINK=0 AND IDEN#"ENTER" START ; !ENTRY IS NOT REFERENCED
PRINTSTRING("**Warning - procedure ".IDEN. C
" not used")
NEWLINE
FINISH
LINK=CENT_LINK
REPEAT
IF UNSATCODE=0=UNSATDATA START
PRINTSTRING("All refs filled")
NEWLINE
FINISH ELSE START
IF UNSATCODE>0 START
WRITE(UNSATCODE,1)
PRINTSTRING(" Unsatisfied code references")
NEWLINE
FINISH
IF UNSATDATA>0 THEN START
WRITE(UNSATDATA,1)
PRINTSTRING(" Unsatisfied data references")
NEWLINE
FINISH
FINISH
NEWLINE
ERR:
SELECTOUTPUT(0)
IF FLAG#0 THEN PSYSMES(1000,FLAG)
RETURN
ROUTINE FAIL(STRING (100) S)
SELECTOUTPUT(0)
PRINTSTRING("Failure in FIX - ".S)
STOP
END ; !OF FAIL
ROUTINE FINDCODEEP(STRING (31) ENTRY, INTEGERNAME DR0, DR1, FLAG)
INTEGER LINK
RECORD (CENTF)NAME CENT
LINK=LDATA(1)
WHILE LINK#0 CYCLE
CENT==RECORD(INBASE+LINK)
IF ENTRY=CENT_IDEN START
DR0=X'B1000000'
DR1=LBASE((CENT_LOC>>24)&X'F')+CENT_LOC&X'FFFFFF'
FLAG=0
RETURN
FINISH
LINK=CENT_LINK
REPEAT
PRINTSTRING("Unsat ref ".ENTRY)
NEWLINE
FLAG=1
DR0=M'NORT'; !USEFUL FOR DIAGNOSING FAULTS
MOVE(4,ADDR(ENTRY)+1,ADDR(DR1)); !FIRST FOUR BYTES OF ENTRY NAME
DR1=X'54524546'
UNSATCODE=UNSATCODE+1
END ; !OF FINDCODEEP
ROUTINE FINDDATAEP(STRING (31) ENTRY, INTEGERNAME AD, FLAG)
INTEGER LINK
RECORD (DENTF)NAME DENT
LINK=LDATA(4)
WHILE LINK#0 CYCLE
DENT==RECORD(INBASE+LINK)
IF ENTRY=DENT_IDEN START
AD=LBASE(DENT_A)+DENT_DISP
FLAG=0
RETURN
FINISH
LINK=DENT_LINK
REPEAT
PRINTSTRING("Unsat data ref ".ENTRY)
NEWLINE
AD=0; !NULL VALUE
FLAG=1
UNSATDATA=UNSATDATA+1
END ; !OF FINDDATAEP
END ; !OF FIX
EXTERNALROUTINE CHOPFIX(STRING (63) S)
ROUTINESPEC ST ENTRY(INTEGERARRAYNAME ST, C
INTEGER SEGNO, SLAVED, SEGLIMBYTES, RA, EXECBIT, WACR, RACR)
ROUTINESPEC HEAD(STRING (71) S)
ROUTINESPEC PSTRG0(STRING (255) S)
ROUTINESPEC MULSYM(INTEGER SYM, MUL)
INTEGERFNSPEC FIND EP(INTEGER FILEADDR, STRING (31) S)
ROUTINESPEC TREAT BLOCK(INTEGER AD)
INTEGER OFM, GLARELST
RECORDFORMAT LDATF(INTEGER PTRS, PROCENTS, Z2, Z3, DATENTS, C
Z5, TOSREFS, PROCREFS, DPROCREFS, DATREFS, Z10, Z11, C
SRCFNAME, Z13, RELOCRQS)
RECORDFORMAT L1F(INTEGER LINK, REFLOC, STRING (31) IDEN)
RECORD (L1F)NAME LIST1
RECORD (LDATF)NAME LDAT
!----------------------------------- CONSTS - SEGMENT ALLOCATIONS ETC.---
CONSTINTEGER TOPPSEG=X'213F'; ! PUBLIC 319 (64+SMACS 0-F)
CONSTINTEGER TOPLSEG=8
CONSTINTEGER SLAVED=0, NONSLAVED=X'20000000'
CONSTINTEGER LST RA=X'8080'
CONSTINTEGER PSTBLKNO=2
CONSTINTEGER PST RA=X'8400'
CONSTINTEGER INF BLK RA=X'8000'
CONSTINTEGER IST RA=X'8200'
CONSTINTEGER VR MAP SEG=0; ! MAPS VIRTUAL TO REAL
CONSTINTEGER PUBLIC0=8192
CONSTINTEGER PSTVSEG=PUBLIC0+11
CONSTINTEGER LAST PUB SEG=TOPPSEG-X'2000'
CONSTINTEGER IST0=PUBLIC0
CONSTINTEGER IST1=PUBLIC0+1
CONSTINTEGER IST2=PUBLIC0+2
CONSTINTEGER IST3=PUBLIC0+3
! USE SEGS AS FOLLOWS:-
! SEG 44 FOR CHOPSUPCODE
! SEG 45 FOR GLA
! SEG 46 FOR STACK
! SEG 47 FOR SSN+1
CONSTINTEGER CODESEG=PUBLIC0+44
CONSTINTEGER GLASEG=PUBLIC0+45
CONSTINTEGER UNDUMPSEG=PUBLIC0+47
CONSTINTEGER STACKSEG=PUBLIC0+46
CONSTINTEGER PUBLIC7=PUBLIC0+7
CONSTINTEGER PUB7 SIZE=X'200'; ! BYTES
CONSTINTEGER RES STKSEG=PUBLIC0+6; ! restart stack
CONSTINTEGER RES STK RA=X'3000'
CONSTINTEGER RES STK SIZE=X'1800'
! STACK SHOLD NOT EXCEED 255 PGS, SEE PLI 4.2.4.1, SHEET 42
CONSTINTEGER STACKSIZE=X'3FC00'; ! 255K BYTES
CONSTINTEGER DISCCA SEG=PUBLIC0+10
CONSTINTEGER DISCCA SIZE=X'400'
CONSTINTEGER REAL0 SEG=PUBLIC0+64; ! maps to RA 0
CONSTINTEGER REAL0 SIZ=X'40000'
! LOCAL SEGMENT NUMBERS ........................................
CONSTINTEGER DRDR0=X'B0000000'; ! 1ST WORD OF A DESCRIPTOR DESCRIPTOR
CONSTINTEGER GLACODE=2
CONSTLONGINTEGER OVERLAY DESCR=X'1800400000004000'; !FOR DBOOT
INTEGERARRAYFORMAT PSTF(0:2*LAST PUB SEG)
INTEGERARRAYFORMAT LSTF(0:255)
INTEGERARRAYNAME PST, LST
INTEGERARRAYNAME PCA ST
RECORDFORMAT REGF(INTEGER LNB, PSR, PC, SSR, SF, IT, IC, LTB)
RECORD (REGF)ARRAYFORMAT ISTF(0:11); ! 12*32=384(DEC) OR X180 BYTES
RECORD (REGF)ARRAYNAME IST
OWNINTEGERARRAY INFO BLOCK(0 : 255) = C
0(224),M'INFO'(32); ! 256 WORDS = 1024 BYTES
OWNINTEGERARRAY PSTBLK(0 : 2*LAST PUB SEG+1)=0(2*LAST PUB SEG+2)
! ANOTHER 2K BYTES
OWNINTEGERARRAY ZERBLK(0 : 255) = 0(256)
OWNINTEGERARRAY EEE(0 : 255) = X'EEEEEEEE'(256)
OWNINTEGERARRAY UNDUMP(0 : 255) = C
0(224),M'UNDU'(32)
RECORDFORMAT INFBF(INTEGER A1, A2, A3, A4, CODEBLK RA, C
GLABLK RA, UNDUMPBLK RA, STACKBLK RA, ACTLSTB0, C
ACTLSTB1, SP10, ACTSSN, SP12, SP13, SP14, SP15, SP16, C
SP17, SP18, SP19, SP20, SP21, SP22, SP23, SP24, SP25, C
SP26, SP27, SP28, SP29, SP30, SP31, C
INTEGERARRAY ST(0:31))
RECORD (INFBF)NAME INF
RECORDFORMAT RF(INTEGER LNB, PSR, PC, SSR, SF, IT, IC, LTB, C
XNB, B, DR0, DR1, A0, A1, A2, A3, LSTB0, LSTB1, PSTB0, C
PSTB1)
RECORD (RF)NAME R
RECORD (OBJF)NAME HO
RECORD (OBJF)NAME HT
STRING (17) GGFILE, IMPFILE, DIAGFILE, TAPEFILE, WK, MPFILE, C
MPIND
CONSTINTEGER MAX PAGES=55; ! maximum CHOPSUPE pages
CONSTINTEGER TPFPGS=64
INTEGER TAPEFILEAD
INTEGER AGLA, ACODE, AFILEEND, J
INTEGER LDATADDR, CODELEN, GLALEN
INTEGER RA, CODE BLOCKS, GLA BLOCKS
INTEGER CODE DR RELAD, EP AD
INTEGER LEN, BLOCKS
INTEGER FLAG
INTEGER BLEN, CONAD
INTEGER MPROGAD
INTEGER PUB7 RA
INTEGER PST IN GGFILE
INTEGER GLOBSTK RA, DISCCA RA
INTEGER BOOTL, AD, BLKSEQ
INTEGER IPLAD, SIPLAD
INTEGER PSAVE
INTEGERARRAY DUMMYBLK(0:1023)
!-----------------------------------------------------------------------
PSAVE=COMREG(27); ! SAVE PARMS
PRINTSTRING("VSN ".VSN."
")
! PRINTSTRING("***** Caution - PST in segment 11 *****
!")
IMPFILE=""; MPFILE=""
IF LENGTH(S)>0 START
IF S->MPFILE.(",").IMPFILE START
FINISH ELSE MPFILE=S
FINISH
IF IMPFILE="" THEN IMPFILE="CHOPZ"; !DEFAULT OBJECT FILE
J=RDFILEAD(IMPFILE)
->QUIT IF J<=0
TAPEFILE=IMPFILE
GGFILE="T#TEMPOBJ"
! REMOVE FILE OWNER NAME FROM STRING IF PRESENT
IF TAPEFILE->WK.(".").TAPEFILE START
FINISH
LENGTH(TAPEFILE)=LENGTH(TAPEFILE)-1
DIAGFILE=TAPEFILE."D"
TAPEFILE=TAPEFILE."T"
TAPEFILEAD=NWFILEAD(TAPEFILE,TPFPGS)
->QUIT IF TAPEFILEAD<=0
NEWLINE
PRINTSTRING("Diag file: ".DIAGFILE."
")
HT==RECORD(TAPEFILEAD)
HT=0
HT_NEXTFREEBYTE=16
HT_CODERELST=HT_NEXTFREEBYTE
! TAPEFILE IS A FILE TO HAVE A COPY OF THE TAPE FILE IN
! HT _ NEXTFREEBYTE - USUAL MEANING
! CODERESLT - START OF IPL BLOCK
! PSIZE - START OF 1K BLOCKS
! FILETYPE - NO OF 1K BLOCKS
DEFINE("57,".DIAGFILE); ! LAST PARAM IS NO OF KBYTES REQD
SELECT OUTPUT(57)
SPACES(20)
PRINTSTRING("CHOPFIX version ".VSN.", called at ".TIME. C
" on ".DATE)
NEWLINE
PRINTSTRING("Object file was ".IMPFILE."
")
PRINTSTRING("Diag file is ".DIAGFILE."
")
!-----------------------------------------------------------------
! FIX UP AND WRITE OUT TO TAPE THE BOOTSTRAP FILE 'BOOTZ'
RA=0
IF RDFILEAD("DBOOTZ")<=0 THEN ->QUIT
COPY("DBOOTZ,DBOOTZT")
CONAD=WRFILEAD("DBOOTZT")
FLAG=0
HO==RECORD(CONAD)
OFM=CONAD+HO_OFM; !START OF OBJECT FILE MAP
AGLA=CONAD+INTEGER(OFM+16); !START OF AREA 2
ACODE=CONAD+HO_CODERELST
AFILEEND=CONAD+HO_NEXTFREEBYTE
LDATADDR=CONAD+HO_LDRELST
BLEN=LDATADDR-CONAD
LDAT==RECORD(LDATADDR)
BLEN=(BLEN+X'F')&(¬X'F')
!
! IF THERE IS A DUMMT MICROPROGRAM THEN ADDTHE OVERLAYS INTO EPAGE 4
! OTHERWISE OR IN THE OCP MICROPROGRAM FROM X100
!
SELECT OUTPUT(0)
IF MPFILE="" THEN START
MPROGAD=RDFILEAD("OCPMPRG")
INTEGER(ACODE+X'104')=X'000F0000'
IF MPROGAD<=0 THEN PRINTSTRING("
Warning - microprogram overlays ommitted. CHOPSUPE will not work
on a 2970 (P3) processor.
" C
) ELSE MOVE(4*4096,MPROGAD+X'1C000'+INTEGER( C
MPROGAD+4),ACODE+X'4000')
MPIND="without "
FINISH ELSE START
MPROGAD=RDFILEAD(MPFILE)
->QUIT IF MPROGAD<=0
MOVE(X'13F00',MPROGAD+X'100'+INTEGER(MPROGAD+4),ACODE+ C
X'100')
!THIS IS THE MAX MPROG SIZE 'COS THE CODE STARTS AT X'14000'
MPIND="with "
FINISH
SELECT OUTPUT(57)
LONGINTEGER(ACODE+X'A8')=OVERLAY DESCR
TREAT BLOCK(ACODE)
HT_PSIZE=HT_NEXTFREEBYTE; ! START POSITION OF 1K BLOCKS
RA=X'8000'
!-----------------------------------------------------------------
! LOAD AND WRITE TO TAPE THE IMP OBJECT FILE
PARM("MAP")
PSTRG0("
Loading CHOPSUPE file")
HEAD("Load 'CHOPSUPE' file")
FIX(IMPFILE,GGFILE,(CODESEG<<18)-32,GLASEG<<18)
SELECT OUTPUT(57)
CONAD=WRFILEAD(GGFILE)
HO==RECORD(CONAD)
GLARELST=INTEGER(CONAD+HO_OFM+16);!START OF AREA 2
AGLA=CONAD+GLARELST
ACODE=CONAD+HO_CODERELST
CODELEN=AGLA-ACODE
GLALEN=HO_LDRELST-GLARELST
LDATADDR=CONAD+HO_LDRELST
LDAT==RECORD(LDATADDR)
! FIND REQUIRED ENTRY DESCRIPTOR
IF FIND EP(CONAD,"ENTER")=0 START
SELECT OUTPUT(0)
PRINTSTRING("Entry point 'ENTER' not found
")
->QUIT
FINISH
CODE DR RELAD=LIST1_REFLOC&X'FFFFFF'; ! DISPL OF ENTRY DESCRIPTOR FROM START OF
! GLA
! GET THE EP ADDRESS FROM THE ENTRY DESCRIPTOR IN GLA (ALREADY FIXED
! UP TO THE CORRECT VA BY THE LOADER.
EP AD=INTEGER(AGLA+CODE DR RELAD+4)
! NEXT LINK THE LOCAL TO THE GLOBAL CONTROLLER
!-------------------------------------------------- INFO -----------------
! EVALUATE NUMBER OF BLOCKS TO BE WRITTEN, SET UP INFO BLOCK
! (ACTIVATE WORDS), SET UP SEG TABLE.
INF==RECORD(ADDR(INFO BLOCK(0)))
CODE BLOCKS=(CODELEN+X'3FF')>>10
GLA BLOCKS=(GLALEN+X'3FF')>>10
! INF_UNDUMPBLK RA = INF_GLA BLK RA + (GLA BLOCKS<<10)
! INF_STACKBLK RA=INF_UNDUMPBLK RA + X'400'
NEWLINES(2)
PRINTSTRING("Info block RA = "); PHEX(RA)
NEWLINE
PRINTSTRING("Activ words RA = "); PHEX(RA+X'20')
NEWLINE
PRINTSTRING("Local seg tab RA = "); PHEX(RA+128)
NEWLINE
PRINTSTRING("IST RA = "); PHEX(IST RA)
NEWLINE
!--------------------------------------------------- ACTIVATE WORDS ---------
! SET UP THE ACTIVATE WORDS
INF_ACTLSTB0=MAXSEG<<18
INF_ACTLSTB1=RA+(ADDR(INF_ST(0))-ADDR(INF))
INF_ACTSSN=STACKSEG<<18
NEWLINES(4)
PRINTSTRING("For the IMP program
!
")
SPACES(36); PRINTSTRING("Virtual real")
NEWLINES(2)
SPACES(20); PRINTSTRING("Code address = ")
PHEX(CODESEG<<18)
NEWLINE
SPACES(20); PRINTSTRING("Entry address = ")
PHEX(EP AD)
NEWLINE
SPACES(20); PRINTSTRING("GLA address = ")
PHEX(GLASEG<<18)
NEWLINE
SPACES(20); PRINTSTRING("STACK address = ")
PHEX(INF_ACTSSN)
NEWLINES(4)
! NOW CREATE THE SEGMENT TABLE IN THE INFO BLOCK
PST==ARRAY(ADDR(PSTBLK(0)),PSTF)
LST==ARRAY(ADDR(INFOBLOCK(0))+LSTRA-INFBLKRA,LSTF)
ST ENTRY(INF_ST,VRMAPSEG,NONSLAVED,X'40000',0,1,15,15)
! MAP LOC SEG 0 TO RA
ST ENTRY(LST,1,SLAVED,X'100',X'80',0,1,1)
ST ENTRY(PST,RES STK SEG,SLAVED,RES STK SIZE,RES STK RA,0, C
1,1)
! NOW THE PUBLIC SEG TABLE IN THE SECOND INFO BLOCK, WITH PUBLIC 0 THE
! INTERRUPT STEERING TABLE AT X2400
IST==ARRAY(ADDR(INFO BLOCK(0))+IST RA-INF BLK RA,ISTF)
IST(0)_LNB=X'200'; ! HOPEFULLY NOT NEEDED
IST(0)_PSR=X'0014FF01'
IST(0)_PC=INF BLK RA
IST(0)_SSR=X'01800FFF'; ! VA MODE
IST(0)_SF=X'204'; ! ALSO HOPEFULLY NOT NEEDED
INFO BLOCK(0)=X'4F801111'; ! AN IDLE 1111 INSTRUCTION !
ST ENTRY(PST,IST0,SLAVED,16*32,IST RA,0,1,1)
ST ENTRY(PST,IST1,SLAVED,16*32,IST RA,0,1,1)
ST ENTRY(PST,IST2,SLAVED,16*32,IST RA,0,1,1)
ST ENTRY(PST,IST3,SLAVED,16*32,IST RA,0,1,1)
TREAT BLOCK(ADDR(INFO BLOCK(0))); ! INFO
HEAD("This block to be overwritten later with PST block")
TREAT BLOCK(ADDR(ZERBLK(0)))
TREAT BLOCK(ADDR(ZERBLK(0)))
! NOW THE GROPE TEMP C/A BLOCKS
DISCCA RA=RA+X'200'; ! ONLY HALF OF BLOCK
! FRONT HALF PART OF PST
HEAD("Disc comms area")
ST ENTRY(PST,DISCCA SEG,NONSLAVED,DISC CA SIZE,DISCCA RA, C
0,1,1)
TREAT BLOCK(ADDR(ZERBLK(0)))
! PUBLIC 7 - SSN+1 FOR RETART STACK (WAS EXTRADUMP INFORMATION)
PUB7 RA=RA+X'200'
ST ENTRY(PST,PUBLIC7,SLAVED,PUB7 SIZE,PUB7 RA,0,1,1)
HEAD("Post mortem info segment")
TREAT BLOCK(ADDR(ZERBLK(0))); ! PUBLIC7 (POST MORTEM)
! NOW THE UN-DUMP SEGMENT, SSN+1
ST ENTRY(PST,UNDUMP SEG,SLAVED,X'400',RA,0,1,1)
R==RECORD(ADDR(UNDUMP(0)))
R_LNB=STACKSEG<<18
R_PSR=X'00140001'; ! PSR, PRIV=1 PM=00 ACS=1 ACR=1
R_PC=EP AD
R_SSR=X'0180FFFF'; ! VA MODE ALL MASKED
R_SF=R_LNB+28; ! 5 WORDS FO DISPLAY + 2 ONE-WORD PARAMS
R_XNB=GLASEG<<18; !ASSUME GLA OFFSET FOR 'ENTER' IS ZERO
R_DR0=DRDR0+GLALEN
R_DR1=GLASEG<<18+CODE DR RELAD
! (DR MUST POINT TO THE DESCRIPTOR (IN CALLED ROUTINE'S GLA) TO THE
! CALLED ROUTINE'S ENTRY POINT).
HEAD("The 'SSN+1' segment")
TREAT BLOCK(ADDR(UNDUMP(0)))
! GLOBAL CODE BLOCKS NEXT
ST ENTRY(PST,CODESEG,SLAVED,CODELEN,RA,1,0,1)
BLOCKS=(CODELEN+X'3FF')>>10
LEN=BLOCKS<<10
MOVE(LEN,ACODE,TAPEFILEAD+HT_NEXTFREEBYTE)
HT_NEXTFREEBYTE=HT_NEXTFREEBYTE+LEN
HT_FILETYPE=HT_FILETYPE+BLOCKS
RA=RA+LEN
! HEAD('Global code')
! %CYCLE J=0,X'400',(CODELEN-1)&(¬X'3FF')
! TREAT BLOCK(ACODE+J)
! GLOBAL CODE
! %REPEAT
! NOW GLOBAL GLA BLOCKS
ST ENTRY(PST,GLASEG,SLAVED,GLALEN,RA,0,1,1)
BLOCKS=(GLALEN+X'3FF')>>10
LEN=BLOCKS<<10
MOVE(LEN,AGLA,TAPEFILEAD+HT_NEXTFREEBYTE)
HT_NEXTFREEBYTE=HT_NEXTFREEBYTE+LEN
HT_FILETYPE=HT_FILETYPE+BLOCKS
RA=RA+LEN
! HEAD('Global GLA')
! NEWLINE
! %CYCLE J=0,X'400',(GLALEN-1) & (¬X'3FF')
! TREAT BLOCK(AGLA+J)
! %REPEAT
! THE PROCESS C/A SEG. (USING ZERBLK)
PCA ST==ARRAY(ADDR(ZERBLK(0)),LSTF)
! THE PROCESS C/A SEG. (USINGZERBLK)
! PROCCA RA=RA
! ST ENTRY(PST,PROCCA SEG,SLAVED,PROCCA SIZE, PROCCA RA,0,1,1)
! HEAD('''Process C/A'' segment')
! TREAT BLOCK(ADDR(ZERBLK(0)))
! %CYCLE J=0,1,7
! ZERBLK(J)=0
! %REPEAT
! RE-INIT THIS
! PST RA=RA + X'400'
! NEXT AFTER UNDUMP ..............
GLOBSTK RA=RA+X'800'
!----------------------------------------------------- PROGRAM REGISTERS
! PUBLIC SEGMENT TABLE
ST ENTRY(PST,STACKSEG,SLAVED,STACKSIZE,GLOBSTK RA,0,1,1)
ST ENTRY(PST,PSTVSEG,SLAVED,8*(LAST PUB SEG+1),PST RA,0,1, C
1)
ST ENTRY(PST,REAL0 SEG,SLAVED,REAL0 SIZ,0,0,1,1)
HEAD("Public segment table")
! PST
! AND PLACE THIS BLOCK FOR RA 2400 IN THE TAPE FILE ALSO
MOVE(X'800',ADDR(PST(0)),PST IN GGFILE)
!
! FINALLY, SET UP STACK SEGMENT AS THOUGH THE IMP PROGRAM HAS
! BEEN CALLED. LNB POINTS TO BEGINNING OF STACK SEGMENT.
!
HEAD("Global stack")
TREAT BLOCK(ADDR(ZERBLK(0)))
!
! TWO BLOCKS OF E'S TO SHOW IN DUMP
!
CYCLE J=0,1,1
TREAT BLOCK(ADDR(EEE(0)))
REPEAT
NEWLINES(5)
SELECT OUTPUT(0)
!
! FORMAT OF "FILE" IS:
! 'CODERELST' POINTS TO START OF DATA
! 'GLA RELST' POINTS TO START OF THE 1K BLOCKS
! 'LDRELST' CONTAINS TOTAL NUMBER OF BLOCKS FOR THE TAPE
! THE FIRST BLOCK FROM 'CODERELST' IS THE IPL BLOCK, FOLLOWED BY
! 1K BLOCKS OF CODE + GLA.
!
CYCLE J=0,1,1023
DUMMYBLK(J)=M'DMBK'
REPEAT
AD=RDFILEAD(TAPEFILE)
RETURN IF AD<=0
HT==RECORD(AD)
BLEN=4096
J=(HT_FILETYPE+99)>>2
NEWLINE
PRINTSTRING("Number of blocks to 'PLOD' from 'SITE'+1 :")
WRITE(J,1)
NEWLINE
IF J>MAX PAGES START
PRINTSTRING("*** Warning - CHOPSUPE is oversize ***
")
FINISH
BOOTL=HT_PSIZE-HT_CODERELST
OUTFILE("CHOPIPL",HT_NEXTFREEBYTE+X'8FF0',0,0,IPLAD,FLAG)
IF FLAG#0 START
PRINTSTRING("'CHOPIPL' not created - FLAG =")
WRITE(FLAG,1)
->QUIT
FINISH
MOVE(16,AD,IPLAD); !COPY HEADER
SIPLAD=IPLAD
INTEGER(IPLAD+4)=4096
IPLAD=IPLAD+4096
! PAD OUT TO X'8000' WITH DUMMIES THIS SPACE TO CONTAIN THE OCP
! MICROPROGRAM AND TEMP STACK SPACE FOR CHOPSUPI
CYCLE J=0,1,20
IF J*BLEN<BOOTL THEN MOVE(BLEN,AD+HT_CODERELST+J* C
BLEN,IPLAD+J*BLEN) ELSE MOVE(BLEN,ADDR(DUMMYBLK(0)), C
IPLAD+J*BLEN)
REPEAT
IPLAD=IPLAD+(J+1)*BLEN
AD=AD+HT_PSIZE; ! TO START OF 4K BLOCKS
J=1; BLKSEQ=21
UNTIL J>=HT_FILETYPE CYCLE
IF BLKSEQ=X'1C' START ; ! PLACE FOR OVERLAYS
IF MPROGAD>0 THEN MOVE(4*4096,MPROGAD+X'1C000'+ C
INTEGER(MPROGAD+4),IPLAD)
BLKSEQ=BLKSEQ+4
IPLAD=IPLAD+4*BLEN
FINISH
MOVE(BLEN,AD,IPLAD)
IPLAD=IPLAD+BLEN
BLKSEQ=BLKSEQ+1
AD=AD+BLEN
J=J+(BLEN//1024)
REPEAT
INTEGER(SIPLAD)=IPLAD-SIPLAD; ! CORRECT 'USEFULL' LENGTH
PRINTSTRING("'CHOPIPL' generated ".MPIND. C
"OCP microprogram")
DESTROY(TAPEFILE.",DBOOTZT")
QUIT:
COMREG(27)=PSAVE; ! RESTORE PARMS
RETURN
!----------------------------------------------------------------------
INTEGERFN FIND EP(INTEGER FILEADDR, STRING (31) S)
! RESULT IS 0 IF EP 'S' NOT FOUND
! 1 IF EP 'S' IS FOUND
RECORD (OBJF)NAME H
RECORD (LDATF)NAME LDAT
H==RECORD(FILEADDR)
LDAT==RECORD(FILEADDR+H_LDRELST)
LIST1==RECORD(ADDR(LDAT_PROCENTS))
WHILE LIST1_LINK#0 CYCLE
LIST1==RECORD(FILEADDR+LIST1_LINK)
IF LIST1_IDEN=S START ; ! IDEN FOUND
UNLESS LIST1_REFLOC>>24=GLACODE START
! CHECKA
PSTRG0("EP IN GLA ?? ")
RESULT =0; ! NOT FOUND
FINISH ; ! CHECKA
RESULT =1; ! FOUND
FINISH ; ! IDEN FOUND
REPEAT
RESULT =0; ! NOT FOUND
END ; ! FIND EP
ROUTINE TREAT BLOCK(INTEGER AD)
!***********************************************************************
!* TAPEFILE IS A FILE TO HAVE A COPY OF THE TAPE FILE IN *
!* HT _ NEXTFREEBYTE - USUAL MEANING *
!* CODERESLT - START OF IPL BLOCK *
!* GLARELST - START OF 1K BLOCKS *
!* LDRELST - NO OF 1K BLOCKS *
!***********************************************************************
OWNINTEGER BLOCK NO=0
INTEGER BLKSI
PRINTSTRING("Block number"); WRITE(BLOCK NO,1)
PRINTSTRING(" for real address ")
PHEX(RA)
NEWLINES(2)
BLKSI=X'400'
IF BLOCKNO=0 THEN BLKSI=BLEN; ! FOR BOOT LOADER
IF HT_NEXTFREEBYTE+BLKSI>TPFPGS<<12 START
SELECT OUTPUT(0)
PRINTSTRING("File for mag tape is not big enough
")
STOP
FINISH
MOVE(BLKSI,AD,TAPEFILEAD+HT_NEXTFREEBYTE)
IF BLOCKNO=PSTBLKNO THEN PST IN GGFILE=TAPEFILEAD+HT_ C
NEXTFREEBYTE
HT_NEXTFREEBYTE=HT_NEXTFREEBYTE+BLKSI
HT_FILETYPE=HT_FILETYPE+1; ! COUNT OF BLOCKS FOR TAPE
BLOCK NO=BLOCK NO+1
RA=RA+X'400'
END ; ! TREAT BLOCK
ROUTINE HEAD(STRING (71) S)
INTEGER J
S=" ".S." "
J=(120-LENGTH(S))>>1
MULSYM('-',J)
PRINTSTRING(S)
MULSYM('-',J)
NEWLINE
END ; ! HEAD
ROUTINE PSTRG0(STRING (255) S)
SELECT OUTPUT(0)
PRINTSTRING(S)
NEWLINE
SELECT OUTPUT(57)
END ; ! PSTRG0
ROUTINE MULSYM(INTEGER SYM, MUL)
INTEGER J
RETURN IF MUL<=0
CYCLE J=1,1,MUL; PRINT SYMBOL(SYM)
REPEAT
END ; ! MULSYM
ROUTINE ST ENTRY(INTEGERARRAYNAME ST, C
INTEGER SEGNO, SLAVED, SEGLIMBYTES, RA, EXECBIT, WACR, RACR)
! MAKES A NON-PAGED, NON-SHARED, SLAVABLE, FIXED SEG TAB ENTRY
CONSTINTEGER LIM=X'0003FF80'
!%CONSTINTEGER APF=X'1FF00000'
CONSTINTEGER FIX=X'00000001'
! APF IS NINE BITS STARTING AT BIT 3 IN 1ST WORD OF ST ENTRY
! FROM LEFT EXEC 1 BIT
! WRITE 4 BITS
! READ 4 BITS
! PERMITTED - EXEC IF EXEC=1
! WRITE IF WRITE>=ACR
! READ IF READ>=ACR
CONSTINTEGER AVAIL=X'80000000'
INTEGER ENTNO, APF
IF SEGNO<X'2000' START
UNLESS 0<=SEGNO<=TOPLSEG THEN ->ERROR
FINISH ELSE START
UNLESS SEGNO<=TOPPSEG THEN ->ERROR
SEGNO=SEGNO-X'2000'
FINISH
ENTNO=SEGNO<<1
UNLESS 0<SEGLIMBYTES<=X'40000' START
SELECT OUTPUT(0)
PRINTSTRING("Segment ")
PHEX(SEGNO)
PRINTSTRING(" limit in error (local or public)
")
SELECT OUTPUT(57)
RETURN
FINISH
UNLESS 0<=EXECBIT<=1 AND 0<=WACR<=15 C
AND 0<=RACR<=15 START
SELECT OUTPUT(0)
PRINTSTRING("Invalid APF value
")
SELECT OUTPUT(57)
RETURN
FINISH
APF=(EXECBIT<<28)!(WACR<<24)!(RACR<<20)
! MAX ADDRESS WITHIN SEGMENT IS SEGLIMBYTES-1
ST(ENTNO)=((SEGLIMBYTES-1)&LIM)!APF!SLAVED
ST(ENTNO+1)=RA!AVAIL!FIX
RETURN
ERROR:
SELECT OUTPUT(0)
PRINTSTRING("Segno too high to make entry
")
END ; ! ST ENTRY
END ; ! CHOPFIX
ENDOFFILE
!