PROGRAM REORGANZ;CONST MAXRECSIZE=1000; PROGRAMNR=1;TYPE'PARMARRAY=PACKED ARRAY (1..39) OF CHAR;'INIVEAU=(MENIG,SERGENT,L\JTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);IPOSTADR=0..MAXRECSIZE;ICOMMBUF =ARRAY (POSTADR) OF INTEGER;(*commbuf(0)=filnr,resten er posten*)IPOINTREC=^COMMBUF;NAME =STRING(10);PCB =^INTEGER;GMESSAGETYPE=(]BEN,LUK,L[SPOST,L[SPOSTX,N[STE,N[STEX,SLET,SLETX,GEMPOST,GN INDS[T,INITIER,UTILMELD,UAFMELD,PTILMELD,PAFMELD,STOPSYS, NH RETURNHEAD,RETURNSTAT); HMESSAGE =RECORD KOMMANDO:MESSAGETYPE; INFO,IREC:INTEGER END; AR=ARRAY (-4..-4) OF INTEGER;VAR PARM:^PARMARRAY; USERNIVEAU:NIVEAU; F:STRING(18); QUQ:^INTEGER;' IER,IREC,STATUSER,MODE,REMUSERS,'# FILNR,I,FRANR,TILNR:INTEGER;#) FNAVN,REGNAVN,DESCNAVN:STRING(18);) SEMAFOR:NAME; FILEINIT:BOOLEAN; SNYD:AR; CPPCB:PCB; COMREC:POINTREC; BESKED:MESSAGE;(*$P*)PROCEDURE D23;BEGIN) GOTOXY(1,23);WRITE(' ':79);GOTOXY(1,23))END;$PROCEDURE BAD(IDENT,STATUS:INTEGER);$BEGIN D23; WRITE('BAD',IDENT:5,STATUS:5); READLNEND;(*$P*)5PROCEDURE ALLOCA(VAR ADDRESS:POINTREC;LENGTH:INTEGER;5% VAR STATUS:INTEGER);% EXTERNAL; 6PROCEDURE DEALLO(ADDRESS:POINTREC;VAR STATUS:INTEGER);6 EXTERNAL; 2PROCEDURE SENDM(RECEIVER:PCB;VAR CONTENTS:MESSAGE;23 LENGTH:INTEGER;VAR STATUS:INTEGER);3 EXTERNAL; 5PROCEDURE RECEIV(VAR SENDER:PCB;VAR CONTENTS:MESSAGE;5% VAR LENGTH:INTEGER);% EXTERNAL; 6PROCEDURE RESERV(RESOURCE:NAME;EXCLUSIVE,WAIT:BOOLEAN;6% VAR STATUS:INTEGER);% EXTERNAL; 3PROCEDURE RELEAS(RESOURCE:NAME;VAR STATUS:INTEGER);3 EXTERNAL; (*$IUDF\R*)(*$IFISFPROC*)(*$P*)PROCEDURE REGVEDL;CONST MAXFELTER=30; MAXN\GLER=9; MAXPOST=500;TYPE%ARAR=PACKED ARRAY (-11..-10) OF CHAR;%RAR=ARRAY (0..0) OF REAL;PPOST=RECORD AA:ARAR; A:AR; AAA:RAR;- CONTENTS: ARRAY (1..MAXPOST) OF INTEGER-END;VAR ANTALIDENT, LINES,OPTION,I,J:INTEGER; LINE:STRING; POST:PPOST;(*$P*)PROCEDURE ERROR(VAR REC:AR);VAR CH:STRING(1); I:INTEGER;BEGIN D23;L (*$R-*)LL WRITE('FEJL I REGISTER ',REC(-3),' FEJLKODE ',IER,' RETURN'); (*$R+*)L CH:=' ';EDIT(CH);. IF CH='[' THEN BEGIN IER:=0;EXIT(ERROR) END;. POST.A(-3):=TILNR; ICLOSE(POST.A);G POST.A(-3):=FRANR; (*$R+*)GA ICLOSE(POST.A); A EXIT(REGVEDL)END;(*$P*)BEGIN (*REGVEDL*) MODE:=3;(*SKRIV*)N (*$R-*)NF POST.A(-3):=TILNR; F- IOPEN(POST.A);IF IER<>0 THEN ERROR(POST.A);-0 INITIATE(POST.A);IF IER<>0 THEN ERROR(POST.A);0F POST.A(-3):=FRANR; F- IOPEN(POST.A);IF IER<>0 THEN ERROR(POST.A);-) FOR I:=1 TO POST.A(-4) DO POST.A(I):=0;)A NEXTREC(POST.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(POST.A);A IER:=0; WHILE IER=0 DO BEGIN POST.A(-3):=TILNR;0 INSERT(POST.A);IF IER<>0 THEN ERROR(POST.A);0 POST.A(-3):=FRANR; NEXTREC(POST.A) END; IF IER<>-2 THEN ERROR(POST.A); ICLOSE(POST.A); POST.A(-4):=1;M POST.A(-3):=TILNR; (*$R+*)M ICLOSE(POST.A); IF IER<>0 THEN BAD(6,IER)END;(*$P*)PROCEDURE DOIT;TYPEFILDESC=RECORD/ FILNAVN,DESCNAVN,POSTNAVN,REGNAVN:STRING(18);/ VEDLNIVEAU:NIVEAU; ZONESIZE:INTEGEREND;FILEDESC=FILE OF FILDESC;&ISF=FILE OF ARRAY (1..232) OF INTEGER;&VAR ISFFILES:FILEDESC; ISFFNAVN:STRING(18); SCH:STRING(1); J,I,AKNR:INTEGER; F,F1:ISF; PROCEDURE IOC;VAR CH:STRING(1); IOR:INTEGER;BEGIN IOR:=IORESULT; IF IOR<>0 THEN BEGIN CLEARSCREEN; D23;) WRITE('Pladefejl ',IOR:5,' RETURN ');) CH:=' '; EDIT(CH); IF CH<>'R' THEN EXIT(DOIT) ENDEND;(*$P*)BEGIN! ISFFNAVN:='ISFFILES:P2:0000:S';!! REWRITE(ISFFILES,ISFFNAVN);IOC;! REPEAT CLEARSCREEN; SEEK(ISFFILES,1);IOC; GET(ISFFILES);IOC; FILNR:=0; & WHILE ISFFILES^.FILNAVN(1)<>'@' DO& BEGIN FILNR:=FILNR+1;9 WRITELN(FILNR:4,' ',ISFFILES^.REGNAVN,'-register');9 GET(ISFFILES);IOC END; REPEAT " D23;WRITE('V{lg register ');" READLN;READ(FRANR)9 UNTIL (IORESULT=0) AND (FRANR>=0) AND (FRANR<=FILNR);9 IF FRANR>0 THEN BEGIN SEEK(ISFFILES,FRANR);IOC; GET(ISFFILES);IOC;% RESET(F,ISFFILES^.FILNAVN);IOC;% SEEK(F,1);IOC; GET(F);IOC; TILNR:=FILNR+1;; ISFFILES^.FILNAVN(2+POS(':',ISFFILES^.FILNAVN)):='1';; SEEK(ISFFILES,TILNR);IOC; PUT(ISFFILES);IOC;( REWRITE(F1,ISFFILES^.FILNAVN);IOC;( SEEK(F1,1);IOC;' FOR I:=1 TO 100 DO F1^(I):=F^(I);' IREC:=F^(22); F1^(22):=0; F1^(20):=0; F1^(21):=0; F1^(23):=0; PUT(F1);IOC; CLOSE(F1);IOC; CLOSE(F);IOC; CLOSE(ISFFILES);IOC; REGVEDL;% REWRITE(ISFFILES,ISFFNAVN);IOC;% ISFFILES^.FILNAVN(1):='@'; SEEK(ISFFILES,TILNR);IOC; PUT(ISFFILES);IOC END UNTIL FRANR=0; CLOSE(ISFFILES);IOCEND;(*$P*)BEGIN SEMAFOR:='ALLOCOMBUF'; I:=ORD(PARM^(1))-48; USERNIVEAU:=MENIG; WHILE I>0 DO BEGIN! USERNIVEAU:=SUCC(USERNIVEAU);! I:=I-1 N END; (*$R-*)N SNYD(-3):=0;> FOR I:=6 DOWNTO 2 DO SNYD(-3):=10*SNYD(-3)+ORD(PARM^(I))-48;>N IF PARM^(7)='-' THEN SNYD(-3):=-SNYD(-3); (*$R+*)N UDF\R(PTILMELD,SNYD); UDF\RT(PTILMELD,SNYD); IF IER<>0 THEN BAD(1,IER); DOIT; F:='HOVED *1'; UDF\R(PAFMELD,SNYD); UDF\RT(PAFMELD,SNYD); IF IER<>0 THEN BAD(2,IER); FNAVN:=' ';& FOR I:=1 TO 7 DO FNAVN(I):=PARM^(I);& CHAIN(F,FNAVN,QUQ);3 IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)3END.END.;3 IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)3END.,IER); REPEAT F:=' '; CLEARSCREEN; DOIT; UNTIL F<>' '; UDF\R(PAFMELD,SNYD); UDF\RT(PAFMELD,SNYD); IF IER<>0 THEN BAD(2,IER); IF F<>'STOP' THEN BEGIN FNAVN:=' ';( FOR I:=1 TO 7 DO FNAVN(I):=PARM^(I);( IF LENGTH(F)>10 THEN2 CHAIN('L *1',CONCAT(F,',',FNAVN),QUQ) 2 ELSE CHAIN(F,FNAVN,QUQ);5 IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)5 END ELSE BEGIN UDF\R(UAFMELD,SNYD); UDF\RT(UAFMELD,SNYD); IF IER<>0 THEN BAD(3,IER) ENDEND.cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc