SECTION"STR"
GET "NLIBHDR" // STANDARD LIB HEADER
// THIS FILE SHOULD BECOME THE INSERT FILE "AHDR"
GET "AHDR"
LET START(PARM) BE $(
LET V1=VEC 20 // PGM
AND V2=VEC 20 // TTL
AND V3=VEC 72 // P.CODEV
AND V4=VEC 72 // P.CODET
AND V5=VEC 80 // PROG.NAME
AND V6=VEC 2 // FSYM
AND V7=VEC 80 // LINE
AND V8=VEC 8 // DUMPV
AND V9=VEC 39 // BIN
AND V10=VEC 8 // RELBITS
AND V11=VEC 7 //NUMBERCHARS
AND V12=VEC 72 //PARMV
AND V13=VEC 2 //LGO FILENAME
AND V14=VEC 2 //ASSFILE FILENAME
AND V15=VEC 2 //LISTFILE FILENAME
AND ACNT,RCNT=0,0 // ABS AND REL COUNTERS
PGM:=V1; TTL:=V2
P.CODEV:=V3; P.CODET:=V4
PROG.NAME:=V5
FSYM:=V6
LINE:=V7
DUMPV:=V8; BIN:=V9; RELBITS:=V10
NUMBERCHARS:=V11
PARMV:=V12
ABSC:=@ACNT; RELC:=@RCNT
VERSIONNUMBER:=1
//SETUP FILE NAMES
//CII ASSFILE,LISTFILE,LGO:="ASSF","LIST","GO,,B"
ASSFILE,LISTFILE,LGO:="ASSF","LIST","GO"
//SETUP SIZE OF WORK SPACES
ARGTEXTSIZE:=400 //WORDS
DICTSIZE:=5000 //CHARACTERS
LISTSIZE:=5000 //WORDS
MACTEXTSIZE:=5000 //CHARACTERS
NAMESIZE:=512 //WORDS (A POWER OF TWO!!!)
DEFTEXTSIZE:=1000 //CHARACTERS
INANALSIZE:=1000
CROSSREF:=FALSE; SHORTCROSSREF:=FALSE; PROFIL:=0
UNPACKSTRING(PARM,PARMV)
PARMV!(!PARMV+1):=0; PARMV:=PARMV+1
$( //START OF LOOP
SWITCHON !PARMV INTO $(
CASE 'A': ARGTEXTSIZE:=READSIZE(); ENDCASE
CASE 'B': FILENAME(V13); LGO:=V13; ENDCASE
CASE 'D': DICTSIZE:=READSIZE(); ENDCASE
CASE 'I': FILENAME(V14); ASSFILE:=V14; ENDCASE
CASE 'L':
IF !(PARMV+1)='=' THEN $(
FILENAME(V15); LISTFILE:=V15; ENDCASE
$)
LISTSIZE:=READSIZE(); ENDCASE
CASE 'M':
IF '0'<=!(PARMV+1)<='9' THEN $(
MACTEXTSIZE:=READSIZE(); ENDCASE
$)
DUMPINIT:=DUMPINITMC; DUMP:=DUMPMC
PARMV:=PARMV+1; ENDCASE
CASE 'N':
NAMESIZE:=READSIZE(); ENDCASE
CASE 'P':
PROFIL:=-1; PARMV:=PARMV+1; ENDCASE
CASE 'R':
INANALSIZE:=READSIZE(); ENDCASE
CASE 'V':
DEFTEXTSIZE:=READSIZE(); ENDCASE
CASE 'S': SHORTCROSSREF:=TRUE
CASE 'X': CROSSREF:=TRUE
CASE ' ':
CASE ',': PARMV:=PARMV+1; ENDCASE
DEFAULT:
WRITETOLOG("KEY LETTER NOT B,I,L OR X")
LOOP
CASE '/':
CASE 0: BREAK
$)
$) REPEAT
ASSFILESTR:=FINDINPUT(ASSFILE)
PENDINGLINE:=FALSE
APTOVEC(MAIN,ARGTEXTSIZE+1+
LISTSIZE+1+
4*NAMESIZE+4+
DEFTEXTSIZE/BYTESPERWORD+1+
DICTSIZE/BYTESPERWORD+1+
MACTEXTSIZE/BYTESPERWORD+1+
INANALSIZE+1+
72+4*(72/BYTESPERWORD)) //SAFETY FACTORS
$)
AND MAIN(V,S) BE $(
LET PART=0
AND KLINE=VEC 72
AND VVV=VEC 80
AND KLAB,KARG,KOP=0,0,0
//NUMBERS IN BRACKETS ARE SAFETY FACTORS USUALLY ONE LINE OF 72 CHARS
VX:=VVV // GLOB VECTOR FOR OBJECT MODULE TEXT
ARGTEXT:=V; V:=V+ARGTEXTSIZE+1
ARGTOP:=V-1; V:=V+(72)
DICT:=V; V:=V+DICTSIZE/BYTESPERWORD+1
DICTMAX:=V*BYTESPERWORD-1; V:=V+(72/BYTESPERWORD)
LISTSPACE:=V; V:=V+LISTSIZE+1
LSPACEMAX:=V-1
MACTEXT:=V; V:=V+MACTEXTSIZE/BYTESPERWORD+1
MACTOP:=V*BYTESPERWORD-1; V:=V+(72/BYTESPERWORD)
NAMEP:=V; V:=V+2*NAMESIZE+2
SNAME:=V; V:=V+NAMESIZE+1
ONAME:=V; V:=V+NAMESIZE+1
DEFTEXT:=V; V:=V+DEFTEXTSIZE/BYTESPERWORD+1
DEFTOP:=V*BYTESPERWORD-1 //(72/BYTESPERWORD) ALLOWED FOR SAFETY
V:=V+(72/BYTESPERWORD)
INANAL:=V
INTOP:=V+INANALSIZE
RSYM:=RSTREAM; TERMINATOR:=0
MACEXP:=FALSE; MACDEF:=FALSE; INPARFORM:=FALSE
INSTR:=ASSFILESTR
SELECTINPUT(INSTR)
$( LET V=VEC 32 AND L=? AND Q=FINDOUTPUT("SYSUT1")
L:=READREC(V)
SELECTOUTPUT(Q)
UNTIL L<0 DO $( WRITEREC(V,L); L:=READREC(V) $)
ENDWRITE()
ENDREAD()
INSTR:=FINDINPUT("SYSUT1")
SELECTINPUT(INSTR)
ASSFILESTR:=INSTR
ASSFILE:="SYSUT1"
$)
$( //START OF BIG LOOP
PASS:=1
// CLEAR OUT SYMBOL TABLES & DICTIONARY
FOR J=0 TO ARGTEXTSIZE DO ARGTEXT!J:=0
FOR J=0 TO INANALSIZE DO INANAL!J:=0
FOR J=0 TO DICTSIZE/BYTESPERWORD DO DICT!J:=0
FOR J=0 TO NAMESIZE*2 DO NAMEP!J:=0
FOR J=0 TO NAMESIZE DO SNAME!J,ONAME!J:=-1,-1
FOR J=0 TO LISTSIZE DO LISTSPACE!J:=0
!ABSC:=0; !RELC:=0; CNT:=RELC
TOPRELCNT:=0; TOPABSCNT:=0
INTERNALS,EXTERNALS,COMMONS:=0,0,0
// PROGRAM NAME, TITLE, ETC.
!PROG.NAME:=0; FOR I=1 TO 6 DO PROG.NAME!I:=' '
!PGM:=0
!TTL:=0
COMMNUM,EXTNUM:=1,1
SCW:=FALSE
// DICTIONARY POINTERS
DP:=DICT*BYTESPERWORD
// LISTS
LSP:=LISTSPACE
// SYMBOL TABLE POINTERS + DFF ENTRY IN SYMBOL TABLE
$(
LET V=VEC 4
LET A=V+1
UNPACKSTRING("DFF ",V)
NAMEP!GETOPN(@A):=LIST(1,T.DIR+D.DFF)
$)
IF !PARMV='/' THEN $(
LET P=PARMV+1
WHILE LETTER(!P) DO $(
LET Q=P
P:=P+1 REPEATWHILE CAN(!P)
UNLESS !P='=' THEN BREAK
P:=P+1
READEXPR(@P)
UNLESS EXPR.TYPE=T.ABS THEN BREAK
SETSYMBOL(Q,T.ABS,EXPR.VALUE)
UNLESS !P=',' THEN BREAK
P:=P+1
$)
$)
FAULTS:=0
INITLISTCONTROL()
// MACRO INITIALISATION
MTP:=MACTEXT*BYTESPERWORD
SEARCHING:=FALSE
DTP:=DEFTEXT*BYTESPERWORD
ATP:=ARGTEXT
// BINARY OUTPUT
BINOUT:=FINDOUTPUT(LGO)
PAGE:=0
// STREAMS
ERRSTR:=FINDOUTPUT("OUTPUT")
SELECTOUTPUT(ERRSTR)
INSTR:=FINDINPUT("M80P")
IF INSTR=0 THEN $(
FAULTS:=1
SELECTOUTPUT(FINDOUTPUT(LISTFILE))
WRITES(" ****** FAILURE TO ATTACH M8OP ******")
WRITETOLOG(" ****** FAILURE TO ATTACH M8OP ******")
FINISH
$)
LABGEN:=-1
SELECTINPUT(INSTR)
PASS1()
ENDREAD()
//** DEBUG(" PASS1 ,INSTR=%X8 *N",INSTR)
INSTR:=ASSFILESTR
SELECTINPUT(INSTR)
//** DEBUG(" PASSS1 *N")
IF INSTR=0 THEN $(
FAULTS:=1
SELECTOUTPUT(FINDOUTPUT(LISTFILE))
WRITEF(" ****** NO INPUT FILE CALLED *"%S*"",ASSFILE)
WRITETOLOG(" ****** NO INPUT FILE")
FINISH
$)
UNLESS PART=0 THEN $(
PENDINGLINE:=TRUE
LAB,ARG,OP:=KLAB,KARG,KOP
FOR I=0 TO 72 DO LINE!I:=KLINE!I
$)
NUMBERED:=TRUE
ENDREC.P:=LEVEL(); ENDREC.L:=PASS1.RETURN
//** DEBUG(" CALLING PASS1 FOR THE FIRST TIME*N")
PASS1()
PASS1.RETURN:
PASS:=2
//** DEBUG(" AFTER PASS1.RETURN")
SELECTINPUT(INSTR); ENDREAD()
//** DEBUG(" AFTER FUNNY SYSUT1 MANIPULATION*N")
INSTR := FINDINPUT("SYSUT1"); SELECTINPUT(INSTR)
//** DEBUG(" AFTER MORE FUNNIES*N")
ASSFILESTR := INSTR // UPDATE CAUSE 'REWIND' CHANGES
MACEXP:=FALSE; RSYM:=RSTREAM
MACDEF:=FALSE; INPARFORM:=FALSE
FOR I=1 TO PART DO $(
LET J,T=0,0
$(
J:=READLINE() REPEATUNTIL J&(!LINE NE '**')&(OP NE 0)
T:=GETOPN(@OP)
IF NAMEP!T=0 THEN LOOP
J:=!(NAMEP!T)
UNLESS (Jﰀ)=T.DIR DO LOOP
J:=JϿ
IF (J=D.MAC) LOGOR (J=D.MAD) THEN $(
MACDEF:=TRUE; LOOP
$)
IF J=D.EMP THEN $(
MACDEF:=FALSE; LOOP
$)
IF MACDEF THEN LOOP
IF J=D.END THEN BREAK
$) REPEAT
J:=READLINE() REPEATUNTIL J&(!LINE NE '**')&(OP NE 0)
PENDINGLINE:=TRUE
$)
SELECTOUTPUT(FINDOUTPUT(LISTFILE))
SELECTINPUT(INSTR)
MACEXP:=FALSE; RSYM:=RSTREAM
LABGEN:=-1
LINES:=LINESPERPAGE; LISTINGCONTROL:=L.ALL; LINENO:=1
!ABSC:=0; !RELC:=0; CNT:=RELC
//INITIALISATION FOR LOADER NOW SET UP
DUMPINIT()
REC.P,REC.L:=LEVEL(),NO.END.DIR
ENDREC.P:=REC.P; ENDREC.L:=PASS2.RETURN
//** DEBUG(" JUST BEFORE PASS2*N")
PASS2()
//** DEBUG(" JUST AFTER PASS2*N")
PASS2.RETURN:
NEWLINE()
TEST FAULTS=0 THEN WRITES(" NO ERRORS IN ASSEMBLY")
ELSE WRITEF(" %N ERROR%S IN ASSEMBLY",FAULTS,(FAULTS=1)->"",
"S")
NEWLINE()
WRITES(" ASSEMBLY COMPLETE")
NEWLINE()
UNLESS PROFIL=0 THEN PRINTPROFIL()
IF CROSSREF THEN PRINTCROSSREFS()
WRITETOLOG((FAULTS=0)->"NO ERRORS IN ASSEMBLY",
(FAULTS=1)->"ERROR IN ASSEMBLY",
"ERRORS IN ASSEMBLY")
WRITETOLOG("ASSEMBLY COMPLETE")
REC.P,REC.L:=LEVEL(),STOP.IT
MACEXP:=FALSE; RSYM:=RSTREAM
SELECTINPUT(INSTR)
SELECTOUTPUT(ERRSTR)
$(
LET J=0
J:=READLINE() REPEATUNTIL J&(!LINE NE '**')&(OP NE 0)
$)
PART:=PART+1
KLAB,KARG,KOP:=LAB,ARG,OP
FOR I=0 TO 72 DO KLINE!I:=LINE!I
$) REPEAT
STOP.IT:
SELECTOUTPUT(BINOUT); ENDWRITE()
FINISH
NO.END.DIR:
FAULTS:=FAULTS+1
WRITES(" ****** NO END TERMINATOR ******")
WRITETOLOG(" ****** NO END TERMINATOR ******")
GOTO PASS2.RETURN
$)
AND FILENAME(V) BE $(
LET P=PARMV+1
PARMV:=PARMV+2
UNLESS LETTER(!PARMV)&(!P='=') THEN $(
WRITETOLOG("ERROR IN FILE NAME")
FINISH
$)
PARMV:=PARMV+1
WHILE (LETTER(!PARMV) LOGOR ('0'<=!PARMV<='9'))&(PARMV-P<=7)
//CII WHILE (LETTER(!PARMV) LOGOR ('0'<=!PARMV<='9'))&(PARMV-P<=4)
PARMV:=PARMV+1
!P:=PARMV-P-1
PACKSTRING(P,V)
$)
AND READSIZE() = VALOF $(
LET S=0
PARMV:=PARMV+1
WHILE '0'<=!PARMV<='9' DO $(
S:=S*10+(!PARMV-'0'); PARMV:=PARMV+1
$)
RESULTIS S
$)
AND PRINTCROSSREFS() BE $(
WRITES("*P CROSS REFERENCE*N *N *N")
$(
LET P,Q,R=-1,0,0
FOR T=0 TO NAMESIZE DO $(
UNLESS SNAME!T<0 THEN $(
P:=T; BREAK
$)
$)
IF P=-1 THEN RETURN
FOR T=P+1 TO NAMESIZE DO $(
UNLESS SNAME!T<0 THEN $(
P:=VALOF $(
LET LP,LT=GETBYTE(0,SNAME!P),GETBYTE(0,SNAME!T)
LET L=(LP<LT)->LP,LT
FOR I=1 TO L DO $(
LET CP,CT=GETBYTE(0,SNAME!P+I),GETBYTE(0,SNAME!T+I)
IF CP<CT THEN RESULTIS P
IF CT<CP THEN RESULTIS T
$)
IF LT<LP THEN RESULTIS T
RESULTIS P
$)
$)
$)
IF SHORTCROSSREF THEN $(
R:=NAMEP!P
IF (R=0) LOGOR (R!3=0) THEN $(
SNAME!P:=-1 //REMOVE ENTRY
LOOP
$)
$)
$( //PRINT NAME
LET L=GETBYTE(0,SNAME!P)
WRCH(' ')
FOR I=SNAME!P+1 TO SNAME!P+L DO WRCH(GETBYTE(0,I))
SNAME!P:=-1 //REMOVE ENTRY
SPACES(14-L)
$)
R:=NAMEP!P
UNLESS R=0 THEN $(
UNLESS (!R&T.REDEF)=0 THEN WRITES("FINAL VALUE ")
WRCH(SYMTYPE(!Rﰀ)); WRCH(' ')
WRITEHEX(1!R,4)
R:=R!2
$)
Q:=-1
UNTIL R=0 DO $(
Q:=Q+1
IF (Q REM 10)=0 THEN $(
WRCH('*N'); SPACES(15)
$)
WRITEF(" **%X4",REFVALUE(R))
R:=REFPOINTER(R)
$)
R:=NAMEP!P; UNLESS R=0 THEN R:=R!3
UNTIL R=0 DO $(
Q:=Q+1
IF (Q REM 10)=0 THEN $(
WRCH('*N'); SPACES(15)
$)
WRITEF(" %X4",REFVALUE(R))
R:=REFPOINTER(R)
$)
WRCH('*N')
$) REPEAT
$)
AND DEBUG(X,X1,X2,X3,X4,X5,X6,X7,X8,X9) BE $(
LET A=OUTPUT()
SELECTOUTPUT(ERRSTR)
WRITEF(X,X1,X2,X3,X4,X5,X6,X7,X8,X9)
SELECTOUTPUT(A)
$)
AND PRINTPROFIL() BE $(
WRITES("*P ASSEMBLER OPTIONS*N *N *N")
WRITES(" FILE NAMES*N *N")
WRITEF(" B=%S BINARY OUTPUT*N",LGO)
WRITEF(" I=%S INPUT FILE*N",ASSFILE)
WRITEF(" L=%S LISTING FILE*N *N *N",LISTFILE)
WRITES(" EXTRA OPTIONS*N *N")
WRITEF(" P %S PROFILE OF SPACE AND OPTIONS*N",
PROFIL>0->"SET BY PROGRAM","SET")
WRITEF(" S %S SHORT CROSS REFERENCE*N",
SHORTCROSSREF->"SET","UNSET")
WRITEF(" X %S CROSS REFERENCE (MAY BE SET BY 'S' OPTION)*N *N *N",
CROSSREF->"SET","UNSET")
WRITES(" SPACE AND ITS UTILISATION*N *N")
WRITEF(" A%N WORDS MACRO ARGUMENTS, AMOUNT USED =",ARGTEXTSIZE)
$(
LET S=0
FOR P=ARGTEXTSIZE TO 0 BY -1 DO $(
UNLESS ARGTEXT!P=0 THEN $(
S:=P; BREAK
$)
$)
WRITEF(" %N*N",S)
$)
WRITEF(" D%N CHARACTERS DICTIONARY, AMOUNT USED = %N*N",
DICTSIZE,DP-DICT*BYTESPERWORD)
WRITEF(" L%N WORDS LIST SPACE, AMOUNT USED = %N*N",
LISTSIZE,LSP-LISTSPACE)
WRITEF(" M%N CHARACTERS MACRO TEXT, AMOUNT USED = %N*N",
MACTEXTSIZE,MTP-MACTEXT*BYTESPERWORD)
WRITEF(" N%N WORDS SYMBOL TABLES ",NAMESIZE)
WRITEF(" (%N WORDS, HASH CODED, A POWER OF TWO)",4*NAMESIZE)
$(
LET S1,S2=0,0
FOR P=0 TO NAMESIZE-1 DO $(
UNLESS ONAME!P=-1 THEN S1:=S1+1
UNLESS SNAME!P=-1 THEN S2:=S2+1
$)
WRITEF(", AMOUNT USED = %N*N",S1>S2->S1,S2)
$)
WRITEF(" V%N CHARACTERS MACRO DEFAULT ARGUMENTS, AMOUNT USED = %N*N",
DEFTEXTSIZE,DTP-DEFTEXT*BYTESPERWORD)
$)
AND ADDREF(P,N,V) BE $(
IF P=0 THEN RETURN
P:=P+N
UNTIL !P=0 DO P:=!P
!P:=LIST(2,0,V)
$)
AND REFPOINTER(R) = !R
AND REFVALUE(R) = 1!R
AND SPACES(M) BE FOR N=1 TO M DO WRCH(' ')
AND ASKII(C) = C!TABLE
/* EBCDIC 00-07 */ #000, #001, #002, #003, 0, #011, 0, #177,
/* EBCDIC 08-0F */ 0, 0, 0, #013, #014, #015, #016, #017,
/* EBCDIC 10-17 */ #020, #021, #022, #023, 0, 0, #010, 0,
/* EBCDIC 18-1F */ #030, #031, 0, 0, #034, #035, #036, #037,
/* EBCDIC 20-27 */ 0, 0, 0, 0, 0, #012, #027, #033,
/* EBCDIC 28-2F */ 0, 0, 0, 0, 0, #005, #006, #007,
/* EBCDIC 30-37 */ 0, 0, #026, 0, 0, 0, 0, #004,
/* EBCDIC 38-3F */ 0, 0, 0, 0, #024, #025, 0, #032,
/* EBCDIC 40-47 */ #040, 0, 0, 0, 0, 0, 0, 0,
/* EBCDIC 48-4F */ 0, 0, 0, #056, #074, #050, #053, #174,
/* EBCDIC 50-57 */ #046, 0, 0, 0, 0, 0, 0, 0,
/* EBCDIC 58-5F */ 0, 0, #041, #044, #052, #051, #073, #176,
/* EBCDIC 60-67 */ #055, #057, 0, 0, 0, 0, 0, 0,
/* EBCDIC 68-6F */ 0, 0, 0, #054, #045, #137, #076, #077,
/* EBCDIC 70-77 */ 0, #136, 0, 0, 0, 0, 0, 0,
/* EBCDIC 78-7F */ 0, #140, #072, #043, #100, #047, #075, #042,
/* EBCDIC 80-87 */ 0, #141, #142, #143, #144, #145, #146, #147,
/* EBCDIC 88-8F */ #150, #151, 0, #173, 0, 0, 0, 0,
/* EBCDIC 90-97 */ 0, #152, #153, #154, #155, #156, #157, #160,
/* EBCDIC 98-9F */ #161, #162, 0, #175, 0, 0, 0, 0,
/* EBCDIC A0-A7 */ 0, 0, #163, #164, #165, #166, #167, #170,
/* EBCDIC A8-AF */ #171, #172, 0, 0, 0, #133, 0, 0,
/* EBCDIC B0-B7 */ 0, 0, 0, 0, 0, 0, 0, 0,
/* EBCDIC B8-BF */ 0, 0, 0, 0, 0, #135, 0, 0,
/* EBCDIC C0-C7 */ 0, #101, #102, #103, #104, #105, #106, #107,
/* EBCDIC C8-CF */ #110, #111, 0, 0, 0, 0, 0, 0,
/* EBCDIC D0-D7 */ 0, #112, #113, #114, #115, #116, #117, #120,
/* EBCDIC D8-DF */ #121, #122, 0, 0, 0, 0, 0, 0,
/* EBCDIC E0-E7 */ #134, 0, #123, #124, #125, #126, #127, #130,
/* EBCDIC E8-EF */ #131, #132, 0, 0, 0, 0, 0, 0,
/* EBCDIC F0-F7 */ #060, #061, #062, #063, #064, #065, #066, #067,
/* EBCDIC F8-FF */ #070, #071, 0, 0, 0, 0, 0, #134
AND CAN2WORDS(NAME,P) BE $(
LET V=VEC 6
AND L=GETBYTE(0,NAME)
IF L>6 THEN L:=6 //TRUNCATE TO 6 CHARACTERS
FOR I=1 TO L DO V!I:=GETBYTE(0,NAME+I)
FOR I=L+1 TO 6 DO V!I:=' '
P!0:=(CANVALUE(V!1)*40+CANVALUE(V!2))*40+CANVALUE(V!3)
P!1:=(CANVALUE(V!4)*40+CANVALUE(V!5))*40+CANVALUE(V!6)
$)
.