SPL,L,O,T,M NAME ISAGN(3,90) !92413-16015A 760329 ! ! ! SOURCE: 92413-18015 REV A ! RELOC: 92413-16015 REV A ! ! ! ISAGN --------- DISK VERSION-DISTRIBUTED SYSTEMS ! ! ! ISAGN IS AN INTERACTIVE TABLE CONFIGURATOR FOR ISA ! ! !*************************************************************** ! ! INITIALIZATION PHASE ! !*************************************************************** ! LET SWAP BE SUBROUTINE,EXTERNAL,DIRECT LET NAM BE INTEGER,GLOBAL !POINTER TO NAME STRING LET EXEC,XOPEN,XCLOS,WRITF BE SUBROUTINE,EXTERNAL LET WSAA BE PSEUDO,DIRECT LET CMCNT BE INTEGER,EXTERNAL LET %PRS2,%PRS5 BE INTEGER,EXTERNAL LET %PR31,%PR41 BE INTEGER,EXTERNAL LET OUTLU,IDPTR BE INTEGER,GLOBAL LET RMPAR,XCRET BE SUBROUTINE,EXTERNAL LET PR1NT,PRT1,GT0UT,CLSF1,F1LCK BE SUBROUTINE,DIRECT,EXTERNAL LET A1DCB,A3DCB,A2DCB BE INTEGER(144),EXTERNAL LET %CLU BE INTEGER(5),EXTERNAL LET BUFFR BE INTEGER(60),GLOBAL !GENERAL BUFFER LET INTMS BE INTEGER(16) INITIALIZE INTMS TO 30," INSTRUMENT TABLE FILE NAME ?" LET ENDBM BE INTEGER(12) INITIALIZE ENDBM TO 21,"* END ISA TABLE GEN *" LET CMDIN BE SUBROUTINE,EXTERNAL LET STPRG BE SUBROUTINE,DIRECT LET READ,WRITE BE SUBROUTINE,DIRECT,GLOBAL LET OUTRL,C2313,C6940,CONST BE SUBROUTINE,EXTERNAL LET INITL,READR,CHNGE BE SUBROUTINE,EXTERNAL,DIRECT LET RELSE BE SUBROUTINE,DIRECT LET WKTOP,WKMIN,OLDWS,LAST,FIRST,FRLST BE INTEGER,GLOBAL LET ASCBF(6) BE INTEGER LET OLDCS BE INTEGER LET LOUT BE SUBROUTINE,EXTERNAL,DIRECT LET %NLU BE INTEGER,EXTERNAL LET ERR1 BE INTEGER(14) INITIALIZE ERR1 TO 26,"STRING UTILITY USAGE ERROR" LET EMES BE INTEGER(16) INITIALIZE EMES TO 30," ISAGN: ALL SEGMENTS NOT FOUND" LET ENDMS BE INTEGER(7) INITIALIZE ENDMS TO 11," $END,ISAGN" LET GETWK,DIAG,STPRG BE SUBROUTINE,DIRECT LET CSAC,INCS BE PSEUDO,DIRECT LET PUTWK BE SUBROUTINE,DIRECT LET ISA01 BE INTEGER(3) INITIALIZE ISA01 TO "ISA01" LET ISA02 BE INTEGER(3) INITIALIZE ISA02 TO "ISA02" LET ISA03 BE INTEGER(3) INITIALIZE ISA03 TO "ISA03" LET ISA04 BE INTEGER(3) INITIALIZE ISA04 TO "ISA04" LET ISA05 BE INTEGER(3) INITIALIZE ISA05 TO "ISA05" ! ! ! ! ISAGN:CALL RMPAR(%CLU) ! INIT1:IFNOT %CLU(1) THEN %CLU(1)_1 IFNOT %CLU(2) THEN %CLU(2)_20040K IFNOT %CLU(3) THEN %CLU(3)_20040K %PR41_%CLU(5) !CARTRIDGE %PR31_%CLU(4) !SECURITY CODE IF (%CLU(1) AND 7400K) THEN %PRS2_2,ELSE %PRS2_1 %PRS5_400K CALL XOPEN(A3DCB,%PRS5) CALL F1LCK?[CALL GT0UT] KEYWD_$1657K WHILE [IDPTR_$KEYWD] DO THRU FRSPC IF($(IDPTR+12)#ISA05(1)) THEN GOTO FRSPC IF($(IDPTR+13)#ISA05(2)) THEN GOTO FRSPC IF(($(IDPTR+14) AND 177400K)#ISA05(3)) THEN GOTO FRSPC GOTO SEG1 FRSPC:KEYWD_KEYWD+1 .B._@EMES+1 .A._EMES(1) CALL PRT1 CALL GT0UT !STOP BAD LOAD SEG1: .A._@ISA01 CALL SWAP CALL INITL ! !************************************************************* ! ! GENERATE THE INSTRUMENT TABLES FOR 2313,6940,&USER DEFINED ! !************************************************************ ! ! ! .A._@ISA03 CALL SWAP CALL C2313(NAMM,ENTM,EXTM,DBLM) IF NAMM=0 THEN GOTO SEG4 .A._@ISA02 CALL SWAP CALL OUTRL(ENTM,EXTM,0,NAMM) CALL RELSE SEG4: .A._@ISA04 CALL SWAP CALL C6940(NAMM,ENTM,EXTM,DBLM) IF NAMM=0 THEN GOTO SEG5 .A._@ISA02 CALL SWAP CALL OUTRL(ENTM,EXTM,0,NAMM) CALL RELSE SEG5: .A._@ISA05 CALL SWAP CALL CONST(NAMM,ENTM,EXTM,DBLM) .A._@ISA02 CALL SWAP CALL OUTRL(NAMM,ENTM,EXTM,DBLM) CALL RELSE ! ! TBL02:CALL WRITE(ENDBM) !END OF GEN MESSAGE %CLU(1)_%NLU %PRS2_0 CALL XCLOS(A3DCB) CALL XOPEN(A3DCB,400K) CALL F1LCK?[GOTO DONE] CALL WRITE(ENDMS) DONE: CALL WRITF(A1DCB,IERR,0,-1) CALL F1LCK?[CALL GT0UT] CALL WRITF(A2DCB,IERR,0,-1) CALL F1LCK?[CALL GT0UT] CALL CLSF1 CALL XCLOS(A2DCB) CALL XCLOS(A3DCB) CALL EXEC(6) !TERMINATE PROGRAM ! !INPUT COMMAND ! READ: SUBROUTINE FEXIT,DIRECT STPRG(NAM) CALL CMDIN(BUFFR(2),ERR) CALL F1LCK?[CALL GT0UT] BUFFR(1)_(CMCNT+1)/2 !WORD COUNT IF BUFFR(2)="/E" THEN FRETURN WSAA(NAM)_@BUFFR RETURN END ! ! ! ! !WRITE A MESSAGE ROUTINE ! WRITE:SUBROUTINE(BUF)DIRECT,GLOBAL .B._@BUF+1 .A._BUF CALL PR1NT CALL F1LCK?[CALL GT0UT] RETURN END ! ! ! ! ! SUBROUTINE TO RELEASE BLOCKS OF WORK SPACE ! BLOCK ADDRESSES ARED DEIFNED IN NAMM,ENTM,EXTM,DBLM ! RELSE:SUBROUTINE DIRECT CALL STPRG(NAMM) CALL STPRG(ENTM) CALL STPRG(EXTM) CALL STPRG(DBLM) RETURN END ! ! WSAW: PSEUDO(WSPTR) GLOBAL,DIRECT IFNOT WSAWF THEN DIAG(ERR1) IFNOT WSPTR THEN[GETWK(OLDXW);WSPTR,OLDWS_OLDXW;\ $OLDWS_WSAWV;X_1;GOTO WSAW5] IF OLDWS=OLDCS THEN OLDWS_0 IF WSPTR=OLDWS THEN[Y_OLDXW AND 77770K;Z_OLDXW AND 7K;GOTO WSAW3] OLDWS,Y_WSPTR WHILE[Z_$(Y+7)]DO Y_Z UNTIL $([OLDXW_Y+Z])=100000K DO Z_Z+1 WSAW3:$OLDXW_WSAWV IF Z#6 THEN[X_1;GOTO WSAW7] GETWK(OLDXW) $(Y+7)_OLDXW X_0 WSAW5:$(OLDXW+7)_0 WSAW7:$([OLDXW_OLDXW+X])_100000K RETURN END ! ! WORD STRING APPEND ARRAY ! ! CALLING SEQ: WSAA(WST)_ ARRAY ADDRESS ! WSAA: PSEUDO(WST)GLOBAL,DIRECT IFNOT WSAAF THEN DIAG(ERR1) ARCNT_$WSAAV !WORD COUNT IF ARCNT<0 THEN[ARCNT_(ARCNT+1)/2] FOR I_1 TO ARCNT DO[WSAW(WST)_$(WSAAV+I)] RETURN END ! ! ! INWS: PSEUDO (WSPT,INDX) GLOBAL,FEXIT,DIRECT IFNOT WSPT THEN GOTO INWS9 IF WSPT=WSPT2 THEN[IF INDX=INDX2+1 THEN \ [Z,Y_1;T_TW+1;\ IF(TW AND 7)=6 THEN T_$T;\ GOTO INWS3]] X_WSPT Y_INDX INWS1:IFNOT X THEN GOTO INWS9 IF Y > 7 THEN [Y_Y-7; X_$(X+7); GOTO INWS1],\ ELSE [Y_Y-1; Z_0] INWS2:T_X+Z INWS3:IF $T=100000K THEN GOTO INWS9 IF Z # Y THEN [Z_Z+1; GOTO INWS2] IF INWSF THEN $T_INWSV,\ ELSE INWSV_$T TW_T INDX2_INDX WSPT2_WSPT RETURN INWS9:IF INWSF THEN DIAG(ERR1) ,ELSE INWSV_0 FRETURN END ! ! ! ! ! ! ! ! ! STPRG RETURNS BLOCKS OF 8 WORDS,EITHER STRINGS OR STACKS, TO ! THE FREE WORKSPACE AREA,ZEROING ITS ARGUMENT ON RETURN. ! THE LAST BLOCK IN EITHER IS FOUND BY CHAINING THRU THE BLOCKS, ! UNTIL EITHER THE LAST WORD IN A BLOCK IS ZERO (STACKS &CHAR. ! STRINGS) OR THE LAST WORD POINTS INTO THE BLOCK ITSELF (WORD STRING). ! STPRG:SUBROUTINE (STRPT) GLOBAL,DIRECT IF STRPT=OLDCS THEN OLDCS_0 IF STRPT=OLDWS THEN OLDWS_0 WHILE STRPT DO [STRPT_$([X_STRPT] OR 7);PUTWK(X)] RETURN END ! ! ! ! ! GETWK:SUBROUTINE(GPTR)DIRECT IF FRLST THEN [GPTR_FRLST;FRLST_$GPTR;GOTO GET9] IFNOT (LAST-FIRST)>6 THEN DIAG(ERR1) GPTR_LAST-7 LAST_GPTR-1 GET9: $(GPTR OR 7)_0 RETURN END ! PUTWK:SUBROUTINE(PPTR)DIRECT IFNOT PPTR THEN RETURN DO[I,K_@FRLST;L_0;M_PPTR AND 77770K] PUT1: I_$[J_I] IF J-I=8 THEN GOTO PUT3 IF I THEN GOTO PUT4 IF J-M#8 THEN GOTO PUT4 PUT3: IFNOT L THEN L_J GOTO PUT2 PUT4: K_J L_0 PUT2: IF I=>M THEN GOTO PUT1 DO[$J_M;$M_I] IF M=(LAST+1)THEN[$K_0;IF L THEN[IF L#@FRLST THEN LAST_L-1];\ LAST_LAST+8] RETURN END ! ! ! ! ! ! ! DIAGNOSTIC PR1NTER ! ! DIAG: SUBROUTINE(ERRS)GLOBAL,DIRECT CALL WRITE(ERRS) CALL GT0UT !ABORT! RETURN END ! ! CSAC: PSEUDO (CSPTR) GLOBAL,DIRECT IFNOT CSACF THEN DIAG(ERR1) IFNOT[Y_CSPTR]THEN[GETWK(OLDXC);$([CSPTR,OLDCS_OLDXC]+7)_0;\ GOTO CSAC9] IF OLDCS=OLDWS THEN OLDCS_0 IF CSPTR=OLDCS THEN[Y_OLDXC AND 77770K;Z_OLDXC AND 7K;\ IF LRFLG=200K THEN GOTO CSAC5,ELSE GOTO CSAC9] OLDCS_CSPTR WHILE $[OLDXC_Y+7] DO Y_$OLDXC Z_-1 CSAC1:IF($[OLDXC_Y+[Z_Z+1]]AND 177400K)=100000K THEN GOTO CSAC9 IF($OLDXC AND 377K)#200K THEN GOTO CSAC1 CSAC5:$OLDXC_($OLDXC AND 177400K)OR(CSACV AND 377K) IF Z=6 THEN[GETWK(OLDXC);$(Y+7)_OLDXC;$(OLDXC+7)_0],\ ELSE OLDXC_OLDXC+1 $OLDXC,LRFLG_100000K RETURN CSAC9:LRFLG_200K $OLDXC_LRFLG OR((CSACV AND 377K)-<8) RETURN END ! ! INCS: PSEUDO (CSPT,INX) GLOBAL,FEXIT,DIRECT IFNOT CSPT THEN GOTO INCS9 IF CSPT=CSPT2 THEN[IF INX=INX2+1 THEN GOTO INC10] X_CSPT Y_(INX+1)>-1 INCS1:IFNOT X THEN GOTO INCS9 IF Y>7 THEN [Y_Y-7; X_$(X+7); GOTO INCS1],\ ELSE [Y_Y-1; Z_0] INCS2:T_X+Z INCS7:IF($T AND 177400K)=100000K THEN GOTO INCS9 IF($T AND 377K)=200K THEN[IF Z#Y THEN GOTO INCS9,\ ELSE[IF INX AND 1 THEN GOTO INCS3,\ ELSE GOTO INCS9 ]] IF Z # Y THEN [Z_Z+1; GOTO INCS2] INCS3:IF INX AND 1 THEN GOTO INCS5 IF INCSF THEN $T_$T AND 177400K OR INCSV AND 377K,\ ELSE INCSV_$T AND 377K GOTO INCS6 INCS5:IF INCSF THEN $T_((INCSV AND 377K)-<8)OR $T AND 377K,\ ELSE INCSV_($T -> 8)AND 377K INCS6:TC_T CSPT2_CSPT INX2_INX RETURN INCS9:IF INCSF THEN DIAG(ERR1) ,ELSE INCSV_0 FRETURN INC10:Y,Z_1 IF INX AND 1 THEN[T_TC+1;IF(T AND 7)=7 THEN T_$T],\ ELSE T_TC GOTO INCS7 END ! END ISAGN END$