! ALAN ANDERSON - 7/6/78
!*********************************************************
!*
!* I.C.L. OBJECT MODULE FORMAT AMENDER
!*
!**********************************************************
!! USES COMREG 26 AS CONTROL PARM FIELD
!!
!!
!!
SYSTEMROUTINESPEC MOVE(INTEGER L, FROM, TO)
SYSTEMROUTINESPEC PHEX(INTEGER N)
SYSTEMROUTINESPEC FILL(INTEGER L, A, FILLER)
SYSTEMROUTINESPEC CONNECT(STRING (15) S, C
INTEGER ACCESS, MAXBYTES, PROTECTION, C
RECORDNAME R, INTEGERNAME J)
RECORDFORMAT INRFM(INTEGER CONAD, FILESIZE, C
BYTEINTEGER DUM1, DUM2, DUM3, DUM4, C
STRING (6) DUM5, INTEGER TYPEDUM6, C
INTEGER DATASTART, DATAEND, DUM7)
SYSTEMROUTINESPEC OUTFILE(STRING (15) S, C
INTEGER L, ML, P, INTEGERNAME CONAD, FLAG)
SYSTEMROUTINESPEC ITOE(INTEGER A, L)
SYSTEMROUTINESPEC ETOI(INTEGER A, L)
SYSTEMROUTINESPEC LOAD(STRING (32) ENTRY, C
INTEGER TYEP, INTEGERNAME FLAG)
SYSTEMROUTINESPEC SSMESS(INTEGER N)
SYSTEMROUTINESPEC FINDENTRY(STRING (32) ENTRY, C
INTEGER TYPE, DAD, STRINGNAME FILE, C
INTEGERNAME DR0, DR1, FLAG)
EXTERNALROUTINESPEC PROMPT(STRING (17) S)
EXTERNALROUTINESPEC OPENOMF(STRING (32) S, INTEGER N, MODE)
EXTERNALROUTINESPEC READOMF(INTEGER CHAN, C
INTEGER FROM, INTEGERNAME L)
EXTERNALROUTINESPEC WRITEOMF(INTEGER CHAN, A, L)
SYSTEMROUTINESPEC DESTROY(STRING (63) S, INTEGERNAME FLAG)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER N)
ROUTINESPEC ERR(INTEGER M, N)
ROUTINESPEC READLINE(STRING (255) NAME S)
!!
!!----------------------------------------------
!! CONSTANTS
!!----------------------------------------------
CONSTINTEGER TEMPORARY = X'40000000'; ! FILE PROPERTY
CONSTINTEGER NORT = X'4E4F5254'; ! UNSATISFIED REFERENCE MARKER
CONSTINTEGER ONESEGMENT = X'40000'; ! ONE NR SEGMENT
CONSTSTRING (6) ARRAY TYPE(0 : 3) = C
"MODULE","AREA","ENTRY","XREF"
RECORDFORMAT ITEMFM(STRING (32) S, INTEGER DR0, DR1, FLAG)
!!
EXTERNALINTEGERFN AMENDOMF(STRING (32) S)
!!
INTEGER PRPSTART, PRP, FLAG, L, MAXIIN, MAXLEN, LEN, TO, IIN, C
I, MAXT1IIN, BUFFAD, DR0, DR1, C26
STRING (32) INFILE, OUTPUTFILE
STRING (64) LINE
STRING (32) ACTION, PAR1, PAR2
STRING (1) DUMMY
INTEGER T1, NAMEDPOINT, OBJLIM, PLT, J, ESIZE
OWNSTRING (9) AREANAME = 'OMFAREAA'
STRING (32) XREF
OWNINTEGER NSEGS = 0
INTEGER BLK
INTEGERARRAY LENS(1 : 200)
INTEGERNAME NUMENTS
RECORDARRAYFORMAT ITEMAFM(0 : 100)(ITEMFM)
RECORDARRAYNAME ITEM(ITEMFM)
!!
RECORDFORMAT ENTRYFM( C
BYTEINTEGER TYPE, PROPS, SIZE0, SIZE1, IIN0, IIN1, C
NAMEUSE, STRING (32) IDEN)
BYTEINTEGERARRAY B(0 : 4120)
BYTEINTEGERARRAYFORMAT BUFFFM(0 : X'40000')
BYTEINTEGERARRAYNAME BUFF
RECORDFORMAT BHEADFM( C
BYTEINTEGER TYPE, LASTENTRY, IIN0, IIN1, C
INTEGER DISP, LEN)
RECORDNAME ENTRY(ENTRYFM)
RECORD BHEAD(BHEADFM)
RECORDFORMAT SEGFM(INTEGER ADDR, LEFT, BYTEINTEGER PROPS)
RECORDARRAY SEGS(1 : 20)(SEGFM)
!!
INTEGERFNSPEC GET VAR(INTEGER N)
ROUTINESPEC WARNING(INTEGER N)
!!
!!
!!**********************************
!!
!! DEAL WITH PROPERTIES RECORD
!!
!!************************************
!!
!************
!*BEGIN HERE*
!************
UNLESS S -> INFILE.(",").OUTPUTFILE C
THEN PRINTSTRING("
FORMAT IS INPUTFILE,OUTPUTFILE
") C
AND STOP
!!
!!
! - GET AREA TO COPY PROPERTIES RECORD INTO
OUTFILE('OMFPROPS',ONESEGMENT,0,TEMPORARY,PRPSTART,FLAG)
ERR(1,FLAG) UNLESS FLAG = 0
!!
BUFF == ARRAY(PRPSTART,BUFFFM)
!!
OPEN OMF(INFILE,1,0)
!!
READOMF(1,ADDR(BUFF(0)),L)
ERR(2,0) IF L = 0
LENS(1) = L; BLK = 1
!!
!! *** DO MODULE ENTRY ***
!!
ENTRY == RECORD(PRPSTART)
ERR(3,0) UNLESS ENTRY_TYPE = 0; ! FIRST ENTRY MUST BE 'MODULE'
ETOI(ADDR(ENTRY_IDEN)+1,LENGTH(ENTRY_IDEN))
MAXIIN = (ENTRY_IIN0<<8)+ENTRY_IIN1
MAXT1IIN = GET VAR(1)
IF MAXT1IIN = 0 THEN MAXT1IIN = MAXIIN
ESIZE = ENTRY_SIZE0<<8+ENTRY_SIZE1
PRP = PRPSTART+(ESIZE<<2)
!!
!!
!!
BEGIN
ROUTINESPEC RENAME
ROUTINESPEC PBYTE(BYTEINTEGER N)
INTEGER BLENT, BTYPE
!!
J = L
CYCLE ; ! THROUGH THE PROPERTIES ENTRIES, CATEGORISING
ENTRY == RECORD(PRP)
ETOI(ADDR(ENTRY_IDEN)+1,LENGTH(ENTRY_IDEN))
IIN = (ENTRY_IIN0<<8)+ENTRY_IIN1
EXIT IF ENTRY_NAME USE&1 = 1;! LAST ENTRY MARKER
ESIZE = ENTRY_SIZE0<<8+ENTRY_SIZE1
PRP = PRP+(ESIZE<<2)
IF PRP >= ADDR(BUFF(J-1)) START
! PROPERTIES RECORD MAY CONSIST OF MULTIPLE RECORDS
READOMF(1,ADDR(BUFF(J)),L)
ERR(2,0) IF L = 0
BLK = BLK+1
LENS(BLK) = L
J = J+L
FINISH
REPEAT
!!
PROMPT("ACTION:")
!!
CYCLE
READLINE(LINE)
EXIT IF LINE = "STOP" OR S = ".END"
IF LINE -> ACTION.("/").PAR1.("=").PAR2 START
IF ACTION = "RENAME" THEN RENAME C
AND -> NEXT ELSE -> PARDON
FINISH ELSE -> PARDON
PARDON: PRINTSTRING(" ??
")
NEXT:
REPEAT
!!
!!
!! NOW PUT IT BACK
!!
!! TRANSLATE NAMES BACK INTO EBCIDIC
!!
PRP = PRPSTART
CYCLE
ENTRY == RECORD(PRP)
ITOE(ADDR(ENTRY_IDEN)+1,LENGTH(ENTRY_IDEN))
EXIT IF ENTRY_NAME USE&1 = 1
PRP = PRP+((ENTRY_SIZE0<<8+ENTRY_SIZE1)<<2)
REPEAT
!!
!! PASS BACK OUT TO FILE
!!
OPENOMF(OUTPUTFILE,2,1)
!!
PRP = PRPSTART
I = 1
UNTIL I >= BLK THEN CYCLE
WRITEOMF(2,PRP,LENS(I))
PRP = PRP+LENS(I)
I = I+1
REPEAT
!!
!! NOW THE REST OF THE FILE
!!
CYCLE
READOMF(1,ADDR(B(0)),L)
EXIT IF L<=0
WRITEOMF(2,ADDR(B(0)),L)
REPEAT
!!
!!***********************************************
!!
!! RENAME SUBROUTINE
!!
!!************************************************
!!
ROUTINE RENAME
!!
INTEGER I, FOUND
!!
IF LENGTH(PAR2) > LENGTH(PAR1) C
THEN PRINTSTRING("
PLEASE MAKE LENGTH OF DESIRED NAME LESS THAN OR EQUAL TO CURRENT
NAME FOR RENAME COMMAND.
") C
AND RETURN
FOUND = 0
PRP = PRPSTART
CYCLE
ENTRY == RECORD(PRP)
IF ENTRY_IDEN = PAR1 START
MOVE(LENGTH(PAR2)+1,ADDR(PAR2),ADDR(ENTRY_IDEN))
PRINTSTRING("
".TYPE(ENTRY_TYPE)." ".PAR1. C
" IS RENAMED ".PAR2)
NEWLINE
FOUND = 1
FINISH
EXIT IF ENTRY_NAMEUSE&1 = 1
PRP = PRP+((ENTRY_SIZE0<<8+ENTRY_SIZE1)<<2)
REPEAT
IF FOUND = 0 THEN PRINTSTRING("
CANNOT FIND ".PAR1. C
" IN PROPERTIES RECORD
")
END
!!
!!*******************************
!!
! PRINTING ROUTINES
!!
!!********************************
!!
ROUTINE PBYTE(BYTEINTEGER N)
CONSTBYTEINTEGERARRAY HX(0 : 15) = C
C
'0','1','2','3','4', C
'5','6','7','8','9','A','B','C','D','E','F'
PRINTSYMBOL(HX(N>>4))
PRINTSYMBOL(HX(N&15))
END
!!
!!
END ; ! OF INNER BLOCK
!!
!!************************************
!!
!! GET VAR
!!
!!*************************************
! LOOK THROUGH THE VARIABLE NUMBER OF OPTIONAL FIELDS FOLLOWING
! THE FIXED PART OF A PROPERTIES RECORD ENTRY FOR ONE FIELD IN
! PARTICULAR. THE OPTIONAL FIELD IDENTIFIER IS IN THE LEADING BYTE.
! IF 255 THEN OPTIONAL FIELD LENGTH IS (4+BYTE2) BYTES.
!!
INTEGERFN GET VAR(INTEGER N)
INTEGER L, OPT
!!
L = 2+((LENGTH(ENTRY_IDEN)+3)>>2);! LENGTH OF FIXED PART
WHILE L < ENTRY_SIZE1 THEN CYCLE ; ! THROUGH OPTIONAL FIELDS
OPT = INTEGER(ADDR(ENTRY_TYPE)+(L<<2))
IF OPT>>24 = N THEN RESULT = OPT&X'FFFFFF'
IF OPT>>24 = 255 THEN L = L+1+((OPT<<8>>24)+3)>>2 C
ELSE L = L+1
REPEAT
IF N = 130 THEN RESULT = -1; ! BOTCH FOR PLT IIN=0
RESULT = 0
END
!!
!!********************************
!!
!! WARNINGS
!!
!!*******************************
!!
ROUTINE WARNING(INTEGER N)
SWITCH W(1 : 10)
OWNINTEGERARRAY WR(1 : 10) = 0(10)
NEWLINE
WR(N) = WR(N)+1
-> W(N) UNLESS WR(N) > 1
W(1): PRINTSTRING(' TEMPLATE FIXUPS NOT SUPPORTED ')
-> END
END:
END ; ! OF WARNING
!!
!!
DESTROY("OMFPROPS",FLAG)
PRINTSTRING("
AMENDMENT SUCCESSFUL
")
RESULT = 0
END ; ! OF OMFAMEND
!!
!*********************************************************************************
!*********************************************************************************
!!
!!
!!*********************************
!!
!! ERRS
!!
!!**********************************
!!
EXTERNALROUTINE ERR(INTEGER N, FLAG)
SWITCH TS(1 : 20)
PRINTSTRING('
OMF LOADER FAILS / ')
-> TS(N)
TS(1):
PRINTSTRING(' OUTFILE FAILS ')
WRITE(FLAG,1)
-> END
TS(2):
PRINTSTRING(' PREMATURE END OF FILE ')
-> END
TS(3):
PRINTSTRING(' FIRST ENTRY WAS NOT A MODULE ')
-> END
TS(4):
PRINTSTRING(' WRONG RECORD SEQUENCE ')
-> END
TS(5):
PRINTSTRING(' ENTRY NOT FOUND ')
-> END
TS(6):
PRINTSTRING(" CANNOT CONNECT ENTRY FILE
HAVE YOU LOADED CORRECTLY ? ")
-> END
END:
NEWLINE
SSMESS(FLAG)
NEWLINES(2)
STOP
END ; ! OF ERR
!!
!**************************************
ROUTINE READLINE(STRING (255) NAME LINE)
WHILE NEXTSYMBOL = NL THEN SKIPSYMBOL; ! SKIP BLANK LINES
LINE = ''
WHILE NEXTSYMBOL # NL THEN LENGTH(LINE) = LENGTH(LINE)+1 C
AND BYTEINTEGER(ADDR(LINE)+LENGTH(LINE)) = NEXTSYMBOL C
AND SKIPSYMBOL
SKIPSYMBOL
END
!*
ENDOFFILE