! DATED 27 JUL 79 ! CONSTINTEGER INVI=X'80308030' SYSTEMINTEGERMAPSPEC COMREG(INTEGER I) ROUTINESPEC RSTRG(STRINGNAME S) DYNAMICSTRINGFNSPEC UINFS(INTEGER I) DYNAMICROUTINESPEC DPOFF(RECORDNAME P) DYNAMICINTEGERFNSPEC DPERMISSION(STRING (6) OWNER,USER, C STRING (8) DATE,STRING (15) FILE, INTEGER FSYS,TYPE,ADRPRM) DYNAMICINTEGERFNSPEC DSFI(STRING (6) USER, C INTEGER FSYS,TYPE,SET,ADR) ! DYNAMICSTRINGFNSPEC DERRS(INTEGER I) DYNAMICINTEGERFNSPEC DFINFO(STRING (6) USER, STRING (15) FILE, C INTEGER FSYS,ADR) ! SYSTEMROUTINESPEC PHEX(INTEGER I) SYSTEMROUTINESPEC MOVE(INTEGER LEN,FROM,TO) SYSTEMROUTINESPEC ETOI(INTEGER AD,LEN) SYSTEMROUTINESPEC FINFO(STRING (31) S,INTEGER MODE, C RECORDNAME R, INTEGERNAME FLAG) DYNAMICINTEGERFNSPEC EXIST(STRING (63) FILE) SYSTEMROUTINESPEC NCODE(INTEGER S,F,FF) SYSTEMROUTINESPEC DISCONNECT(STRING (31) S,INTEGERNAME F) DYNAMICROUTINESPEC PROMPT(STRING (15) S) DYNAMICROUTINESPEC CLEAR(STRING (63) S) DYNAMICROUTINESPEC DEFINE(STRING (63) S) DYNAMICROUTINESPEC DETACH(STRING (255) S) SYSTEMROUTINESPEC OUTFILE(STRING (31) S, C INTEGER LENGTH,MAXBYTES,PROT, INTEGERNAME CONAD,FLAG) ! SYSTEMROUTINESPEC CONNECT(STRING (31) S, INTEGER ACC,MAXB,PROT, C RECORDNAME R, INTEGERNAME FLAG) ! RECORDFORMAT OBJF(INTEGER NEXTFREEBYTE,CODERELST,GLARELST,LDRELST,C CHKSM,DT,W6,W7) RECORDFORMAT SRCF(INTEGER NEXTFREEBYTE,TXTRELST,MAXLEN,ZERO) CONSTSTRINGNAME DATE=X'80C0003F', TIME=X'80C0004B' ! ! ! RECORDFORMAT CONRECF(INTEGER CONAD,FILETYPE,RELST,RELEND) ! RECORDFORMAT FINFRECF(INTEGER CONAD,FILETYPE,RELST,RELEND, C SIZE,RUP,EEP,MODE,USERS,ARCH, C STRING (6) TRAN,STRING (8) DATE,TIME, C INTEGER COUNT,SPARE1,SPARE2) ! CONSTSTRING (15)ARRAY OUTFMSGS(1:19)= C "INVALID NAME", "INVALID OWNER", "", "", "NO FREE FDS", "NO FREE CELLS", "FSYS FULL", "CONFLICT USE", "ON OFFER", "TWO GEN", "INVALID SIZE", "NO VM GAP", "", "USER NOT OWNER", "BEING EXEC", "", "FILE IN USE", "TOO MANY CONN", "USER NOT OWNER" ! CONSTSTRING (23)ARRAY CONNMSGS(1:24)= C "INVALID NAME", "INVALID OWNER", "NOT EXIST OR NO ACC", "REQ ACC NOT GRANTED", "", "", "", "CONFLICTING USE", "ON OFFER", ""(8), "NO VM GAP", ""(3), "BEING EXEC", "CURRENTLY IN USE", "TOO MANY FILES CONN" ! EXTERNALSTRINGFN FROMSTR(STRING (255) S,INTEGER I,J) UNLESS I<=J AND J<=LENGTH(S)>0 THEN RESULT ="" RESULT =FROMSTRING(S,I,J) END ; ! FROMSTR !-------------------------------------------------------------------------------- EXTERNALROUTINE UDERRS(INTEGER N) PRINTSTRING("FLAG =") PRINTSTRING(DERRS(N)) NEWLINE END ; ! UDERRS EXTERNALSTRINGFN HTOS(INTEGER I,PL) ! RESULT IS THE STRING OF HEX DIGITS REPRESENTING THE NUMBER I. ! THE SECOND PARAM, TO BE SET IN RANGE 1 TO 8, SPECIFIES LENGTH OF ! RESULT STRING, TRUNCATING ON THE LEFT (NO CHECKING OF THIS PARAM, OR ! OF WHAT DIGITS ARE BEING TRUNCATED) INTEGER J,K,M STRING (8) W J=ADDR(W) CYCLE M=8,-1,1 K=I&15 + '0' IF K>57 THEN K=K+7 BYTEINTEGER(J+M)=K I=I>>4 REPEAT BYTEINTEGER(J)=8 J=ADDR(W) + 8 - PL BYTEINTEGER(J)=PL RESULT =STRING(J) END ; ! HTOS !-------------------------------------------------------------------------------- EXTERNALROUTINE CONNFLAG(STRING (63) S,INTEGER FLAG) INTEGER CURRST IF FLAG#0 START CURRST=COMREG(23) SELECT OUTPUT(0) PRINTSTRING(S.": CONNECT FLAG =") WRITE(FLAG,1) PRINTSTRING(" ".CONNMSGS(FLAG)) IF 0<FLAG<=24 NEWLINE SELECT OUTPUT(CURRST) FINISH END ; ! CONNFLAG EXTERNALINTEGERFN NWFILEAD(STRING (15) S,INTEGER PGS) INTEGER I,FLAG,CURR FLAG=1 IF 0<LENGTH(S)<=15 THEN OUTFILE(S,PGS<<12,X'40000',0,I,FLAG) IF FLAG#0 START CURR=COMREG(23) SELECT OUTPUT(0) PRINTSTRING("OUTFILE FLAG =") WRITE(FLAG,1) IF FLAG>9 THEN FLAG=FLAG-6; ! 16-24 -> 10-18 IF FLAG+6=49 THEN FLAG=19 IF 0<FLAG<=19 THEN PRINTSTRING(" ".OUTFMSGS(FLAG)." ") I=0 SELECT OUTPUT(CURR) FINISH RESULT =I END ; ! NWFILEAD EXTERNALINTEGERFN TPFILEAD(STRING (15) S,INTEGER PGS) ! SAME AS NWFILEAD, BUT SETS NEXT TO TOP BIT IN "PROTECT", THUS ! FORMING A FILE MARKED "TEMPFI" INTEGER I,FLAG,CURR FLAG=1 IF 0<LENGTH(S)<=15 THEN OUTFILE(S,PGS<<12,X'40000', C X'40000000',I,FLAG) IF FLAG#0 START CURR=COMREG(23) SELECT OUTPUT(0) PRINTSTRING("OUTFILE FLAG =") WRITE(FLAG,1) IF FLAG>9 THEN FLAG=FLAG-6; ! 16-24 -> 10-18 IF FLAG+6=49 THEN FLAG=19 PRINTSTRING(" ".OUTFMSGS(FLAG)." ") I=0 SELECT OUTPUT(CURR) FINISH RESULT =I END ; ! TPFILEAD INTEGERFN SHORTCFN(STRINGNAME S) ! ! CHECK FILE NAME - 1-8 CHARS, ALPHA,NUMBERS OR HASH ! ! RESULT = 0 GOOD 1 BAD ! INTEGER CH,J,L L=LENGTH(S) RESULT =1 UNLESS 0<L<=11 CYCLE J=1,1,L CH=BYTEINTEGER(ADDR(S)+J) RESULT =1 UNLESS 'A'<=CH<='Z' OR '0'<=CH<='9' OR CH='#' REPEAT RESULT =0; ! FILENAME IS GOOD END ; ! SHORTCFN INTEGERFN CFN(STRINGNAME S) STRING (31) MAS,MEM IF S->MAS.("_").MEM THEN RESULT =SHORTCFN(MAS) ! C SHORTCFN(MEM) RESULT =SHORTCFN(S) END ; ! CFN INTEGERFN LONG CFN(STRINGNAME S) ! RESULT 0 GOOD 1 BAD STRING (63) USER,FILE IF S->USER.(".").FILE START IF LENGTH(USER)#6 OR SHORTCFN(USER)#0 OR C CFN(FILE)#0 THEN RESULT =1 RESULT =0; ! GOOD FINISH RESULT =CFN(S) END ; ! LONG CFN EXTERNALINTEGERFN RDFILEAD(STRING (63) S) RECORD R(CONRECF) 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) CONNFLAG(S,FLAG) I=R_CONAD I=0 IF FLAG#0 RESULT =I END ; ! RDFILEAD EXTERNALINTEGERFN WRFILEAD(STRING (31) S) RECORD R(CONRECF) 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) CONNFLAG(S,FLAG) I=R_CONAD I=0 IF FLAG#0 RESULT =I END ; ! WRFILEAD EXTERNALSTRINGFN ITOS(INTEGER VALUE) !********************************************************************** ! * ! TURNS AN INTEGER INTO A STRING * ! * !********************************************************************** STRING (11) S STRING (1) SIGN INTEGER J SIGN = ""; S = "" SIGN = "-" AND VALUE = -VALUE IF VALUE < 0 CYCLE J = VALUE VALUE = VALUE//10 J = J-VALUE*10+'0' S = TO STRING(J).S EXIT IF VALUE <= 0 REPEAT RESULT = SIGN.S END ; !OF STRINGFN I TO S !-------------------------------------------------------------------------------- EXTERNALROUTINE AWAIT(STRING (255) S) RECORDFORMAT PARMF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6) RECORD P(PARMF) PRINTSTRING("WAITING .. ") DPOFF(P) END ; ! AWAIT !-------------------------------------------------------------------------------- EXTERNALROUTINE COPF(STRING (71) S) INTEGER J,SIZEBYTES RECORD R(FINFRECF) STRING (63) FILE1,FILE2 INTEGER FROMAD,TOAD,FLAG UNLESS LENGTH(S)>0 AND C S->FILE1.(",").FILE2 AND C 0<LENGTH(FILE1)<=31 AND C 0<LENGTH(FILE2)<=31 THEN -> BAD FROMAD=RDFILEAD(FILE1) RETURN IF FROMAD<=0 FINFO(FILE1,0,R,FLAG) MONITOR IF FLAG#0 SIZEBYTES=R_SIZE TOAD=NWFILEAD(FILE2,(SIZEBYTES+X'FFF')>>12) RETURN IF TOAD<=0 MOVE(SIZEBYTES,FROMAD,TOAD) DISCONNECT(FILE2,J) RETURN BAD: PRINTSTRING("PARAMS? ") END ; ! COPF INTEGERFNSPEC HXSTOBIN(STRING (29) S) ! EXTERNALINTEGERFN BIN(STRING (255) S) ! RESULT IS VALUE REPRESENTED BY THE STRING PARAM ! ERROR RESULT IS X80308030 (BAD CHAR IN STRING OR BAD ! LENGTH) INTEGER I,Q,L,AS,CH,SIGN SIGN=1 WHILE S->(" ").S CYCLE ;REPEAT IF S->("-").S THEN SIGN=-1 WHILE S->(" ").S CYCLE ; REPEAT IF S->("X").S START I=HXSTOBIN(S) IF I#X'80308030' THEN I=I*SIGN RESULT =I FINISH AS=ADDR(S) L=LENGTH(S) RESULT =X'80308030' IF L=0 I=0 CYCLE Q=1,1,L CH=BYTEINTEGER(AS+Q) RESULT =X'80308030' UNLESS '0'<=CH<='9' I= 10*I + CH - 48 REPEAT RESULT =I*SIGN END ; ! BIN ROUTINE INSTRG(STRINGNAME S) ! READS NEXT LINE FROM CURRENT INPUT STREAM, SETTING S TO BE CONTENTS ! OF THE LINE WITHOUT THE NEWLINE. INTEGER I S="" UNTIL I=NL CYCLE READSYMBOL(I) S=S.TOSTRING(I) REPEAT LENGTH(S)=LENGTH(S) - 1 END ; ! INSTRG !-------------------------------------------------------------------------------- EXTERNALROUTINE RSTRG(STRINGNAME S) INSTRG(S) UNTIL S#"" END ; ! RSTRG EXTERNALINTEGERFN HXSTOBIN(STRING (29) S) ! RESULT IS VALUE REPRESENTED BY UP TO 8 HEX DIGITS IN THE PARAM. ! ERROR RESULT IS X80308030 INTEGER I,Q,L,AS,CH AS=ADDR(S) L=LENGTH(S) RESULT =X'80308030' IF L>8 OR L=0 I=0 CYCLE Q=1,1,L CH=BYTEINTEGER(AS+Q) RESULT =X'80308030' UNLESS '0'<=CH<='9' OR 'A'<=CH<='F' IF CH>'9' THEN CH=CH-55 ELSE CH=CH-48 I=I<<4 ! CH REPEAT RESULT =I END ; ! HXSTOBIN EXTERNALINTEGERFN RDINTS(STRING (63) S) ! READS NEXT UNSIGNED DEC NO. OR HEX NO. (NOT X80308030). OWNSTRING (15)ARRAY NS(1:10)=""(10) STRING (1) T STRING (63) REST INTEGER I OWNINTEGER NP=0,NL=0 IF S#"" THEN -> NONNULL START IF NP>=NL THEN START RESET: RSTRG(S) NONNULL START: NP=0; NL=0 WHILE S->(" ").S CYCLE ;REPEAT WHILE S->NS(NL+1).(" ").S CYCLE WHILE S->(" ").S CYCLE ;REPEAT IF NS(NL+1)="X" OR NS(NL+1)="-" START T=NS(NL+1) WHILE S->(" ").S CYCLE ;REPEAT UNLESS S->REST.(" ").S THEN REST=S AND S="" NS(NL+1)=T.REST FINISH NL=NL+1 REPEAT IF S#"" START NL=NL+1 NS(NL)=S FINISH FINISH !---------------------------------------- ! ! NP=NP+1 S=NS(NP) I=BIN(S) IF I=X'80308030' THEN START PRINTSTRING("INVALID HEX OR DEC NO. ") IF NP>1 START NP=NP-1 PRINTSTRING("LAST TAKEN WAS ") PRINTSTRING(NS(NP)) NEWLINE FINISH -> RESET FINISH RESULT =I END ; ! RDINTS !-------------------------------------------------------------------------------- EXTERNALROUTINE RDINT(INTEGERNAME I) I=RDINTS("") END ; ! RDINT OWNINTEGER NEXT=-1 EXTERNALSTRINGFN SEPARATE(STRINGNAME S) ! SEPARATES STRING S INTO SUB-STRINGS COMPRISING THINGS BETWEEN ! (ENDS OR) COMMAS IN S. AT SUCCESSIVE CALS OF THIS FN, S AND THE ! RESULT ARE SET TO THE "NEXT" SUB-STRING. RESULT IS "" WHEN THERE ! ARE NO SUB-STRINGS LEFT. A NULL SUB-STRING (IE. ",," IN THE ! ORIGINAL) ALSO TERMINATES THE SET OF SUB-STRINGS. OWNSTRING (127)ARRAY FS(0:19)=""(20) OWNINTEGER N=0 STRING (127) LH,RH INTEGER J ! ! IF NEXT<0 START IF LENGTH(S)=0 THEN RESULT ="" NEXT=0 WHILE S->LH.(" ").RH THEN S=LH.RH CYCLE J=0,1,19; FS(J)=""; REPEAT ; ! TO ALLOW SERIAL RE-USE N=0 FS(0)=S WHILE FS(N)->FS(N).(",").FS(N+1) THEN N=N+1 FINISH IF FS(NEXT)="" THEN NEXT=-1 AND S="" AND RESULT ="" NEXT=NEXT+1 S=FS(NEXT-1) RESULT =S END ; ! SEPARATE ! ! ROUTINE AINNER(STRING (255) S) RECORDFORMAT INDIVF(STRING (6) USER,BYTEINTEGER UPRM) RECORDFORMAT RETF(INTEGER BYTES,OWNP,EEP,SPARE, C RECORDARRAY INDIV(0:15)(INDIVF)) RECORD P(RETF) INTEGER I,J,TYPE ROUTINESPEC OUT(INTEGER A) IF S#"" START J=DPERMISSION(UINFS(1),"","",S,-1,4,ADDR(P)); ! GIVE LIST FOR FILE TYPE=4 IF J#0 THEN -> MONPRM PRINTSTRING("OWNP: "); OUT(P_OWNP) PRINTSTRING("; EEP: "); OUT(P_EEP); NEWLINE I=0 J=16 WHILE J<P_BYTES CYCLE SPACE; PRINTSTRING(P_INDIV(I)_USER) OUT(P_INDIV(I)_UPRM); NEWLINE J=J+8 I=I+1 REPEAT FINISH ; ! S NOT "" J=DPERMISSION(UINFS(1),"","",S,-1,8,ADDR(P)); ! GIVE LIST FOR INDEX TYPE=8 IF J#0 THEN -> MONPRM I=0 J=16 WHILE J<P_BYTES CYCLE PRINTSTRING("+") PRINTSTRING(P_INDIV(I)_USER) OUT(P_INDIV(I)_UPRM); NEWLINE J=J+8 I=I+1 REPEAT RETURN MONPRM: PRINTSTRING("DPERM"); WRITE(TYPE,1) PRINTSTRING(" FLAG ="); WRITE(J,1); NEWLINE RETURN ROUTINE OUT(INTEGER A) SPACE IF A&4#0 THEN PRINTSTRING("X") IF A&2#0 THEN PRINTSTRING("W") IF A&1#0 THEN PRINTSTRING("R") END ; ! OUT END ; ! AINNER ! ! !-------------------------------------------------------------------------------- EXTERNALROUTINE QINFO(STRING (255) FILE) RECORDFORMAT DFINFRECF(INTEGER NKB,RUP,EEP,APF,USE,ARCH,FSYS, C CONSEG,CCT,CODES,CODES2,SSBYTE, STRING (6) OFFER) RECORD X(DFINFRECF) CONSTINTEGER UNAVA=1, WRCONN=1 CONSTINTEGER OFFER=2, NEWGE=2 CONSTINTEGER TEMPFI=4, OLDGE=4 CONSTINTEGER VTEMPF=8, WSALLOW=8 CONSTINTEGER TEMPFS=12 CONSTINTEGER CHERSH=16, COMMS=16 CONSTINTEGER PRIVAT=32, DISCFI=32 CONSTINTEGER VIOLAT=64 CONSTINTEGER NOARCH=128, DEAD=128 INTEGER J STRING (31) USER ! STRING (31) W1,W2 WHILE SEPARATE(FILE)#"" CYCLE J=0 USER="" IF FILE->USER.(".").FILE START J=8 UNLESS (LENGTH(USER)=6 OR LENGTH(USER)=0) AND C 0<LENGTH(FILE)<=11 FINISH USER=UINFS(1) IF USER="" X=0 J=DFINFO(USER,FILE,-1,ADDR(X)) IF J=0 IF X_CODES&CHERSH#0 THEN PRINTSYMBOL('*') AND SPACE PRINTSTRING(FILE.":") IF J#0 START UDERRS(J) CONTINUE FINISH PRINTSTRING(" CONN ") IF X_CONSEG>15 THEN PRINTSYMBOL('X') PRINTSTRING(HTOS(X_CONSEG,2)) PRINTSTRING("; PGS ") IF X_NKB>>2>15 THEN PRINTSYMBOL('X') PRINTSTRING(HTOS(X_NKB>>2,3)) PRINTSTRING("; OWP"); WRITE(X_RUP,1) PRINTSTRING("; EEP"); WRITE(X_EEP&15,1) PRINTSTRING("; APF "); PRINTSTRING(HTOS(X_APF,3)) PRINTSTRING("; USERS"); WRITE(X_USE,1) PRINTSTRING("; POOL"); WRITE(X_SSBYTE,1) IF LENGTH(X_OFFER)=6 THEN PRINTSTRING("; OFF: ".X_OFFER) IF X_CODES&VIOLAT#0 THEN PRINTSTRING("; VIOL") IF X_CODES&TEMPFS#0 THEN PRINTSTRING("; ") IF X_CODES&VTEMPF#0 THEN PRINTSTRING("V") IF X_CODES&TEMPFS#0 THEN PRINTSTRING("TEMPFI") IF X_CODES&NOARCH#0 THEN PRINTSTRING("; NOARCH") IF X_CODES2&(NEWGE!OLDGE)#0 THEN PRINTSTRING("; GENRS") NEWLINE ! %IF S->W1.(".").W2 %THEN %CONTINUE ! J=0 ! %WHILE J<U_CT %CYCLE ! PRINTSTRING(U_PS(J)_USER ) ! WRITE(U_PS(J)_PRM,1) ! NEWLINE ! J=J+1 ! %REPEAT REPEAT NEWLINE END ; ! QINFO !-------------------------------------------------------------------------------- EXTERNALROUTINE AINFO(STRING (63) S) IF S="" THEN AINNER("") AND RETURN WHILE SEPARATE(S)#"" CYCLE PRINTSTRING(S." ") AINNER(S) REPEAT END ; ! AINFO !-------------------------------------------------------------------------------- EXTERNALROUTINE DUMP(INTEGER START,FINISH,PRINTST,LIM) ! ! DUMP ROUTINE FOR .LP OR EQUIVALENT FILE ! ! LIM GIVE BYTES PER LINE REQUIRED ! BUT IN ADDITION, LIM=-1 WILL GIVE LIM=32, AND ! LIM=-16 WILL GIVE LIM=16 AND EBCDIC PRINT, AND ! LIM=-32 WILL GIVE LIM=32 AND EBCDIC PRINT ROUTINESPEC EXLINES INTEGER K,SAMEAS,MSGIND,ACURL INTEGER ALIGN,MAINSTOP,LM1,ACL4 INTEGER ZER,EBCDIC BYTEINTEGER CH2 EBCDIC=0 PRINTST=START IF PRINTST=-1 IF START&3#PRINTST&3 THEN PRINTSTRING("DUMP: WRONG PARAMS ") START=START&(¬3) FINISH=FINISH&(¬3) PRINTST=PRINTST&(¬3) MSGIND=0 IF LIM=-16 THEN EBCDIC=1 AND LIM=16 IF LIM=-32 THEN EBCDIC=1 AND LIM=32 LIM=32 UNLESS LIM=16; ! ONLY THESE TWO VALUES VALID LM1=LIM-1 ALIGN=PRINTST&LM1 ACURL=START-ALIGN PRINTST=PRINTST-ALIGN MAINSTOP=FINISH&(¬LM1) EXLINES EXLINES WHILE ACURL<MAINSTOP CYCLE ACL4=ACURL+LIM-4 SAMEAS=1 CYCLE K=ACURL,4,ACL4 IF INTEGER(K-LIM)#INTEGER(K) THEN SAMEAS=0 AND EXIT REPEAT IF SAMEAS=0 THEN MSGIND=0 ELSE MSGIND=MSGIND+1 IF MSGIND=0 START ; ! NOT SAME, GO ON ! PRINT ADDRESS OF LINESTART PRINTSYMBOL('(') PHEX(PRINTST) PRINTSTRING(") ") ! PRINT HEX PART CYCLE K=ACURL,4,ACL4 PRINTSTRING(" ") PHEX(INTEGER(K)) REPEAT PRINTSTRING(" ") ! PRINT CHAR PART CYCLE K=ACURL,1,ACURL+LM1 CH2=BYTEINTEGER(K) IF EBCDIC#0 THEN ETOI(ADDR(CH2),1) IF 32<=CH2<122 THEN PRINTSYMBOL(CH2) ELSE SPACE REPEAT NEWLINE FINISH ELSE START ; ! NOT SAME, GO ON/ELSE START SAME IF MSGIND=1 START PRINTSYMBOL('(') PHEX(PRINTST) PRINTSTRING(") ") ZER=1 CYCLE K=ACURL,4,ACL4 IF INTEGER(K)#0 THEN ZER=0 AND EXIT REPEAT IF ZER=0 THEN PRINTSTRING("SAME AS ABOVE") C ELSE PRINTSTRING("ZEROES") NEWLINE FINISH FINISH ; ! SAME ACURL=ACURL+LIM PRINTST=PRINTST+LIM REPEAT EXLINES RETURN ! ROUTINE EXLINES !--- STARTING AND FINAL LINES --- RETURN UNLESS ACURL+LIM>START AND ACURL<FINISH ! PRINT ADDRESS OF LINESTART PRINTSYMBOL('(') PHEX(PRINTST) PRINTSTRING(") ") ! PRINT HEX PART CYCLE K=ACURL,4,ACURL+LIM-4 PRINTSTRING(" ") IF START<=K<FINISH THEN PHEX(INTEGER(K)) ELSE SPACES(8) REPEAT PRINTSTRING(" ") ! PRINT CHAR PART CYCLE K=ACURL,1,ACURL+LIM-1 CH2=BYTEINTEGER(K) IF EBCDIC#0 THEN ETOI(ADDR(CH2),1) IF START<=K<=FINISH AND 32<=CH2<=122 THEN C PRINTSYMBOL(CH2) ELSE SPACE REPEAT ACURL=ACURL+LIM PRINTST=PRINTST+LIM NEWLINE END ; ! EXLINES END ; ! DUMP ROUTINE REDUCE PARAMS(INTEGER A,B,C,D) NCODE(A,B,C) D=0 END ; ! REDUCE PARAMS ROUTINE OCDUMP(STRING (71) S,ROUTINE DUMPRT,INTEGER TYPE) ! SPEC DUMPRT(INTEGER I,J,K,L) INTEGER PAR,ST,FI,FILEAD INTEGER MARG,PRINTST,LIM STRING (71) FIS,STS,DEVS,FILE RECORDNAME HDR(SRCF) ! PAR=1 PROMPT("FILE: ") NEXT=-1 FILE=SEPARATE(S) WHILE LONG CFN(FILE)#0 THEN RSTRG(FILE) FILEAD=RDFILEAD(FILE) IF FILEAD=0 THEN RETURN HDR==RECORD(FILEAD) STS=SEPARATE(S) PROMPT("RELSTART: ") ST=RDINTS(STS) PROMPT("RELFINISH: ") FIS=SEPARATE(S) FI=RDINTS(FIS) IF TYPE=2 START ; ! DUMPCODE UNLESS 0<=ST<FI AND FI<=HDR_MAXLEN THEN -> FAIL FINISH IF FI=0 THEN FI=HDR_NEXTFREEBYTE DEVS=SEPARATE(S) PROMPT("TO FILE/DEV: ") WHILE ".OUT"#DEVS AND FROMSTR(DEVS,1,3)#".LP" AND C CFN(DEVS)#0 THEN RSTRG(DEVS) DEFINE("ST63,".DEVS) SELECT OUTPUT(63) IF DEVS#".OUT" START MARG=132 PRINTSTRING("DUMPED FROM FILE: ".FILE) SPACES(5) PRINTSTRING(DATE." ".TIME) NEWLINES(3) FINISH ELSE MARG=72 PRINTST=FILEAD+ST IF TYPE=2 THEN PRINTST=ST; ! "FIDDLE-FACTOR" FOR NCODE LIM=16 IF MARG>72 THEN LIM=32 IF TYPE=3 THEN LIM=-LIM DUMPRT(FILEAD+ST,FILEAD+FI,PRINTST,LIM) NEWLINES(2) SELECT OUTPUT(0) CLOSE STREAM(63) CLEAR("") RETURN FAIL: PRINTSTRING("ADDRESSES MUST BE REL TO FILE START AND WITHIN FILE LENGTH ") END ; ! OCDUMP !-------------------------------------------------------------------------------- EXTERNALROUTINE DUMPFILE(STRING (71) S) OCDUMP(S,DUMP,1) END ; ! DUMPFILE !-------------------------------------------------------------------------------- EXTERNALROUTINE DUMPCODE(STRING (71) S) OCDUMP(S,REDUCE PARAMS,2) END ; ! DUMPCODE !-------------------------------------------------------------------------------- EXTERNALROUTINE NRCODE(STRING (71) S) OCDUMP(S,REDUCE PARAMS,2) END ; ! NRCODE !-------------------------------------------------------------------------------- EXTERNALROUTINE EBCDICDUMP(STRING (71) S) OCDUMP(S,DUMP,3) END ; ! EBCDICDUMP !-------------------------------------------------------------------------------- EXTERNALROUTINE DUMPVM(STRING (255) S) INTEGER LIM INTEGER START,FINISH,AS AT,J,SEGAD LIM=32 PROMPT("ADDR OR SEGNO: ") RDINT(START) IF 0< START < 1<<18 START PROMPT("RELSTART: ") RDINT(J) START=START<<18 + J FINISH SEGAD=START&X'FFFC0000' PROMPT("ADDR OR RELEND:") RDINT(FINISH) IF 0< FINISH < 2<<18 THEN FINISH=SEGAD + FINISH AS AT=0 PROMPT("TO FILE/DEV: ") RSTRG(S) DEFINE("STREAM01,".S) SELECT OUTPUT(1) IF S=".OUT" THEN LIM=16 ELSE START PROMPT("TITLE: ") RSTRG(S) PRINTSTRING(S) NEWLINES(4) FINISH DUMP(START,FINISH,START,LIM) NEWLINE SELECT OUTPUT(99) CLOSE STREAM(1) CLEAR("") END ; ! DUMPVM ROUTINE ISEARCH(INTEGER FROM,TO,SEGAD) STRING (63) TYPE,SEEK STRING (63) FILE INTEGER LSEEKM1,ASEEKPLUS1 INTEGER J,K,FIN INTEGER SEEK1,SEEK2 J=FROM FIN=TO PROMPT("STR/SHORT/INT: ") RSTRG(TYPE) UNTIL TYPE="STR" OR TYPE="SHORT" OR TYPE="INT" IF TYPE="SHORT" THEN -> SHORT IF TYPE="INT" THEN -> INT ! THEN STRING PROMPT("STRING: ") RSTRG(SEEK) LSEEKM1=LENGTH(SEEK) - 1 ASEEKPLUS1=ADDR(SEEK) + 1 UNTIL J>FIN-LSEEKM1 CYCLE CYCLE K=0,1,LSEEKM1 IF BYTEINTEGER(J+K)#BYTEINTEGER(ASEEKPLUS1+K) THEN EXIT -> FOUND IF K=LSEEKM1; ! GOT THROUGH ALL BYTES WITHOUT DISAGREEMENT REPEAT J=J+1 REPEAT -> NOT FOUND ! SHORT: PROMPT("SEARCH FOR: ") RDINT(SEEK2) UNTIL SEEK2&X'FFFF0000'=0 UNTIL J>FIN-2 CYCLE IF J&3=0 THEN K=INTEGER(J)>>16 ELSE K=INTEGER(J)&X'FFFF' IF K=SEEK2 THEN -> FOUND J=J+2 REPEAT -> NOT FOUND ! INT: PROMPT("SEARCH FOR: ") RDINT(K) SEEK1=K>>16 SEEK2=K&X'FFFF' UNTIL J>FIN-4 CYCLE IF J&3=0 START IF INTEGER(J)=K THEN -> FOUND FINISH ELSE START IF INTEGER(J-2)&X'FFFF'=SEEK1 AND C INTEGER(J+2)>>16=SEEK2 THEN -> FOUND FINISH J=J+2 REPEAT ! NOT FOUND: PRINTSTRING(" NOT FOUND ") RETURN FOUND: PRINTSTRING(" FOUND: ") K=J+16 K=FIN IF K>FIN J=J-16 J=SEGAD IF J<SEGAD DUMP(J,K,J-SEGAD,16) NEWLINE END ; ! ISEARCH !-------------------------------------------------------------------------------- EXTERNALROUTINE SEARCHVM(STRING (255) S) INTEGER LIM INTEGER START,FINISH,AS AT,J,SEGAD LIM=32 PROMPT("ADDR OR SEGNO: ") RDINT(START) IF 0< START < 1<<18 START PROMPT("RELSTART: ") RDINT(J) START=START<<18 + J FINISH SEGAD=START&X'FFFC0000' PROMPT("ADDR OR RELEND:") RDINT(FINISH) IF 0< FINISH < 2<<18 THEN FINISH=SEGAD + FINISH ISEARCH(START,FINISH,SEGAD) END ; ! SEARCHVM !-------------------------------------------------------------------------------- EXTERNALROUTINE YSEARCH(STRING (255) S) STRING (63) FILE INTEGER START,J,K,FIN PROMPT("FILE: ") RSTRG(FILE) START=RDFILEAD(FILE) RETURN IF START<=0 PROMPT("RELSTART: ") RDINT(J) PROMPT("RELFINISH: ") RDINT(K) UNTIL K>J FIN=START + K ISEARCH(START+J,FIN,START) END ; ! YSEARCH !-------------------------------------------------------------------------------- EXTERNALROUTINE YCOMP(STRING (255) S) RECORD FINF(FINFRECF) INTEGER ORIGS1,FLAG STRING (63) FILE1,FILE2 INTEGER U,V,S1,S2,SA,LIM PROMPT("FILE1: ") RSTRG(FILE1) PROMPT("FILE2: ") RSTRG(FILE2) PROMPT("REL START: ") RDINT(SA) SA=SA & (¬B'11'); ! ALIGN TO WORD S1=RDFILEAD(FILE1) S2=RDFILEAD(FILE2) RETURN IF S1<=0 OR S2<=0 ORIGS1=S1 FINFO(FILE1,0,FINF,FLAG) IF FLAG#0 START PRINTSTRING("ERROR"); WRITE(FLAG,1); NEWLINE; RETURN FINISH LIM=FINF_SIZE FINFO(FILE2,0,FINF,FLAG) IF FLAG#0 START PRINTSTRING("ERROR"); WRITE(FLAG,1); NEWLINE; RETURN FINISH ! SET LIM TO SHORTER OF THE TWO FILESIZES IF LIM>FINF_SIZE THEN LIM=FINF_SIZE S1=S1 + SA S2=S2 + SA LIM=ORIGS1 + LIM CYCLE U=INTEGER(S1) V=INTEGER(S2) IF U#V THEN -> DIFF S1=S1+4 S2=S2+4 -> DONE IF S1>=LIM REPEAT DIFF: PRINTSTRING("DIFF AT REL ADDRESS: ") PHEX(S1 - ORIGS1) SPACES(5) PHEX(U); SPACES(2) PHEX(V); NEWLINE RETURN DONE: PRINTSTRING("FINISHED AT REL ADDRESS: ") PHEX(S1-ORIGS1) NEWLINE END ; ! YCOMP !-------------------------------------------------------------------------------- EXTERNALROUTINE COMPARE(STRING (255) S) ! IF NULL PARAMETER IS SUPPLIED, THE PROGRAM PROMPTS FOR INPUT FILES ! FOR COMPARISON. IT THEN PROMPTS : FOR THE "COMPARE" ! COMMANDS. ! IF PARAMETER COMPRISES TWO FILENAMES SEPARATED BY COMMA, THEN ! COMPARISON COMMENCES RIGHT AWAY. ! UNLESS A THIRD PARAMETER ,.F IS APPENDED, THE PROGRAM RETURNS ! AFTER A DIFFERENCE HAS BEEN FOUND. IT RETURNS ANYWAY IF THE FILES ! ARE FOUND IDENTICAL. ! STRING (131)FNSPEC RSTRG ROUTINESPEC LRSTRG(STRINGNAME S) RECORDNAME H(SRCF) INTEGER I,J,C,F,AS,L,AGOFLAG,FNCALL INTEGER OUTSTRM,OUTFILE,CUR IN TO OUT STRING (63) U,V,PD,MEM STRING (255)ARRAY CUR(1:2) INTEGER CURIP INTEGERARRAY FP,FL(1:2) SWITCH A('A':'Z') FNCALL=0 OUTSTRM=0 CUR IN TO OUT=1 CURIP=1 AS=ADDR(S) AGOFLAG=0 OUTFILE=0 U=""; V="" IF LENGTH(S)>0 START UNLESS S->U.(",").V START IF S->PD.("_").MEM START IF EXIST(MEM)#0 THEN U=PD."_".MEM AND V=MEM FINISH FINISH AGOFLAG=1 OUTFILE=0 S=".N" ! IF PARAMETER ,.F APPENDED, WE SET "FNCALL" TO INDICATE RETURN ! REQUIRED AFTER DIFFERENCE FOUND, AS WELL AS WHEN IDENTITY FOUND. IF V->V.(",.F") THEN FNCALL=1 FINISH IF U="" START PROMPT("FILE1:") U=RSTRG FINISH I=RDFILEAD(U) H==RECORD(I) RETURN IF I<=0 FP(1)=I+H_TXTRELST; FL(1)=I+H_NEXTFREEBYTE IF V="" START PROMPT("FILE2:") V=RSTRG FINISH J=RDFILEAD(V) RETURN IF J<=0 H==RECORD(J) FP(2)=J+H_TXTRELST; FL(2)=J+H_NEXTFREEBYTE ADVANCE: CURIP=1 LRSTRG(CUR(1)) CURIP=2 LRSTRG(CUR(2)) IF LENGTH(CUR(1))=255 START ;F=1;->EOF;FINISH IF LENGTH(CUR(2))=255 START ;F=2; ->EOF; FINISH IF AGOFLAG#0 START AGOFLAG=0 S="GO" -> L11 FINISH NEXTCMD: PROMPT(":") S=RSTRG L11: L=LENGTH(S) C=BYTEINTEGER(AS+1) F=BYTEINTEGER(AS+2) - '0' -> NO UNLESS C='M' OR C='P' OR C='G' OR C='F' OR C='Q' C OR C='A' OR C='E' -> A(C) ! ! A('A'): -> NO UNLESS L=1 OR S="AGO" AGOFLAG=1 -> ADVANCE ! ! A('M'): -> NO UNLESS L>=3 AND 1<=F<=2 S=FROMSTRING(S,3,L) I=BIN(S) -> NO IF I<=0 CURIP=F CYCLE J=1,1,I LRSTRG(CUR(F)) IF LENGTH(CUR(F))=255 THEN -> EOF REPEAT -> PRINT BOTH ! ! A('E'): A('Q'): -> NO UNLESS L=1 RETURN ! ! A('P'): -> NO UNLESS L=2 AND (1<=F<=2 OR F+'0'='B') IF F+'0'='B' START PRINT BOTH: IF LENGTH(CUR(1))=255 THEN PRINTSTRING("**EOF1** ") ELSE PRINTSTRING(CUR(1) ." ") IF LENGTH(CUR(2))=255 THEN PRINTSTRING("**EOF2** ") ELSE PRINTSTRING(CUR(2)." ") -> NEXTCMD FINISH IF LENGTH(CUR(F))=255 THEN PRINTSTRING("**EOF** ") ELSE PRINTSTRING(CUR(F)." ") -> NEXTCMD ! ! A('G'): L50: -> NO UNLESS L=2 AND F+'0'='O' IF CUR(1)#CUR(2) AND LENGTH(CUR(1))<255 C AND LENGTH(CUR(2))<255 THEN -> DIFF IF LENGTH(CUR(1))=255 THEN -> EOFS CURIP=1 LRSTRG(CUR(1)) CURIP=2 LRSTRG(CUR(2)) -> L50 ! ! A('F'): -> NO UNLESS L>2 AND (1<=F<=2 OR F+'0'='B') S=FROMSTRING(S,3,L) IF F+'0'='B' THEN J=0 ELSE J=1 ! J=0 MEANS DO BOTH FILES, 1 MEANS DO JUST ONE. IF J=0 THEN F=1 L22: CURIP=F L20: IF LENGTH(CUR(F))=255 THEN -> EOF IF CUR(F)->U.(S).V THEN -> L25 LRSTRG(CUR(F)) -> L20 L25: -> PRINT BOTH IF J=1 ! THEN BOTH FILES ARE BEING DONE. NO. 2 NEXT. F=2 J=1; ! TO STOP IT AFTER THIS TIME. -> L22 ! ! NO: PRINTSTRING("NO ") -> NEXTCMD DIFF: PRINTSTRING("DIFF ") CYCLE J=1,1,2 SPACES(20) IF FNCALL#0 PRINTSTRING(CUR(J)) NEWLINE REPEAT IF FNCALL#0 THEN RETURN -> NEXTCMD EOF: PRINTSTRING("EOF"); WRITE(F,1) NEWLINE RETURN EOFS: PRINTSTRING("COMPARISON COMPLETE ") RETURN ! ! STRING (255) FN RSTRG STRING (131) S INTEGER I,CT,AS AS=ADDR(S) NEW: CT=0 L1: READSYMBOL(I) -> L9 IF I=10 CT=CT+1 BYTEINTEGER(AS+CT)=I -> L1 L9: BYTEINTEGER(AS)=CT IF S="" THEN -> NEW RESULT =S END ; ! RSTRG ROUTINE LRSTRG(STRINGNAME S) ! SETS S TO THE NEXT LINE (WITHOUT THE NL CHARACTER) FROM THE ! RELEVANT FILE AND SETS FP(CURIP) TO POINT TO THE CHARACTER ! AFTER THE NL. INTEGER AS,CURP,I,L AS=ADDR(S) CURP=FP(CURIP) I=FL(CURIP) IF CURP>=I THEN -> LEOF L=0 WHILE BYTEINTEGER(CURP)#10CYCLE L=L+1 BYTEINTEGER(AS+L)=BYTEINTEGER(CURP) CURP=CURP+1 REPEAT BYTEINTEGER(AS)=L -> OUT LEOF: BYTEINTEGER(AS)=255; ! EOF INDICATION OUT: FP(CURIP)=CURP+1; ! POINTS TO CHAR AFTER NEWLINE RETURN END ; ! LRSTRG END ; ! COMPARE !-------------------------------------------------------------------------------- EXTERNALROUTINE NOF(STRING (255) S) INTEGER FILES,USEDFDS,FREEBYTES,ISIZE KB,NCELLS, C FREECELLS,NCELLS1,FREECELLS1 ! THE ORDER MUST REMAIN THE SAME FOR THE ABOVE !! INTEGER J FILES=0; USEDFDS=0; FREEBYTES=0; NCELLS=0; FREECELLS=0 NCELLS1=0; FREECELLS1=0 J=DSFI(UINFS(1),-1,4,0,ADDR(FILES)) IF J#0 START UDERRS(J) RETURN FINISH PRINTSTRING("FILES "); WRITE(FILES,1); NEWLINE PRINTSTRING("USEDFDS "); WRITE(USEDFDS,1); NEWLINE PRINTSTRING("FREEBYTES "); WRITE(FREEBYTES,1); NEWLINE PRINTSTRING("ISIZE KB "); WRITE(ISIZE KB,1); NEWLINE PRINTSTRING("CELLS/FREEC"); WRITE(NCELLS,1); PRINTSYMBOL('/') WRITE(FREECELLS,1) WRITE(NCELLS1,4); PRINTSYMBOL('/'); WRITE(FREECELLS1,1) NEWLINE END ; ! NOF !-------------------------------------------------------------------------------- EXTERNALROUTINE NKB(STRING (255) S) INTEGER J,FSYS INTEGER MAXFILE,MAXKB INTEGER NOF,TOTKB,NOCHER,CHERKB,NOTEMP,TEMPKB STRING (31) USER FSYS=-1 USER=UINFS(1) MAXFILE=0; MAXKB=0 NOF=0; TOTKB=0; NOCHER=0; CHERKB=0; NOTEMP=0; TEMPKB=0 FSYS=-1 J=DSFI(USER,FSYS,11,0,ADDR(MAXKB)) UDERRS(J) IF J#0 J=DSFI(USER,FSYS,12,0,ADDR(MAXFILE)) UDERRS(J) IF J#0 J=DSFI(USER,FSYS,30,0,ADDR(NOF)) UDERRS(J) IF J#0 PRINTSTRING("Single file limit =") WRITE(MAXFILE,1); PRINTSTRING(" Kbytes"); NEWLINE PRINTSTRING("Total file limit =") WRITE(MAXKB,1); PRINTSTRING(" Kbytes") PRINTSTRING(" total Kbytes =") WRITE(TOTKB,1); NEWLINE PRINTSTRING("No of files ") WRITE(NOF,1); NEWLINE PRINTSTRING("No of temp files =") WRITE(NOTEMP,1); NEWLINE PRINTSTRING("Amount of temp file space =") WRITE(TEMPKB,1) NEWLINE END ; ! NKB !-------------------------------------------------------------------------------- EXTERNALROUTINE TIM(STRING (255) S) PRINTSTRING(TIME) NEWLINE END ; ! TIM !-------------------------------------------------------------------------------- EXTERNALROUTINE DETA(STRING (255) S) ROUTINESPEC SET CPU FIELD INTEGER K,AS,AT,FAD,LIMFIELD,DO DET RECORDNAME H(SRCF) STRING (63) TIM FAD=NWFILEAD("SS#DET",1) DEFINE("STREAM55,SS#DET") SELECT OUTPUT(55) PRINTSTRING("CPULIMIT(0000) CPULIMIT 0000 ") AS=ADDR(S) AT=ADDR(TIM) DO DET=0 PROMPT(":") MOREIP: RSTRG(S) IF S="Q" THEN DO DET=1 AND -> ENDIP IF S="%C" THEN -> ENDIP TIM="20" K=BIN(S) IF 0<K<=600 THEN TIM=S AND -> ENDIP PRINTSTRING(S) NEWLINE -> MOREIP ENDIP: S="SS#DET" IF TIM#"" THEN S=S."," S=S.TIM SELECT OUTPUT(99) CLOSE STREAM(55) CLEAR("") RETURN IF DO DET#0 FAD=WRFILEAD("SS#DET") RETURN IF FAD=0 H==RECORD(FAD) ! SET LIMFIELD TO POINT TO THI CPULIMIT NUMERIC FIELD LIMFIELD=FAD + H_TXTRELST SET CPU FIELD LIMFIELD=LIMFIELD + 5 SET CPU FIELD DETACH(S) RETURN ROUTINE SET CPU FIELD INTEGER J UNTIL BYTEINTEGER(LIMFIELD)='0' THEN LIMFIELD=LIMFIELD+1 IF 0<LENGTH(TIM)<=4 START CYCLE J=LENGTH(TIM),-1,1 BYTEINTEGER(LIMFIELD+3-LENGTH(TIM)+J)=BYTEINTEGER(AT+J) REPEAT FINISH END ; ! SET CPU FIELD END ; ! DETA ENDOFFILE