|
DataMuseum.dkPresents historical artifacts from the history of: CR80 Hard and Floppy Disks |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CR80 Hard and Floppy Disks Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8704 (0x2200)
Types: TextFile
Names: »CNPSOD«
└─⟦927b41227⟧ Bits:30005184 8" CR80 Floppy CR80FD_0181 ( CR/D/1189 (ulæseligt) )
└─⟦cac81710b⟧
└─ ⟦this⟧ »PHO.CNPSOD«
"----------------------------------------------------------------------"
" 790523 HOH"
" CONPAS"
" ======"
" CONVERTS PASCAL PROGRAMS FROM UTILITY TO DRIVER FORMAT"
"----------------------------------------------------------------------"
%WORKAREACLAIM=3000
%SUMMARY
$PREFIX
$IODEC
"----------------------------------------------------------------------"
CONST
SIZE_DISP = 4;
PRG_DISP = 23;
REF_DISP = 54;
BUF_DISP = 55;
CURIN_DISP = 90;
NAME_DISP = 7;
SHARE_TOP = #AF7;
SHARE_BOTTOM = #189;
REFLENGTH = 4;
BUFLENGTH = 9;
NEXT = 3;
PG_HEADERLENGTH = 31;
DRIVERHEADER = 13;
"----------------------------------------------------------------------"
TYPE
REF_BUFFER = ARRAY(.1..REFLENGTH.) OF INTEGER;
BUF_BUFFER = ARRAY(.1..BUFLENGTH.) OF INTEGER;
"----------------------------------------------------------------------"
VAR
REF,BUF,REFS,BUFS: INTEGER;
ABS_ADDRESS: INTEGER;
CONSOLE, SOURCE_STREAM, OBJECT_STREAM: STREAM;
FORTOLKER: BOOLEAN;
SOURCE_NAME, OBJECT_NAME, PROCESSNAME: IDENTIFIER;
PGHEAD: ARRAY(.0..PG_HEADERLENGTH.) OF INTEGER;
WORDS: INTEGER;
PG_SIZE, CONSTS, PR_SIZE, SHARE_SIZE: INTEGER;
ASS_SIZE, PROCESS_SIZE, PRG, REFREF, BUFREF: INTEGER;
GLCOUNT: INTEGER;
$IO
PROCEDURE OUTHEX(S:STREAM; CH: UNIV CHAR; INT: UNIV INTEGER);
VAR CTRL: INTEGER;
BEGIN
OUTBYTE(S,CH);
FOR CTRL:= 4 DOWNTO 1 DO
OUTBYTE(S,BIN_TO_ASCII(GETBITS(INT,4*CTRL-1,4)));
END "OUTHEX";
"----------------------------------------------------------------------"
PROCEDURE OUTWORD(INT: UNIV INTEGER);
"----------------------------------------------------------------------"
BEGIN
IF ABS_ADDRESS MOD 8 = 0
THEN BEGIN
OUTNL(OBJECT_STREAM);
OUTHEX(OBJECT_STREAM,SP,ABS_ADDRESS);
OUTSTRING(OBJECT_STREAM, 'L(:0:)');
END;
OUTHEX(OBJECT_STREAM,SP,INT);
ABS_ADDRESS:=ABS_ADDRESS+1;
END "OUTWORD" ;
"----------------------------------------------------------------------"
PROCEDURE MAKE_BUFS(VAR BUF: INTEGER; VAR BUFS: INTEGER);
"----------------------------------------------------------------------"
VAR B: BUF_BUFFER; I: INTEGER;
BEGIN
WHILE BUFS > 0 DO
BEGIN
FOR I:= 1 TO BUFLENGTH DO B(.I.):= 0;
BUF:= BUF+BUFLENGTH;
BUFS:= PRED(BUFS);
IF BUFS > 0 THEN B(.NEXT.):= BUF;
FOR I:=1 TO BUFLENGTH DO OUTWORD(B(.I.));
END;
END "MAKE_BUFS";
"----------------------------------------------------------------------"
PROCEDURE MAKE_REFS(VAR REF: INTEGER; VAR REFS: INTEGER);
"----------------------------------------------------------------------"
VAR R:REF_BUFFER; I: INTEGER;
BEGIN
WHILE REFS > 0 DO
BEGIN
FOR I:=1 TO REFLENGTH DO R(.I.):=0;
REF:= REF+REFLENGTH;
REFS:= PRED(REFS);
IF REFS > 0 THEN R(.NEXT.):= REF;
FOR I:=1 TO REFLENGTH DO
OUTWORD(R(.I.) );
END;
END "MAKE_REFS";
"----------------------------------------------------------------------"
PROCEDURE PRESET_INPUT(S: STREAM);
"----------------------------------------------------------------------"
VAR CHA: CHAR;
BEGIN
REPEAT
INBYTE(S,CHA)
UNTIL CHA = 'P';
GLCOUNT:= 0;
END "PRESET_INPUT";
"----------------------------------------------------------------------"
PROCEDURE RESET(VAR S:STREAM;NAME:TEXT;DIR:DIRECTION);
"----------------------------------------------------------------------"
BEGIN
CLOSE(S);
OPEN(S,NAME,DIR);
PRESET_INPUT(S);
END "RESET";
"----------------------------------------------------------------------"
PROCEDURE CHECKTYPE(TAG:ARGTAG;PARMTYPE:ARGTAG; PARM:INTEGER);
"----------------------------------------------------------------------"
BEGIN
IF TAG <> PARMTYPE
THEN BEGIN
OUTSTRING(CONSOLE,'PARAMETER (:0:)');
OUTINTEGER(CONSOLE,PARM,4);
OUTSTRING(CONSOLE,' IS OF ILLEGAL TYPE(:0:)');
OUTNL(CONSOLE);
HALT;
END " ERROR PRINTOUT"
END "CHECKTYPE";
"----------------------------------------------------------------------"
PROCEDURE INWORD(S: STREAM; VAR INT: INTEGER);
"----------------------------------------------------------------------"
BEGIN
IF GLCOUNT MOD 8 = 0 THEN INHEXA(S,INT);
INHEXA(S,INT);
GLCOUNT:= SUCC(GLCOUNT);
END "INWORD";
"----------------------------------------------------------------------"
PROCEDURE SKIP(COUNT: INTEGER);
"----------------------------------------------------------------------"
VAR I,INT: INTEGER;
BEGIN
FOR I:=1 TO COUNT DO INWORD(SOURCE_STREAM,INT);
END "SKIP";
"----------------------------------------------------------------------"
PROCEDURE TRANSFER(COUNT: INTEGER);
"----------------------------------------------------------------------"
VAR I,INT: INTEGER;
BEGIN
FOR I:=1 TO COUNT DO
BEGIN
INWORD(SOURCE_STREAM,INT);
OUTWORD(INT);
END
END "TRANSFER" ;
"----------------------------------------------------------------------"
PROCEDURE READ_PARAMETERS;
"----------------------------------------------------------------------"
VAR I: INTEGER;
BEGIN
FOR I:=1 TO 7 DO
BEGIN
WITH PARAM(.I.) DO
BEGIN
CASE I OF
1:
BEGIN CHECKTYPE(TAG,IDTYPE,I);
IF ID(.1.) = 'F' THEN FORTOLKER :=TRUE
ELSE FORTOLKER :=FALSE;
END;
2:
BEGIN CHECKTYPE(TAG,IDTYPE,I);
SOURCE_NAME:=ID;
END;
3:
BEGIN CHECKTYPE(TAG,IDTYPE,I);
OBJECT_NAME:=ID;
END;
4:
BEGIN CHECKTYPE(TAG,IDTYPE,I);
PROCESSNAME:=ID;
END;
5:
BEGIN CHECKTYPE(TAG,INTTYPE,I);
ABS_ADDRESS:= INT;
END;
6:
BEGIN CHECKTYPE(TAG,INTTYPE,I);
BUFS:= INT;
END;
7:
BEGIN CHECKTYPE(TAG,INTTYPE,I);
REFS:= INT;
END
END "CASE";
END "WITH PARAM";
END;
END "READ_PARAMETERS";
"----------------------------------------------------------------------"
PROCEDURE CALCULATE_DISPS;
"----------------------------------------------------------------------"
VAR I: INTEGER;
BEGIN
FOR I:=0 TO PG_HEADERLENGTH DO INWORD(SOURCE_STREAM,PGHEAD(.I.));
WORDS:=PGHEAD(.3.);
PG_SIZE:= PGHEAD(.4.);
IF FORTOLKER THEN CONSTS:=0 ELSE CONSTS:=PGHEAD(.31.);
PR_SIZE:=PGHEAD(.11.);
SHARE_SIZE:=SHARE_TOP - SHARE_BOTTOM;
ASS_SIZE:= PR_SIZE-CONSTS-SHARE_SIZE;
PROCESS_SIZE:= ASS_SIZE+CONSTS+WORDS+REFS*REFLENGTH+BUFS*BUFLENGTH;
PRG:= PROCESS_SIZE-DRIVERHEADER;
REF:= ASS_SIZE+CONSTS+WORDS-DRIVERHEADER;
BUF:= REF+REFS*REFLENGTH;
PGHEAD(.11.):= ASS_SIZE;
END "CALCULATE_DISPS";
"----------------------------------------------------------------------"
PROCEDURE GENERATE_HEADER;
"----------------------------------------------------------------------"
BEGIN
OUTNL(OBJECT_STREAM);
OUTSTRING(OBJECT_STREAM, 'Z(:0:)');
OUTHEX(OBJECT_STREAM,'0',ABS_ADDRESS);
OUTSTRING(OBJECT_STREAM,' T0000(:0:)');
OUTNL(OBJECT_STREAM);
OUTSTRING(OBJECT_STREAM,'P(:0:)');
OUTNL(OBJECT_STREAM);
END "GENERATE_HEADER";
"----------------------------------------------------------------------"
PROCEDURE WRITE_DRIVERPROCESS;
" GENERATES DRIVER PROCESS PART, I.E. FROM DRIVER HEADER UNTIL PG HEADR"
"----------------------------------------------------------------------"
VAR I: INTEGER;
BEGIN
SKIP(PG_SIZE-(PG_HEADERLENGTH+1));
TRANSFER(SIZE_DISP);
SKIP(1); OUTWORD(PROCESS_SIZE);
TRANSFER(NAME_DISP-SIZE_DISP-1);
PACK(PROCESSNAME,PROCESSNAME,6);
SKIP(3);
OUTWORD(PROCESSNAME(.1.));
OUTWORD(PROCESSNAME(.2.));
OUTWORD(PROCESSNAME(.3.));
TRANSFER(PRG_DISP-NAME_DISP-3);
SKIP(1); OUTWORD(PRG);
IF FORTOLKER THEN TRANSFER(1)
ELSE BEGIN SKIP(1); OUTWORD(256) END;
TRANSFER(REF_DISP-PRG_DISP-2);
SKIP(2);
OUTWORD(REF); OUTWORD(BUF);
TRANSFER(CURIN_DISP-REF_DISP-2);
SKIP(1); OUTWORD(0);
TRANSFER(ASS_SIZE-CURIN_DISP-1);
SKIP(SHARE_SIZE); TRANSFER(CONSTS);
FOR I:=1 TO WORDS DO OUTWORD(0);;
MAKE_REFS(REF,REFS);
MAKE_BUFS(BUF,BUFS);
END "WRITE_DRIVERPROCESS";
"----------------------------------------------------------------------"
PROCEDURE WRITE_DRIVERPROGRAM;
"----------------------------------------------------------------------"
VAR I: INTEGER;
BEGIN
FOR I:= 0 TO PG_HEADERLENGTH DO OUTWORD(PGHEAD(.I.));
RESET(SOURCE_STREAM,SOURCE_NAME,INPUT);
SKIP(PG_HEADERLENGTH+1);
TRANSFER(PG_SIZE-(PG_HEADERLENGTH+1));
END "WRITE_DRIVERPROGRAM";
"----------------------------------------------------------------------"
PROCEDURE GENERATE_TAIL;
"----------------------------------------------------------------------"
BEGIN
OUTNL(OBJECT_STREAM);
OUTSTRING(OBJECT_STREAM,'S(:0:)');
OUTNL(OBJECT_STREAM);
END "GENERATE_TAIL" ;
"----------------------------------------------------------------------"
" MAIN PROGRAM"
"----------------------------------------------------------------------"
BEGIN
OPEN(CONSOLE,'OC(:0:)',OUTPUT);
READ_PARAMETERS;
OPEN(SOURCE_STREAM,SOURCE_NAME,INPUT);
OPEN(OBJECT_STREAM,OBJECT_NAME,OUTPUT);
PRESET_INPUT(SOURCE_STREAM);
CALCULATE_DISPS;
GENERATE_HEADER;
WRITE_DRIVERPROCESS;
WRITE_DRIVERPROGRAM;
GENERATE_TAIL;
CLOSE(CONSOLE);
CLOSE(SOURCE_STREAM);
CLOSE(OBJECT_STREAM);
END.
«eof»