-- file: PLtoTF4Impl.mesa
-- Pascal-to-Mesa translator output, translated at October 23, 1985 11:00:04 am PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
PLtoTFPrivate,
PLtoTFExternals;
PLtoTF4Impl: PROGRAM IMPORTS PascalBasic, PascalWizardFiles, PLtoTFPrivate EXPORTS PLtoTFPrivate = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, PLtoTFPrivate, PLtoTFExternals;
WriteByte: PROCEDURE[ F: LONG POINTER TO ByteFile,B: PascalInteger[0..255]] =
BEGIN PascalWriteLong[file: @F↑.baseFile, length: SIZE[PascalInteger[0..255], 2], element: @F↑.element, item: @B]; END;
--:86----87:-- ReadBcpl: PROCEDURE[L: HeaderIndex,N: Byte] =
BEGIN K:HeaderIndex;
K←L;WHILE CurChar=32 DO GetNext[] ENDLOOP ;
WHILE(CurChar#40)AND (CurChar#41)DO BEGIN IF INT[K]<L+N THEN K←K+1;
IF INT[K]<L+N THEN HeaderBytes↑[K]←CurChar;GetNext[]; END ENDLOOP ;
IF K=L+N THEN BEGIN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
{PascalWriteLongString[file: @Output, item: "String is too long; its first "]; PascalWriteInteger[file: @Output, item: N-1, fieldMinLength: 1]; PascalWriteLongString[file: @Output, item: " characters will be kept"]
};ShowErrorContext[]; END;K←K-1; END;HeaderBytes↑[L]←K-L;
WHILE INT[K]<L+N-1 DO BEGIN K←K+1;HeaderBytes↑[K]←0; END ENDLOOP ; END;--:87----96:
CheckTag: PROCEDURE[C: Byte] =
BEGIN SELECT CharTag↑[C]FROM 0 => NULL;
1 =>BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "This character already appeared in a LIGTABLE LABEL"];
ShowErrorContext[]; END;2 =>BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "This character already has a NEXTLARGER spec"];
ShowErrorContext[]; END;3 =>BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "This character already has a VARCHAR spec"];ShowErrorContext[];
END; ENDCASE; END;--:96----106:-- PrintOctal: PROCEDURE[C: Byte]
=
BEGIN {PascalWriteLongString[file: @Output, item: "'"]; PascalWriteInteger[file: @Output, item: ( PascalDIVPower2[C ,6]), fieldMinLength: 1]; PascalWriteInteger[file: @Output, item: ( PascalMODPower2Mask[( PascalDIVPower2[C ,3]),7]), fieldMinLength: 1]; PascalWriteInteger[file: @Output, item: ( PascalMODPower2Mask[C ,7]), fieldMinLength: 1]}; END;--:106
--128:-- OutScaled: PROCEDURE[X: FixWord] =
BEGIN Z:PascalReal;N:Byte;M:PascalInteger[0..65535];
IF ABS[PascalFLOAT[X]/PascalFLOAT[DesignUnits]]>=16.0 THEN BEGIN {
PascalWriteLongString[file: @Output, item: "The relative dimension"]; PascalWriteReal[file: @Output, item: PascalFLOAT[X]/PascalFLOAT[1048576], fieldMinLength: 1, fracLength: 3]; PascalWriteLongString[file: @Output, item: " is too large."]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: " (Must be less than 16*designsize"];
IF DesignUnits#1048576 THEN {PascalWriteLongString[file: @Output, item: " ="]; PascalWriteReal[file: @Output, item: PascalFLOAT[DesignUnits]/PascalFLOAT[65536], fieldMinLength: 1, fracLength: 3]
; PascalWriteLongString[file: @Output, item: " designunits"]};{PascalWriteLongString[file: @Output, item: ")"]; PascalWriteLn[file: @Output]};X←0; END;
IF X<0 THEN WriteByte[@TfmFile,255] ELSE WriteByte[@TfmFile,0];
IF DesignUnits=1048576 THEN BEGIN IF X<0 THEN X←X+16777216;
N← PascalDIVPower2[X ,16];M← PascalMODPower2Mask[X ,65535]; END ELSE BEGIN Z←(PascalFLOAT[X]/PascalFLOAT[DesignUnits])*16.0;
IF Z<PascalFLOAT[0 ] THEN Z←Z+256.0;N←PascalTRUNC[Z];M←PascalTRUNC[65536.0*(Z-PascalFLOAT[N])]; END;
WriteByte[@TfmFile,N];WriteByte[@TfmFile, PascalDIVPower2[M ,8]];
WriteByte[@TfmFile, PascalMODPower2Mask[M ,255]]; END;--:128----134:-- ParamEnter: PROCEDURE
=
BEGIN--48:-- NameLength←5;CurName↑[16]←83;CurName↑[17]←76;
CurName↑[18]←65;CurName↑[19]←78;CurName↑[20]←84;EnterName[21];
NameLength←5;CurName↑[16]←83;CurName↑[17]←80;CurName↑[18]←65;
CurName↑[19]←67;CurName↑[20]←69;EnterName[22];NameLength←7;
CurName↑[14]←83;CurName↑[15]←84;CurName↑[16]←82;CurName↑[17]←69;
CurName↑[18]←84;CurName↑[19]←67;CurName↑[20]←72;EnterName[23];
NameLength←6;CurName↑[15]←83;CurName↑[16]←72;CurName↑[17]←82;
CurName↑[18]←73;CurName↑[19]←78;CurName↑[20]←75;EnterName[24];
NameLength←7;CurName↑[14]←88;CurName↑[15]←72;CurName↑[16]←69;
CurName↑[17]←73;CurName↑[18]←71;CurName↑[19]←72;CurName↑[20]←84;
EnterName[25];NameLength←4;CurName↑[17]←81;CurName↑[18]←85;
CurName↑[19]←65;CurName↑[20]←68;EnterName[26];NameLength←10;
CurName↑[11]←69;CurName↑[12]←88;CurName↑[13]←84;CurName↑[14]←82;
CurName↑[15]←65;CurName↑[16]←83;CurName↑[17]←80;CurName↑[18]←65;
CurName↑[19]←67;CurName↑[20]←69;EnterName[27];NameLength←4;
CurName↑[17]←78;CurName↑[18]←85;CurName↑[19]←77;CurName↑[20]←49;
EnterName[28];NameLength←4;CurName↑[17]←78;CurName↑[18]←85;
CurName↑[19]←77;CurName↑[20]←50;EnterName[29];NameLength←4;
CurName↑[17]←78;CurName↑[18]←85;CurName↑[19]←77;CurName↑[20]←51;
EnterName[30];NameLength←6;CurName↑[15]←68;CurName↑[16]←69;
CurName↑[17]←78;CurName↑[18]←79;CurName↑[19]←77;CurName↑[20]←49;
EnterName[31];NameLength←6;CurName↑[15]←68;CurName↑[16]←69;
CurName↑[17]←78;CurName↑[18]←79;CurName↑[19]←77;CurName↑[20]←50;
EnterName[32];NameLength←4;CurName↑[17]←83;CurName↑[18]←85;
CurName↑[19]←80;CurName↑[20]←49;EnterName[33];NameLength←4;
CurName↑[17]←83;CurName↑[18]←85;CurName↑[19]←80;CurName↑[20]←50;
EnterName[34];NameLength←4;CurName↑[17]←83;CurName↑[18]←85;
CurName↑[19]←80;CurName↑[20]←51;EnterName[35];NameLength←4;
CurName↑[17]←83;CurName↑[18]←85;CurName↑[19]←66;CurName↑[20]←49;
EnterName[36];NameLength←4;CurName↑[17]←83;CurName↑[18]←85;
CurName↑[19]←66;CurName↑[20]←50;EnterName[37];NameLength←7;
CurName↑[14]←83;CurName↑[15]←85;CurName↑[16]←80;CurName↑[17]←68;
CurName↑[18]←82;CurName↑[19]←79;CurName↑[20]←80;EnterName[38];
NameLength←7;CurName↑[14]←83;CurName↑[15]←85;CurName↑[16]←66;
CurName↑[17]←68;CurName↑[18]←82;CurName↑[19]←79;CurName↑[20]←80;
EnterName[39];NameLength←6;CurName↑[15]←68;CurName↑[16]←69;
CurName↑[17]←76;CurName↑[18]←73;CurName↑[19]←77;CurName↑[20]←49;
EnterName[40];NameLength←6;CurName↑[15]←68;CurName↑[16]←69;
CurName↑[17]←76;CurName↑[18]←73;CurName↑[19]←77;CurName↑[20]←50;
EnterName[41];NameLength←10;CurName↑[11]←65;CurName↑[12]←88;
CurName↑[13]←73;CurName↑[14]←83;CurName↑[15]←72;CurName↑[16]←69;
CurName↑[17]←73;CurName↑[18]←71;CurName↑[19]←72;CurName↑[20]←84;
EnterName[42];NameLength←20;CurName↑[1]←68;CurName↑[2]←69;
CurName↑[3]←70;CurName↑[4]←65;CurName↑[5]←85;CurName↑[6]←76;
CurName↑[7]←84;CurName↑[8]←82;CurName↑[9]←85;CurName↑[10]←76;
CurName↑[11]←69;CurName↑[12]←84;CurName↑[13]←72;CurName↑[14]←73;
CurName↑[15]←67;CurName↑[16]←75;CurName↑[17]←78;CurName↑[18]←69;
CurName↑[19]←83;CurName↑[20]←83;EnterName[28];NameLength←13;
CurName↑[8]←66;CurName↑[9]←73;CurName↑[10]←71;CurName↑[11]←79;
CurName↑[12]←80;CurName↑[13]←83;CurName↑[14]←80;CurName↑[15]←65;
CurName↑[16]←67;CurName↑[17]←73;CurName↑[18]←78;CurName↑[19]←71;
CurName↑[20]←49;EnterName[29];NameLength←13;CurName↑[8]←66;
CurName↑[9]←73;CurName↑[10]←71;CurName↑[11]←79;CurName↑[12]←80;
CurName↑[13]←83;CurName↑[14]←80;CurName↑[15]←65;CurName↑[16]←67;
CurName↑[17]←73;CurName↑[18]←78;CurName↑[19]←71;CurName↑[20]←50;
EnterName[30];NameLength←13;CurName↑[8]←66;CurName↑[9]←73;
CurName↑[10]←71;CurName↑[11]←79;CurName↑[12]←80;CurName↑[13]←83;
CurName↑[14]←80;CurName↑[15]←65;CurName↑[16]←67;CurName↑[17]←73;
CurName↑[18]←78;CurName↑[19]←71;CurName↑[20]←51;EnterName[31];
NameLength←13;CurName↑[8]←66;CurName↑[9]←73;CurName↑[10]←71;
CurName↑[11]←79;CurName↑[12]←80;CurName↑[13]←83;CurName↑[14]←80;
CurName↑[15]←65;CurName↑[16]←67;CurName↑[17]←73;CurName↑[18]←78;
CurName↑[19]←71;CurName↑[20]←52;EnterName[32];NameLength←13;
CurName↑[8]←66;CurName↑[9]←73;CurName↑[10]←71;CurName↑[11]←79;
CurName↑[12]←80;CurName↑[13]←83;CurName↑[14]←80;CurName↑[15]←65;
CurName↑[16]←67;CurName↑[17]←73;CurName↑[18]←78;CurName↑[19]←71;
CurName↑[20]←53;EnterName[33];--:48-- END;
END.