|
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 - metrics - download
Length: 33152 (0x8180)
Types: TextFile
Names: »PS1«
└─⟦9975dd352⟧ Bits:30005088 8" CR80 Floppy CR80FD_0043 ( CR/D/1032 PROMGEN (HBA) 790917 HBA PROMGEN BACKUP )
└─⟦69b0db55a⟧
└─⟦this⟧ »HBA.PS1«
%SUMMARY
%LIST
%WORKAREA=25000
"PAGE" \f
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" "
" MODULE NUMBER CSS/103/L-D/0100 NAME PROMGEN PROGRAM LISTING "
" "
" GENERAL PURPOSE PROM GENERATING PROGRAM "
" "
" ROVSING FH/790822 RELEASE 01 VERSION 001 "
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" "
" FUNCTION "
" "
" THE PROMGEN PROGRAM GENERATES PROMDESCRIPTIONS FROM A GIVEN "
" HEXADECIMAL INPUT DISC FILE. "
" THE PROMDESCRIPTIONS DEFINES THE CONTENT OF A NUMBER OF "
" PROMS EACH CONTAINED IN ITS OWN DISCFILE. "
" THESE DISCFILES HAVE TO BE CREATED PRIOR TO PROMGEN EXECUTION "
" THE PROMDESCRIPTION IS AFTER A COPY TO A MAGNETIC TAPE , "
" DIRECT USABLE AS INPUT TO A 'DATA I/O' PROM PROGRAMMER. "
" PROMGEN TAKES FIXED INPUT PARAMETERS FROM A DISCFILE( "
" SPECIFIED IN THE PROMGEN CALL) AND DYNAMIC PARAMETERS FROM "
" THE OPERATORS CONSOLE. "
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
"PAGE" \f
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" "
" INTERFACE "
" INVOCATION "
" PROGRAM CALL: PROMGEN S:<PDATA> P:<PARAM> "
" PROMGEN: THE ASSEMBLED PROGRAM. "
" PDATA : THE HEXADECIMAL INPUTFILE TO BE PROMMED. "
" PARAM : FIXED INPUT PARAMETER FILE. "
" "
" THE PROGRAM REQUIRES INPUT PARAMETERS FROM OC: "
" "
" ORIGINATED BY: <IDENTIFIER> "
" PROJECT NO: <LONG INTEGER> "
" DATE: <LONG INTEGER> "
" FLOPPY DISC NO,CR/D/: <INTEGER> "
" SOURCETEXT AND VERSION: <TEXT> "
" AREASIZE: <INTEGER> "
" AREASTART ADDRESS: <INTEGER> "
" WHERE THE TEXT BEFORE : IS SUPPLIED BY THE PROGRAM. "
" THE < > IS SUPPLIED AS AN ANSWER BY THE OPERATOR. "
" "
" FORMAT OF THE PARAM DISCFILE: "
" "
" # MODULE <TEXT> "
" # WORDSIZE <INTEGER> "
" # PROMSIZE <INTEGER> "
" # PROMWIDTH <INTEGER> "
" # PARITYPROMS <INTEGER> "
" [ # <SEQNO> <PROMFILE> <PROMID> <VERSION> <PARITYBIT> ]X "
" [ # <SEQNO> <PARITYFILE> <PROMID> <VERSION> ]Y "
" WHERE X= NUMBER OF PROMS(PARITY PROMS EXCLUDED). "
" Y= NUMBER OF PARITY PROMS. "
" X AND Y ARE REPETITIONS FACTORS. "
" "
" OUTPUT "
" "
" FOR EACH GENERATED PROM , THE PROGRAM WRITES ON THE "
" OPERATORS CONSOLE: "
" "
" PROMID: <INTEGER> VERSION: <INTEGER> "
" CHECKSUM: <HEXADECIMAL NUMBER> "
" "
" EXIT "
" THE PROGRAM RELINQUISHES CONTROL, WHEN ALL THE SPECIFIED "
" PROMS ARE CREATED OR IF A PARAMETER ERROR IS FOUND. "
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" "
" EXCEPTIONS "
" "
" IF A PARAMETER IS ILLEGAL, THE PROGRAM STOPS AND "
" ISSUES AN APPROPRIATE ERRORMESSAGE. "
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
"PAGE" \f
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" "
" PROGRAM GENERATION "
" THE SOURCE PROGRAM CONSISTS OF THE FOLLOWING FILES: "
" "
" PMODULE : MODULE HEADER "
" PREFIX : PREFIX ROUTINES "
" IODEC : IO DECLARATIONS AND CONSTANTS "
" PDEC : PROMGEN DECLARATIONS AND CONSTANTS "
" IO : IO PROCEDURES "
" PPROC : PROMGEN PROCEDURES "
" PPROG : PROMGEN MAIN PROGRAM "
" "
" THESE SOURCE PROGRAMS ARE MERGED: "
" MERGE S: PMERGE1 O:PS1 "
" "
" HEREAFTER THE COMPILER IS CALLED: "
" COMPILE S:PS1 O:GENOBJ P:PLIST1 "
" "
" THE BLOCKSIZE IS CHANGED: "
" CONV41 S:GENOBJ O:PROMGEN.BIN "
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" "
" PROGRAM STORAGE "
" "
" CR/D/1327 "
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" "
" REFERENCE DOCUMENTS "
" VERSION DESCRIPTION DOCUMENT: CSS/103/VDD/0018 "
" USERS MANUAL: CSS/103/USM/0025 "
" LISTING : CSS/103/LST/0001 "
" "
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
"PAGE" \f
%NOLIST
"##################################################"
"CR80 SEQUENTIAL PASCAL STANDARD PREFIX. PHO-790330"
"##################################################"
CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)';
CONST NULL = '(:0:)'; SP = ' ';
CONST PAGELENGTH = 256;
TYPE PAGE = ARRAY [1..PAGELENGTH] OF INTEGER;
CONST LINELENGTH = 132;
TYPE LINE = ARRAY [1..LINELENGTH] OF CHAR;
CONST IDLENGTH = 12;
TYPE IDENTIFIER = ARRAY [1..IDLENGTH] OF CHAR;
TYPE FILE = 1..2;
TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE);
TYPE POINTER = @BOOLEAN;
TYPE ARGTYPE = RECORD
CASE TAG: ARGTAG OF
NILTYPE, BOOLTYPE: (BOOL: BOOLEAN);
INTTYPE: (INT: INTEGER);
IDTYPE: (ID: IDENTIFIER);
PTRTYPE: (PTR: POINTER)
END;
CONST MAXARG = 10;
TYPE ARGLIST = ARRAY [1..MAXARG] OF ARGTYPE;
CONST S = 2; P = 3; O = 4; N = 5; D = 6; L = 7;
TYPE ARGSEQ = (INP, OUT);
TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR,
RANGEERROR, VARIANTERROR, HEAPLIMIT,
STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR);
TYPE BITPOSITION = 0..15;
TYPE BITFIELDLENGTH = 0..16;
TYPE BITVALUE = (LOW, HIGH);
TYPE MESSAGE_BUFFER = ARRAY (.1..5.) OF INTEGER;
TYPE EVENT_TYPE = (TIME_OUT, ANSWER, MESSAGE, INTERRUPT);
TYPE WORD_ADDRESS = RECORD
MEMORY_SECTION: INTEGER;
WORD_DISPLACEMENT:INTEGER
END;
TYPE BYTE_ADDRESS = RECORD
BYTE_DISPLACEMENT: INTEGER;
WORD_ADDR: WORD_ADDRESS
END;
TYPE PROCESS_NAME = RECORD
NAME: ARRAY [0..2] OF CHAR;
NAME_IDENT:INTEGER;
PROC_IDENT:INTEGER
END;
PROCEDURE READ(VAR C: CHAR);
PROCEDURE WRITE(C: CHAR);
PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN);
PROCEDURE CLOSE(F: FILE);
PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
PROCEDURE PUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE);
PROCEDURE WRITEARG(S: ARGSEQ; ARG: ARGTYPE);
PROCEDURE ACCEPT(VAR C:CHAR);
PROCEDURE DISPLAY(C: CHAR);
PROCEDURE MARK(VAR TOP: INTEGER);
PROCEDURE RELEASE(TOP: INTEGER);
PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST;
VAR LINE: INTEGER; VAR RESULT: PROGRESULT);
PROCEDURE EXIT;
PROCEDURE HALT;
PROCEDURE SET_TRACE(MASK: INTEGER; DEVICE:IDENTIFIER);
PROCEDURE PRINT_TRACE(ON: BOOLEAN);
FUNCTION IAND(MASK1, MASK2: UNIV INTEGER): INTEGER;
FUNCTION IOR(MASK1, MASK2: UNIV INTEGER): INTEGER;
FUNCTION XOR(MASK1, MASK2: UNIV INTEGER): INTEGER;
FUNCTION INV(MASK: UNIV INTEGER): INTEGER;
FUNCTION LEFTSHIFT(BITS: UNIV INTEGER; SHIFTS: INTEGER): INTEGER;
FUNCTION RIGHTSHIFT(BITS: UNIV INTEGER; SHIFTS: INTEGER): INTEGER;
FUNCTION GETBITS(BITS: UNIV INTEGER; LEFTMOST: BITPOSITION;
FIELDLENGTH: BITFIELDLENGTH): INTEGER;
PROCEDURE PUTBITS(FROM: UNIV INTEGER; VAR TO_: UNIV INTEGER;
LEFTTO: BITPOSITION; FIELDLENGTH: BITFIELDLENGTH);
FUNCTION TESTBIT(BITS: UNIV INTEGER; BITNUMBER: BITPOSITION): BOOLEAN;
PROCEDURE SETBIT(VAR BITS: UNIV INTEGER; BITNUMBER: BITPOSITION);
PROCEDURE CLEARBIT(VAR BITS: UNIV INTEGER; BITNUMBER: BITPOSITION);
PROCEDURE PACK(UNPACKED, PACKED: IDENTIFIER; NO_OF_BYTES: INTEGER);
PROCEDURE UNPACK(PACKED, UNPACKED: IDENTIFIER; NO_OF_BYTES: INTEGER);
PROCEDURE PACK_SWAPPED(UNPACKED, PACKED: IDENTIFIER; NO_OF_BYTES: INTEGER);
PROCEDURE UNPACK_SWAPPED(PACKED, UNPACKED: IDENTIFIER; NO_OF_BYTES: INTEGER);
PROCEDURE RESERVE_INTERRUPT(DEVPR: INTEGER; VAR INTRPT: INTEGER);
PROCEDURE RELEASE_INTERRUPT(INTRPT: INTEGER);
PROCEDURE CLEAR_INTERRUPT(INTRPT: INTEGER; VAR COUNT: INTEGER);
PROCEDURE WAIT_INTERRUPT(DELAY: INTEGER; INTRPT: INTEGER;
VAR TIMED_OUT: BOOLEAN; VAR COUNT: INTEGER);
PROCEDURE SENSE_IO(DEVICE: INTEGER; VAR STATUS: INTEGER);
PROCEDURE READ_IO(DEVICE: INTEGER; VAR DATA: INTEGER);
PROCEDURE CONTROL_IO(DEVICE: INTEGER; STATUS: INTEGER);
PROCEDURE WRITE_IO(DEVICE: INTEGER; DATA: INTEGER);
PROCEDURE SEND_MESSAGE(RECEIVER: PROCESS_NAME; MSG:UNIV MESSAGE_BUFFER;
VAR EVENT: INTEGER);
PROCEDURE SEND_ANSWER(ANS: UNIV MESSAGE_BUFFER; EVENT: INTEGER);
PROCEDURE WAIT_ANSWER(DELAY: INTEGER; EVENT: INTEGER;
VAR ANS: UNIV MESSAGE_BUFFER; VAR TIMED_OUT: BOOLEAN);
PROCEDURE WAIT_MESSAGE(DELAY: INTEGER; VAR MSG: UNIV MESSAGE_BUFFER;
VAR EVENT: INTEGER; VAR TIMED_OUT: BOOLEAN);
PROCEDURE WAIT_EVENT(DELAY: INTEGER; INTRPT: INTEGER;
VAR MSG: UNIV MESSAGE_BUFFER;
VAR EVENT: INTEGER; VAR EVTTYPE: EVENT_TYPE;
VAR COUNT: INTEGER; VAR TIMED_OUT: BOOLEAN);
PROCEDURE RESUME_EVENT;
PROCEDURE COPY(SOURCE, DEST: BYTE_ADDRESS; NO_OF_BYTES: INTEGER);
PROCEDURE GET_ABS_ADDR(STRUCTURE: LINE; VAR WORD_ADDR: WORD_ADDRESS);
PROCEDURE GET_ABS_ADDR1(STRUCTURE: LINE; VAR WORD_ADDR: WORD_ADDRESS);
PROCEDURE GET_ABS_ADDR2(STRUCTURE: LINE; VAR WORD_ADDR: WORD_ADDRESS);
FUNCTION CURRENT_LINE: INTEGER;
PROCEDURE CURRENT_LEVEL(VAR LEVEL: INTEGER);
PROCEDURE LONG_EXIT(LEVEL: INTEGER);
PROCEDURE ASSIGNBITS(VALUE: UNIV BITVALUE; VAR P: UNIV PAGE;
FIRSTBIT, NO_OF_BITS: INTEGER);
PROCEDURE SKIPBITS(VALUE: UNIV BITVALUE; P: UNIV PAGE;
VAR FIRSTBIT: INTEGER; NO_OF_BITS: INTEGER;
VAR BITSSKIPPED: INTEGER);
PROGRAM MAIN(VAR PARAM: ARGLIST);
%LIST
"PAGE"\f
"****************************
* PASCAL I/O DECLARATIONS *
****************************"
CONST TEXT_SIZE=132;
TYPE TEXT=ARRAY[1..TEXT_SIZE] OF CHAR;
TYPE STREAM=(INOC,OUTOC,INFILE,OUTFILE);
TYPE DIRECTION=(INPUT,OUTPUT);
TYPE BYTE=0..255;
"**********************************************************************"
" CONSTANTS "
"**********************************************************************"
CONST MAX_PARITY_PROMS = 4 ; "20"
MAX_PROMS = 64 ; "30"
STX = '(:2:)' ; "40"
ETX = '(:3:)' ; "50"
MIN_AREASIZE = 8 ; "60"
MIN_PROMSIZE = 8 ; "80"
MAX_AREASIZE = 16384 ; "70"
MAX_PROMSIZE = 16384 ; "90"
MIN_PROMWIDTH = 4 ; "100"
MAX_PROMWIDTH = 16 ; "110"
MIN_WORDSIZE = 4 ; "120"
MAX_WORDSIZE = 16 ; "130"
"**********************************************************************"
" MAIN VARIABLES "
"**********************************************************************"
TYPE PROMTYPE = RECORD "10"
FILE : IDENTIFIER ; "20"
IDNO : INTEGER ; "30"
VERSION : INTEGER ; "40"
PARITY_BIT : INTEGER ; "50"
CHECKSUM : LONG_INTEGER "60"
END; "70"
TYPE LONG1 = RECORD
LSB : INTEGER ;
MSB : INTEGER
END;
TYPE ID_RECORD_TYPE = RECORD "100"
ORIGINATOR : IDENTIFIER ; "110"
PROJECT_NO : LONG_INTEGER ; "120"
DATE : LONG_INTEGER ; "130"
MODULE : TEXT ; "140"
FLOPPY_DISC_NO : INTEGER ; "150"
SOURCE_TEXT : TEXT "160"
END; "170"
TYPE PROM_AREA_TYPE = RECORD "190"
SIZE : LONG_INTEGER ; "200"
START_ADDRESS : LONG_INTEGER ; "210"
WIDTH : INTEGER ; "220"
PARITY_BITS_IN_USE : INTEGER "230"
END; "240"
TYPE PHYS_PROM_TYPE = RECORD "260"
SIZE : LONG_INTEGER ; "270"
WIDTH : INTEGER "280"
END; "290"
VAR PROM : ARRAY [1..MAX_PROMS] OF PROMTYPE ; "292"
ID_RECORD : ID_RECORD_TYPE ; "296"
PROM_AREA : PROM_AREA_TYPE ; "298"
PHYS_PROM : PHYS_PROM_TYPE ; "300"
PARITY_AREA : ARRAY [0..MAX_PROMSIZE] OF INTEGER ; "310"
S_IN , S_OUT : STREAM ; "320"
PROM_INPUT_FILE : IDENTIFIER ; "330"
PARAM_INPUT_FILE : IDENTIFIER ; "340"
PROMS_PR_ROW , "350"
PROMS_PR_COLOUMN , "360"
NO_OF_PROMS , "370"
PARITY_BITS_IN_USE , "315"
NO_OF_PARITY_PROMS , "375"
HEXA_PR_ROW , "380"
HEXA_PR_PROM_ROW , "390"
HEXA_PR_SINGLE_PROM , "400"
HEXA_NO , "410"
ROW_NO , "420"
COLOUMN_NO , "430"
I , J : INTEGER ; "440"
"PAGE" \f
%NOLIST
"PAGE"\f
"***********************
* PASCAL I/O PACKAGE *
***********************"
PROCEDURE XXXERROR(T: TEXT);
VAR I:INTEGER;
BEGIN
DISPLAY(NL);
DISPLAY('?');
DISPLAY('?');
I:=1;
WHILE T[I]<>NULL DO
BEGIN
DISPLAY(T[I]);
I:=SUCC(I);
END;
DISPLAY(NL);
HALT;
END "XXXERROR";
"OPEN AND CLOSE STREAMS"
"----------------------"
PROCEDURE OPEN(VAR S:STREAM; NAME:TEXT; DIR:DIRECTION);
CONST OC='OC ';
VAR ID:IDENTIFIER; CTRL:INTEGER; ARG:ARGTYPE;
BEGIN
IF NOT (DIR IN [INPUT,OUTPUT]) THEN
XXXERROR('ILLEGAL DIRECTION(:0:)');
FOR CTRL:=1 TO IDLENGTH DO
ID[CTRL]:=' ';
CTRL:=1;
WHILE (NAME[CTRL]<>'(:0:)') AND
(CTRL<SUCC(IDLENGTH)) DO
BEGIN
ID[CTRL]:=NAME[CTRL];
CTRL:=SUCC(CTRL);
END;
IF ID=OC THEN
IF DIR=INPUT
THEN S:=INOC
ELSE S:=OUTOC
ELSE
BEGIN
ARG.TAG:=IDTYPE;
ARG.ID:=ID;
IF DIR=INPUT THEN
BEGIN
S:=INFILE;
WRITEARG(INP,ARG);
END
ELSE
BEGIN
S:=OUTFILE;
WRITEARG(OUT,ARG);
END;
END;
END "OPEN";
PROCEDURE CLOSE(S:STREAM);
VAR ARG:ARGTYPE;
BEGIN
CASE S OF
INOC,OUTOC:
;
INFILE:
READARG(INP,ARG);
OUTFILE:
READARG(OUT,ARG)
END "CASE";
END "CLOSE";
"I/O OF BYTES (CHARACTERS)"
"-------------------------"
PROCEDURE OUTBYTE(S:STREAM; B:UNIV CHAR);
BEGIN
CASE S OF
OUTOC:
DISPLAY(B);
OUTFILE:
WRITE(B);
INOC,INFILE:
XXXERROR('OUTPUT TO AN INPUT STREAM(:0:)')
END "CASE";
END "OUTBYTE";
PROCEDURE INBYTE(S:STREAM; VAR B:UNIV CHAR);
BEGIN
CASE S OF
INOC:
ACCEPT(B);
INFILE:
READ(B);
OUTOC,OUTFILE:
XXXERROR('INPUT FROM AN OUTPUT STREAM(:0:)')
END "CASE";
END "INBYTE";
PROCEDURE OUTNL(S:STREAM);
BEGIN
OUTBYTE(S,NL);
END "OUTNL";
PROCEDURE BACKSPACE(S:STREAM);
BEGIN
" UNIMPLEMENTED "
END "BACKSPACE";
"I/O OF TEXT STRINGS"
"-------------------"
PROCEDURE INLINE(S:STREAM; VAR T:TEXT);
VAR CH:CHAR; I:INTEGER;
BEGIN
I:=1;
REPEAT
INBYTE(S,CH);
T[I]:=CH;
I:=SUCC(I);
UNTIL (CH=NL) OR (CH=EM) OR (I>=TEXT_SIZE);
T[I]:=NULL;
END "INLINE";
PROCEDURE OUTBYTES(S:STREAM; B:UNIV CHAR; COUNT:INTEGER);
VAR CTRL:INTEGER;
BEGIN
FOR CTRL:=1 TO COUNT DO
OUTBYTE(S,B);
END "OUTBYTES";
PROCEDURE OUTSTRING(S:STREAM; T:TEXT);
VAR DONE:BOOLEAN; I:INTEGER;
BEGIN
I:=1; DONE:=FALSE;
WHILE NOT DONE DO
IF T[I]<>NULL THEN
IF I<=TEXT_SIZE THEN
BEGIN
OUTBYTE(S,T[I]);
I:=SUCC(I);
END
ELSE DONE:=TRUE
ELSE DONE:=TRUE;
END "OUTSTRING";
PROCEDURE OUTTEXT(S:STREAM; T:TEXT; SIZE:INTEGER);
VAR CTRL:INTEGER;
BEGIN
IF SIZE>TEXT_SIZE THEN
XXXERROR('TEXT TOO LARGE(:0:)');
FOR CTRL:=1 TO SIZE DO
OUTBYTE(S,T[CTRL]);
END "OUTTEXT";
"I/O OF INTEGERS"
"---------------"
FUNCTION BIN_TO_ASCII(INT:INTEGER):CHAR;
BEGIN
IF INT<10
THEN BIN_TO_ASCII:=CHR(INT+ORD('0'))
ELSE BIN_TO_ASCII:=CHR(INT-10+ORD('A'));
END "BIN_TO_ASCII";
PROCEDURE OUTHEXA(S:STREAM; INT:UNIV INTEGER; WIDTH:INTEGER);
VAR T:TEXT; CTRL:INTEGER; TEMP:INTEGER;
BEGIN
FOR CTRL:=1 TO TEXT_SIZE DO
T[CTRL]:=SP;
TEMP:=INT;
FOR CTRL:=1 TO 4 DO
BEGIN
T[CTRL]:=BIN_TO_ASCII(GETBITS(TEMP,3,4));
TEMP:=RIGHTSHIFT(TEMP,4);
END;
T[5]:='#';
IF WIDTH<5 THEN
FOR CTRL:=1 TO WIDTH DO
T[CTRL]:='*';
FOR CTRL:=WIDTH DOWNTO 1 DO
OUTBYTE(S,T[CTRL]);
END "OUTHEXA";
PROCEDURE OUTINTEGER(S:STREAM; INT:UNIV INTEGER; WIDTH:INTEGER);
VAR T:TEXT; CTRL:INTEGER;
NEGATIVE:BOOLEAN; TEMP:INTEGER;
BEGIN
FOR CTRL:=1 TO TEXT_SIZE DO
T[CTRL]:=SP;
IF INT=#8000 THEN
BEGIN
"HANDLE SPECIAL CASE"
END
ELSE
BEGIN
TEMP:=INT;
NEGATIVE:=TEMP<0;
IF NEGATIVE THEN TEMP:=-TEMP;
CTRL:=1;
REPEAT
T[CTRL]:=BIN_TO_ASCII(TEMP MOD 10);
TEMP:=TEMP DIV 10;
CTRL:=SUCC(CTRL);
UNTIL TEMP=0;
IF NEGATIVE
THEN T[CTRL]:='-'
ELSE CTRL:=PRED(CTRL);
END;
IF WIDTH<CTRL THEN
FOR CTRL:=1 TO WIDTH DO
T[CTRL]:='*';
FOR CTRL:= WIDTH DOWNTO 1 DO
OUTBYTE(S,T[CTRL]);
END "OUTINTEGER";
FUNCTION XXXDIGIT(CH:CHAR):BOOLEAN;
BEGIN
XXXDIGIT:=('0'<=CH) AND (CH<='9');
END "XXXDIGIT";
FUNCTION XXXHEXADIGIT(CH:CHAR):BOOLEAN;
BEGIN
XXXHEXADIGIT:=XXXDIGIT(CH) OR
(('A'<=CH) AND (CH<='F'));
END "HEXADIGIT";
FUNCTION ASCII_TO_BIN(CH:CHAR):INTEGER;
BEGIN
IF XXXDIGIT(CH) THEN
ASCII_TO_BIN:=ORD(CH)-ORD('0')
ELSE IF XXXHEXADIGIT(CH)
THEN ASCII_TO_BIN:= ORD(CH)-ORD('A')+10
ELSE XXXERROR('ILLEGAL CHARACTER CONVERSION(:0:)');
END "ASCII_TO_BIN";
PROCEDURE INHEXA(S:STREAM; VAR INT:INTEGER);
VAR CH:CHAR;
BEGIN
"SKIP INITIAL GARBAGE"
REPEAT
INBYTE(S,CH);
IF CH=EM THEN XXXERROR('INPUT STREAM TERMINATED(:0:)');
UNTIL XXXHEXADIGIT(CH);
"ASSEMBLE VALUE"
INT:=0;
WHILE XXXHEXADIGIT(CH) DO
BEGIN
INT:=LEFTSHIFT(INT,4);
PUTBITS(ASCII_TO_BIN(CH),INT,3,4);
INBYTE(S,CH);
END;
END "INHEXA";
PROCEDURE ININTEGER(S:STREAM; VAR INT:INTEGER);
VAR CH:CHAR; POSITIVE:BOOLEAN;
BEGIN
"SKIP INITIAL GARBAGE"
REPEAT
INBYTE(S,CH);
IF CH=EM THEN XXXERROR('INPUT STREAM TERMINATED(:0:)');
UNTIL (CH='#') OR (CH='-') OR XXXDIGIT(CH);
"GO HANDLE HEXADECIMAL CASE"
IF CH='#' THEN
BEGIN
INHEXA(S,INT);
EXIT;
END;
"CHECK FOR SIGN"
POSITIVE:=TRUE;
IF CH='-' THEN
BEGIN
POSITIVE:=FALSE;
INBYTE(S,CH);
END;
"ASSEMBLE VALUE"
INT:=0;
WHILE XXXDIGIT(CH) DO
BEGIN
INT:=INT*10-ASCII_TO_BIN(CH);
INBYTE(S,CH);
END;
"REVERSE SIGN IF POSITIVE"
IF POSITIVE THEN INT:=-INT;
END "ININTEGER";
PROCEDURE IN_LONG_INTEGER(S: STREAM; VAR LINT: LONG_INTEGER);
VAR
CH: CHAR;
POSITIVE: BOOLEAN;
BEGIN
"SKIP INITTIAL GARBAGE"
REPEAT
INBYTE(S,CH);
IF CH=EM THEN XXXERROR('INPUT STREAM TERMINATED(:0:)');
UNTIL (CH='#') OR (CH='-') OR XXXDIGIT(CH);
"HANDLE HEXADECIMAL CASE"
IF CH='#' THEN
BEGIN
EXIT;
END;
"HANDLE SIGN"
POSITIVE:= TRUE;
IF CH='-' THEN
BEGIN
POSITIVE:= FALSE;
INBYTE(S,CH);
END;
"ASSEMBLE VALUE, NEGATIVE"
LINT:= 0L;
WHILE XXXDIGIT(CH) DO
BEGIN
LINT:= LINT*10L-LONG(ASCII_TO_BIN(CH));
INBYTE(S,CH);
END;
"REVERSE SIGN IF POSITIVE"
IF POSITIVE THEN
LINT:= -LINT;
END "IN_LONG_INTEGER";
PROCEDURE OUT_LONG_INTEGER(S: STREAM; LINT: LONG_INTEGER; WIDTH: INTEGER);
VAR
T: TEXT;
I: INTEGER;
NEGATIVE: BOOLEAN;
TEMP: LONG_INTEGER;
BEGIN
FOR I:= 1 TO TEXT_SIZE DO
T[I]:= SP;
IF LINT=#80000000L THEN
BEGIN
"HANDLE SPECIAL CASE"
END
ELSE
BEGIN
TEMP:= LINT;
NEGATIVE:= TEMP<0L;
IF NEGATIVE THEN
TEMP:= -TEMP;
I:= 1;
REPEAT
T[I]:= BIN_TO_ASCII(SHORT(TEMP-(TEMP/10L)*10L));
TEMP:= TEMP/10L;
I:= SUCC(I);
UNTIL TEMP= 0L;
IF NEGATIVE THEN
T[I]:= '-'
ELSE
I:= PRED(I);
END;
IF WIDTH<I THEN
FOR I:= 1 TO WIDTH DO
T[I]:= '*';
FOR I:= WIDTH DOWNTO 1 DO
OUTBYTE(S,T[I]);
END "OUT_LONG_INTEGER";
%LIST
"PAGE" \f
"**********************************************************************"
" MAIN PROCEDURES "
"**********************************************************************"
PROCEDURE DEFINE_CONSTANTS ; "10"
VAR L : LONG_INTEGER ; "15"
I : INTEGER ; "16"
BEGIN "20"
PROMS_PR_ROW := PROM_AREA.WIDTH DIV PHYS_PROM.WIDTH ; "30"
PROMS_PR_COLOUMN := SHORT(( PROM_AREA.SIZE / "40"
PHYS_PROM.SIZE ) ); "45"
NO_OF_PROMS := PROMS_PR_ROW * PROMS_PR_COLOUMN ; "50"
HEXA_PR_ROW := PROM_AREA.WIDTH DIV 4 ; "60"
HEXA_PR_SINGLE_PROM := PHYS_PROM.WIDTH DIV 4 ; "70"
L := LONG(HEXA_PR_ROW) * PHYS_PROM.SIZE ; "75"
HEXA_PR_PROM_ROW := SHORT( L ); "80"
FOR I := 0 TO SHORT( PHYS_PROM.SIZE ) - 1 DO "82"
PARITY_AREA[ I ] := -1 ; "84"
PARITY_BITS_IN_USE := 0 ; "86"
FOR I:= 1 TO (NO_OF_PROMS + NO_OF_PARITY_PROMS ) DO "100"
PROM[ I ].CHECKSUM := 0L ; "110"
END ; "90"
"**********************************************************************"
"PAGE" \f
PROCEDURE READ_FROM_PARITY_AREA( LEFT_BIT , "10"
ROW : INTEGER ; "20"
VAR HEXA : CHAR ) ; "40"
VAR BIN : INTEGER ; "50"
BEGIN "60"
BIN := GETBITS( PARITY_AREA[ ROW ] , "70"
LEFT_BIT , "80"
4 ) ; "90"
HEXA := BIN_TO_ASCII( BIN ) ; "100"
END "READ FROM PARITY AREA" ; "110"
PROCEDURE READ_HEXA( S : STREAM ; "10"
VAR HEXA : CHAR ; "20"
VAR NO : INTEGER ) ; "30"
VAR CH : CHAR ; "40"
BEGIN "50"
IF NO MOD 32 = 0 "60"
THEN "70"
BEGIN "80"
REPEAT "90"
INBYTE( S , CH ); "100"
UNTIL "110"
CH = 'L' ; "120"
END; "130"
REPEAT "140"
INBYTE( S , CH ) "150"
UNTIL "160"
XXXHEXADIGIT( CH ); "170"
HEXA := CH ; "180"
NO := NO + 1 ; "190"
END "READ HEXA"; "200"
PROCEDURE IN_IDENT( S: STREAM ; "10"
VAR IDF: IDENTIFIER ); "20"
VAR CH: CHAR; "30"
I : INTEGER; "40"
BEGIN "50"
FOR I:= 1 TO IDLENGTH DO "60"
IDF[I] := NULL; "70"
REPEAT "80"
INBYTE( S , CH ); "90"
UNTIL "100"
NOT ( (CH=NL) OR (CH=SP) OR (CH=EM)) ; "110"
IDF[1] := CH ; "120"
I:=1; "130"
REPEAT "140"
INBYTE( S , CH ); "150"
I:= I + 1 ; "160"
IDF[ I ] := CH ; "170"
UNTIL "180"
(CH=NL) OR (CH=SP) OR (CH=EM) OR (I>=IDLENGTH) ; "190"
IDF[ I ] := NULL ; "195"
END "IN_IDENT" ; "200"
"PAGE" \f
PROCEDURE GET_OC_PARAMS( OC_IN , OC_OUT : STREAM ); "10"
BEGIN "20"
OUTNL( OC_OUT ); "30"
OUTSTRING( OC_OUT, 'ORIGINATED BY: (:0:)'); "40"
OUTNL( OC_OUT ); "50"
IN_IDENT( OC_IN , ID_RECORD.ORIGINATOR ); "60"
OUTNL(OC_OUT); "70"
OUTSTRING( OC_OUT, 'PROJECT NO: (:0:)' ); "80"
OUTNL(OC_OUT); "90"
IN_LONG_INTEGER( OC_IN , ID_RECORD.PROJECT_NO); "100"
OUTNL(OC_OUT); "110"
OUTSTRING( OC_OUT , 'DATE: (:0:)' ); "120"
OUTNL(OC_OUT); "130"
IN_LONG_INTEGER( OC_IN , ID_RECORD.DATE ); "140"
OUTNL(OC_OUT); "150"
OUTSTRING(OC_OUT, 'FLOPPY DISC NO, CR/D: (:0:)' ); "160"
OUTNL(OC_OUT); "170"
ININTEGER( OC_IN , ID_RECORD.FLOPPY_DISC_NO ); "180"
OUTNL(OC_OUT); "190"
OUTSTRING( OC_OUT ,'SOURCE TEXT AND VERSION: (:0:)' ); "200"
OUTNL(OC_OUT); "210"
INLINE(OC_IN , ID_RECORD.SOURCE_TEXT ); "220"
OUTNL(OC_OUT); "230"
OUTSTRING( OC_OUT, 'AREASIZE: (:0:)' ); "240"
OUTNL(OC_OUT); "250"
IN_LONG_INTEGER( OC_IN , PROM_AREA.SIZE ); "260"
OUTNL(OC_OUT); "270"
OUTSTRING( OC_OUT, 'AREA STARTADDRESS: (:0:)' ); "280"
OUTNL(OC_OUT); "290"
IN_LONG_INTEGER( OC_IN, PROM_AREA.START_ADDRESS); "300"
END "GET_OC_PARAMS" ; "310"
"PAGE" \f
PROCEDURE GET_DISC_PARAMS( S: STREAM ); "10"
VAR I , SEQ_NO, PROM_NO, "20"
P_NO : INTEGER ; "25"
CH : CHAR ; "30"
TXT : TEXT ; "40"
IDF : IDENTIFIER ; "50"
BEGIN "60"
FOR I:= 1 TO 5 DO "70"
BEGIN "80"
REPEAT "90"
INBYTE( S , CH ); "100"
UNTIL "110"
CH= '#'; "120"
IN_IDENT( S , IDF ) ; "130"
CASE I OF "140"
1: BEGIN "150"
IF IDF <> 'MODULE(:0:)(:0:)(:0:)(:0:)(:0:)(:0:)' "160"
THEN XXXERROR('MODULE PARAM(:0:)') "170"
ELSE INLINE( S , ID_RECORD.MODULE ); "180"
END; "190"
2: BEGIN "200"
IF IDF <> 'WORDSIZE(:0:)(:0:)(:0:)(:0:)' "210"
THEN XXXERROR('WORDSIZE PARAM(:0:)') "220"
ELSE ININTEGER( S , PROM_AREA.WIDTH ); "230"
END; "240"
3: BEGIN "250"
IF IDF <> 'PROMSIZE(:0:)(:0:)(:0:)(:0:)' "260"
THEN XXXERROR('PROMSIZE PARAM(:0:)' ) "270"
ELSE IN_LONG_INTEGER( S , PHYS_PROM.SIZE ); "280"
END; "290"
4: BEGIN "300"
IF IDF <> 'PROMWIDTH(:0:)(:0:)(:0:)' "310"
THEN XXXERROR('PROMWIDTH PARAM(:0:)' ) "320"
ELSE ININTEGER( S , PHYS_PROM.WIDTH ); "330"
END ; "340"
5: BEGIN "341"
IF IDF <> 'PARITYPROMS(:0:)' "342"
THEN XXXERROR('PARITY PROM PARAM(:0:)' ) "343"
ELSE ININTEGER( S , NO_OF_PARITY_PROMS ) ; "344"
END "345"
END "CASE"; "350"
END "FOR I"; "360"
NO_OF_PROMS := ( PROM_AREA.WIDTH DIV PHYS_PROM.WIDTH) * "320"
SHORT( PROM_AREA.SIZE / PHYS_PROM.SIZE ); "380"
PROM_NO := 0; "390"
P_NO := 0 ; "395"
REPEAT "400"
PROM_NO := PROM_NO + 1 ; "410"
IF PROM_NO = NO_OF_PROMS + 1 "412"
THEN P_NO := 0; "414"
P_NO := P_NO + 1 ; "416"
REPEAT "420"
INBYTE( S , CH ); "430"
UNTIL "440"
CH='#'; "450"
ININTEGER( S , SEQ_NO ); "460"
IF SEQ_NO <> P_NO "470"
THEN XXXERROR('PARAM PROM SEQUENCE ERROR(:0:)' ); "475"
IN_IDENT( S , PROM[ PROM_NO ].FILE ); "480"
ININTEGER( S, PROM[ PROM_NO ].IDNO ); "490"
ININTEGER( S , PROM[ PROM_NO ].VERSION ); "500"
IF PROM_NO <= NO_OF_PROMS "504"
THEN ININTEGER( S , PROM[ PROM_NO ].PARITY_BIT ) ; "510"
UNTIL "520"
PROM_NO >= NO_OF_PROMS + NO_OF_PARITY_PROMS ; "530"
END "GET DISC PARAMS"; "540"
"PAGE" \f
PROCEDURE CHECK_PARAMS;
VAR TEST : INTEGER ;
BEGIN
TEST := SHORT( PROM_AREA.SIZE ) ; "40"
IF ( TEST < MIN_AREASIZE )
OR ( TEST > MAX_AREASIZE )
THEN XXXERROR('AREASIZE CONTENT(:0:)' );
TEST := SHORT( PHYS_PROM.SIZE ) ; "80"
IF ( TEST < MIN_PROMSIZE ) OR ( TEST > MAX_PROMSIZE )
OR ( TEST > SHORT( PROM_AREA.SIZE ) ) "100"
OR ( SHORT( PROM_AREA.SIZE) MOD TEST <> 0 ) "110"
THEN XXXERROR( 'PROMSIZE CONTENT(:0:)' );
TEST := SHORT( PROM_AREA.START_ADDRESS ) ; "130"
IF ( TEST < 0 ) OR ( TEST >= SHORT( PROM_AREA.SIZE ) ) "140"
THEN XXXERROR( ' START ADDRESS CONTENT(:0:)' );
TEST := PROM_AREA.WIDTH ;
IF ( TEST < MIN_WORDSIZE ) OR (TEST > MAX_WORDSIZE )
OR (TEST MOD 4 <>0 )
THEN XXXERROR( 'WORDSIZE CONTENT(:0:)' );
TEST := PHYS_PROM.WIDTH ;
IF ( TEST < MIN_PROMWIDTH ) OR (TEST > MAX_PROMWIDTH )
OR ( TEST MOD 4 <> 0 )
OR ( TEST > PROM_AREA.WIDTH ) "230"
THEN XXXERROR( 'PROMWIDTH CONTENT(:0:)' );
END " CHECK PARAMS";
"PAGE" \f
PROCEDURE PROM_WORD_TREATMENT( F_OUT , F_IN : STREAM ; "10"
ROW, "20"
PROM_NO : INTEGER ; "40"
VAR HEXA_NO : INTEGER ) ; "50"
CONST CR = '(:10:)' ;
VAR I, "60"
J , "62"
ADDR , "66"
LEFT_BIT , "68"
HEXAS_OUTPUT, "70"
BIN, "80"
WORD, "90"
P_BIT , "95"
ONES : INTEGER ; "100"
HEXA : CHAR ; "110"
BEGIN "120"
ADDR := SHORT( PROM_AREA.START_ADDRESS ) ; "130"
IF ( ROW= ADDR ) AND ( ADDR > 0 ) AND ( PROM_NO <= PROMS_PR_ROW ) "135"
THEN "140"
BEGIN "150"
I:= PHYS_PROM.WIDTH ;
IF I=4 THEN WORD := #F
ELSE IF I=8 THEN WORD:= #FF
ELSE WORD := #FFFF ;
FOR I :=0 TO (ADDR - 1 ) DO
PROM[PROM_NO].CHECKSUM := PROM[PROM_NO].CHECKSUM +
LONG( WORD ) ;
OUTBYTE(F_OUT , STX ) ; "151"
OUTBYTE( F_OUT , CR ) ; "152"
ADDR := ADDR*HEXA_PR_SINGLE_PROM ; "153"
FOR J := 1 TO ADDR DIV 32 DO "154"
BEGIN "155"
FOR I:= 1 TO 32 DO "156"
BEGIN "157"
OUTBYTE( F_OUT , 'F' ); "158"
IF ( I MOD HEXA_PR_SINGLE_PROM = 0 ) "158.5"
THEN OUTBYTE( F_OUT , SP ) ; "159"
END; "160"
OUTBYTE( F_OUT , CR ); "161"
OUTBYTES( F_OUT , NULL , 7 ); "162"
END; "163"
FOR J:= 1 TO ADDR MOD 32 DO "165"
BEGIN "166"
OUTBYTE( F_OUT , 'F' ) ; "167"
IF ( J MOD HEXA_PR_SINGLE_PROM = 0 ) "168"
THEN OUTBYTE( F_OUT , SP ) ; "169"
END; "170"
END; "195"
WORD := 0 ; "200"
FOR I:= 1 TO HEXA_PR_SINGLE_PROM DO "210"
BEGIN "220"
IF PROM_NO > NO_OF_PROMS "230"
THEN "231"
BEGIN "232"
LEFT_BIT := "233"
(PROM_NO-NO_OF_PROMS)*PHYS_PROM.WIDTH -4*(I-1) - 1 ; "234"
READ_FROM_PARITY_AREA( LEFT_BIT , ROW , HEXA ) ; "235"
END "237"
ELSE READ_HEXA( F_IN , HEXA , HEXA_NO ) ; "236"
IF (I=1) AND (ROW=0 ) THEN "240"
BEGIN "250"
OUTBYTE( F_OUT , STX ) ; "260"
OUTBYTE( F_OUT , CR ); "270"
END; "280"
OUTBYTE( F_OUT , HEXA ); "290"
HEXAS_OUTPUT := ROW*HEXA_PR_SINGLE_PROM + I ; "300"
IF ( LONG( ROW ) = PHYS_PROM.SIZE - 1L ) AND "310"
( I = HEXA_PR_SINGLE_PROM ) "320"
THEN "325"
BEGIN "330"
OUTBYTE( F_OUT , SP ) ; "335"
OUTBYTE(F_OUT , ETX ); "350"
OUTBYTES( F_OUT , NULL , 7 ) ; "354"
OUTNL( F_OUT ) ; "356"
END "360"
ELSE "370"
BEGIN "380"
IF ((HEXAS_OUTPUT MOD 32) = 0 ) "400"
THEN "410"
BEGIN "420"
OUTBYTE( F_OUT , SP ) ; "425"
OUTBYTE( F_OUT , CR ); "430"
OUTBYTES( F_OUT , NULL , 7 ); "440"
END "450"
ELSE "460"
BEGIN "470"
IF HEXAS_OUTPUT MOD HEXA_PR_SINGLE_PROM = 0 "480"
THEN OUTBYTE( F_OUT , SP ); "490"
END; "500"
END; "510"
BIN := ASCII_TO_BIN( HEXA ) ; "520"
WORD := LEFTSHIFT( WORD , 4 ) + BIN ; "530"
END "FOR I " ; "540"
PROM[ PROM_NO].CHECKSUM := "600"
PROM[PROM_NO].CHECKSUM + LONG( WORD ) ; "610"
IF PROM_NO <= NO_OF_PROMS "612"
THEN "613"
P_BIT := PROM[ PROM_NO ].PARITY_BIT ; "614"
IF (PROM_NO <= NO_OF_PROMS ) AND ( P_BIT >=0) AND ( P_BIT <= 15) "620"
THEN "630"
BEGIN "640"
ONES := 0; "650"
FOR I := 0 TO PHYS_PROM.WIDTH -1 DO "660"
IF TESTBIT( WORD , I ) "670"
THEN ONES := ONES + 1 ; "680"
IF TESTBIT(PARITY_BITS_IN_USE , P_BIT ) "690"
THEN "700"
BEGIN "710"
IF GETBITS( ONES , 0 , 1 ) <> "720"
GETBITS( PARITY_AREA[ROW] , P_BIT , 1 ) "730"
THEN SETBIT( PARITY_AREA[ ROW ] , P_BIT ) "740"
ELSE CLEARBIT(PARITY_AREA[ROW ] , P_BIT ) "750"
END "760"
ELSE "770"
BEGIN "780"
IF TESTBIT( ONES , 0 ) "790"
THEN CLEARBIT( PARITY_AREA[ROW], P_BIT ) "800"
ELSE SETBIT( PARITY_AREA[ROW] , P_BIT ) "810"
END; "820"
END; "830"
END "PROMWORD TREATMENT" ; "840"
"PAGE" \f
FUNCTION SHORT1( L_INT: UNIV LONG1 ) : INTEGER ; "10"
BEGIN "20"
SHORT1 := L_INT.LSB ; "30"
END; "40"
"PAGE" \f
PROCEDURE EXTRACT_PARITY_PROM( F_OUT : STREAM ; "10"
PROM_NO : INTEGER ) ; "20"
VAR J, "30"
COL : INTEGER ; "40"
BEGIN "50"
COL := 16 DIV PHYS_PROM.WIDTH - PROM_NO ; "60"
J:= 0 ; "70"
REPEAT "80"
PROM_WORD_TREATMENT( F_OUT , S_IN , J , "110"
PROM_NO , HEXA_NO ) ; "115"
J := J + 1 ; "120"
UNTIL "130"
J >=SHORT( PHYS_PROM.SIZE ) ; "140"
OUTNL( F_OUT ) ; "142"
OUTSTRING( F_OUT , 'CHECKSUM: (:0:)' );
OUTHEXA( F_OUT ,SHORT1( PROM[ PROM_NO ].CHECKSUM ) , 5 ) ; "146"
OUTNL( F_OUT ) ;
OUTBYTE( F_OUT , EM ); "149"
END " EXTRACT PARITY PROM" ; "150"
"PAGE" \f
PROCEDURE EXTRACT_PROM( F_OUT,F_IN : STREAM ; "10"
PROM_NO : INTEGER ); "20"
VAR ROW , COL , I , S : INTEGER ; "30"
HEXA : CHAR ; "40"
START,J ,OFFSET_NO : LONG_INTEGER ; "50"
BEGIN "60"
HEXA_NO := 0 ; "70"
ROW := ( PROM_NO - 1 ) DIV PROMS_PR_ROW ; "80"
COL := ( PROM_NO - 1 ) MOD PROMS_PR_ROW ; "90"
IF ROW=0 "110"
THEN START := PROM_AREA.START_ADDRESS "120"
ELSE START := 0L ; "130"
IF ROW >= 1 "140"
THEN "150"
BEGIN "160"
J := PHYS_PROM.SIZE - PROM_AREA.START_ADDRESS ; "170"
" ROW POSITIONING " "175"
OFFSET_NO := J * LONG( HEXA_PR_ROW ) "180"
+ LONG( HEXA_PR_PROM_ROW * ( ROW-1 ) ); "185"
J := 0L ; "190"
REPEAT "200"
J:= J + 1L ; "205"
READ_HEXA( F_IN , HEXA , HEXA_NO ) ; "210"
UNTIL "215"
J >= OFFSET_NO ; "218"
END " ROW > 1 " ; "220"
J := START ; "230"
WHILE "235"
J < PHYS_PROM.SIZE DO "240"
BEGIN "245"
"POSITION IN THE PROMAREA WORD " "250"
FOR S := 1 TO COL*HEXA_PR_SINGLE_PROM DO "260"
READ_HEXA( F_IN , HEXA , HEXA_NO ); "270"
PROM_WORD_TREATMENT( "280"
F_OUT , F_IN , SHORT(J) , PROM_NO , HEXA_NO ); "285"
" SKIP THE REST OF THE LINE " "290"
FOR S := 1 TO "300"
(PROMS_PR_ROW - COL - 1 )* HEXA_PR_SINGLE_PROM DO "305"
READ_HEXA( F_IN , HEXA, HEXA_NO ); "310"
J := J + 1L ; "320"
END; "330"
OUTNL( F_OUT ) ; "331"
OUTSTRING( F_OUT , 'CHECKSUM: (:0:)' ); "332"
OUTHEXA( F_OUT ,SHORT1( PROM[ PROM_NO ].CHECKSUM ) , 5 ) ; "334"
OUTNL( F_OUT ) ; "336"
OUTBYTE( F_OUT , EM ) ; "340"
I := PROM[ PROM_NO ].PARITY_BIT ; "342"
IF ( I>=0) AND ( I<=15 ) "344"
THEN SETBIT( PARITY_BITS_IN_USE , I ) ; "346"
END " EXTRACT PROM" ; "350"
"PAGE" \f
PROCEDURE PRINT_ID_RECORD( S: STREAM; "10"
PROM_NO: INTEGER ); "20"
BEGIN "30"
OUTNL(S); "40"
OUTSTRING( S , 'ORIGINATED BY: (:0:)' ); "50"
OUTSTRING( S , ID_RECORD.ORIGINATOR ); "60"
OUTNL(S); "70"
OUTSTRING( S , 'PROJECT NO: (:0:)' ); "80"
OUT_LONG_INTEGER( S , ID_RECORD.PROJECT_NO , 8 ); "90"
OUTNL(S); "100"
OUTSTRING( S , 'DATE: (:0:)' ); "110"
OUT_LONG_INTEGER( S , ID_RECORD.DATE , 8 ); "120"
OUTNL( S ) ; "130"
OUTSTRING( S , 'MODULE: (:0:)' ); "140"
OUTTEXT( S , ID_RECORD.MODULE , 60 ) ; "150"
OUTNL(S); "160"
OUTSTRING( S , 'FLOPPY DISC NO CR/D/(:0:)' ); "170"
OUTINTEGER( S , ID_RECORD.FLOPPY_DISC_NO , 4 ); "180"
OUTNL(S); "190"
OUTSTRING( S, 'SOURCE TEXT AND VERSION: (:0:)' ); "200"
OUTTEXT( S , ID_RECORD.SOURCE_TEXT ,60 ); "210"
OUTNL(S); "220"
OUTSTRING( S , 'AREASIZE: (:0:)' ); "230"
OUT_LONG_INTEGER( S , PROM_AREA.SIZE , 7 ); "240"
OUTNL(S); "250"
OUTSTRING( S , 'AREA START ADDRESS: (:0:)' ); "260"
OUT_LONG_INTEGER( S , PROM_AREA.START_ADDRESS , 7 ); "270"
OUTNL(S); "280"
OUTSTRING( S , 'PROMSIZE: (:0:)' ); "290"
OUT_LONG_INTEGER( S , PHYS_PROM.SIZE , 6) ; "300"
OUTNL(S); "310"
OUTSTRING( S , 'PROMWIDTH: (:0:)' ); "320"
OUTINTEGER( S , PHYS_PROM.WIDTH , 4 ); "330"
OUTNL(S); "340"
OUTSTRING( S , 'PROM FILE: (:0:)' ); "350"
OUTSTRING( S , PROM[ PROM_NO ].FILE ); "360"
OUTNL(S); "370"
OUTSTRING( S , 'PROMID: (:0:)' ); "380"
OUTINTEGER( S ,PROM[ PROM_NO ].IDNO , 5 ); "390"
OUTSTRING( S , ' VERSION: (:0:)' ); "400"
OUTINTEGER( S , PROM[ PROM_NO ].VERSION , 3 ); "410"
IF PROM_NO <= NO_OF_PROMS "420"
THEN "422"
BEGIN "423"
OUTSTRING( S , ' PARITY BIT: (:0:)' ); "424"
OUTINTEGER( S , PROM[ PROM_NO ].PARITY_BIT , 2 ); "425"
END; "427"
OUTNL(S); "440"
OUTSTRING( S , 'PROM INPUT FILE: (:0:)' ); "450"
OUTTEXT( S , PROM_INPUT_FILE , IDLENGTH ) ; "460"
OUTNL( S ); "465"
OUTSTRING( S , 'PARAM INPUT FILE: (:0:)' ); "470"
OUTTEXT( S , PARAM_INPUT_FILE , IDLENGTH ) ; "480"
OUTNL(S); "540"
END "PRINT_ID_RECORD"; "550"
"PAGE" \f
PROCEDURE OC_CHECKSUM( PROM_NO : INTEGER ) ; "10"
VAR S : STREAM ; "15"
BEGIN "20"
OPEN( S , 'OC(:0:)' , OUTPUT ) ; "30"
OUTNL(S); "500"
OUTSTRING( S , 'PROMID: (:0:)' ); "380"
OUTINTEGER( S ,PROM[ PROM_NO ].IDNO , 5 ); "390"
OUTSTRING( S , ' VERSION: (:0:)' ); "400"
OUTINTEGER( S , PROM[ PROM_NO ].VERSION , 3 ); "410"
OUTNL(S); "370"
OUTSTRING( S , 'CHECKSUM: (:0:)' ); "520"
OUTHEXA( S , SHORT1( PROM[ PROM_NO ].CHECKSUM ) , 5 ) ; "530"
OUTNL( S ) ; "535"
CLOSE( S ) ; "536"
END "OC CHECKSUM" ; "540"
"PAGE" \f
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
" MAIN PROGRAM "
"**********************************************************************"
BEGIN "10"
OPEN( S_IN , 'OC(:0:)' , INPUT ); "20"
OPEN( S_OUT, 'OC(:0:)' , OUTPUT ); "30"
GET_OC_PARAMS( S_IN , S_OUT ) ; "40"
CLOSE( S_IN); "50"
CLOSE( S_OUT ) ; "60"
IF PARAM[P].TAG = IDTYPE "62"
THEN PARAM_INPUT_FILE := PARAM[ P ].ID "63"
ELSE PARAM_INPUT_FILE := 'OC(:0:) ' ; "65"
IF PARAM[S].TAG = IDTYPE "66"
THEN PROM_INPUT_FILE := PARAM[S].ID "67"
ELSE PROM_INPUT_FILE := 'OC(:0:) ' ; "69"
OPEN( S_IN , PARAM_INPUT_FILE , INPUT ) ; "70"
GET_DISC_PARAMS( S_IN ); "80"
CLOSE( S_IN ) ; "90"
CHECK_PARAMS ; "95"
DEFINE_CONSTANTS ; "100"
FOR I:=1 TO ( NO_OF_PROMS + NO_OF_PARITY_PROMS ) DO "110"
BEGIN "120"
OPEN( S_IN , PROM_INPUT_FILE , INPUT ); "130"
OPEN( S_OUT , PROM[I].FILE , OUTPUT ) ; "140"
PRINT_ID_RECORD( S_OUT , I ); "150"
IF I <= NO_OF_PROMS "162"
THEN EXTRACT_PROM( S_OUT , S_IN , I ) "164"
ELSE EXTRACT_PARITY_PROM( S_OUT , I); "166"
CLOSE( S_IN ) ; "170"
CLOSE( S_OUT ) ; "180"
OC_CHECKSUM( I ); "185"
END; "190"
END. "200"
"**********************************************************************"
" END OF PROGRAM "
"**********************************************************************"
"PAGE" \f
«eof»