-- file: PLtoTF4Impl.mesa -- Pascal-to-Mesa translator output, translated at September 23, 1986 1:41:45 pm 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.