Artifact d0e21079d03eaba96f3f85b5a60aa4d41ab2e9d6cdbd4028b934eca5b4bfdeeb:
- File
psl-1983/3-1/doc/examples-for-imp-guide.mss
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 13951) [annotate] [blame] [check-ins using] [more...]
- File
psl-1983/doc/examples-for-imp-guide.mss
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 13951) [annotate] [blame] [check-ins using]
@section(Examples of various kinds) Recall that when compiling code, variables which are used extended in one procedure, and bound as LAMBDA or PROG variables in another, must be declared fluids. Example: @begin(verbatim) (de foo(X) (PLUS2 X 1)), compiles to: (!*entry foo expr 1) (!*alloc 0) (!*move (quote 1) (reg 2)) (!*linke 0 plus2 expr 2) (de fee(X Y) (Fum (foo X) (foo Y)), compiles to: (!*entry fee expr 2) (!*alloc 2) (!*move (reg 2) (frame 2)) (!*link foo expr 1) (!*move (reg 1) (frame 1)) (!*move (frame 2) (reg 1)) (!*link foo expr 1) (!*move (reg 1) (reg 2)) (!*move (frame 1) (reg 1)) (!*linke 2 fum expr 2) Finally, (de fac (N) (cond ((Lessp N 1) 1) (T (Times2 N (fac SUB 1 N)) compiles to: (!*entry fac expr 1) (!*alloc 1) (!*move (reg 1) (frame 1)) (!*move (quote 1) (reg 2)) (!*link LessP expr 1) (!*jumpeq (label L) (quote nil) (reg 1)) (!*move (quote 1) (reg 1)) (!*exit 1) (!*lbl (label L)) (!*move (frame 1) (reg 1)) (!*link sub1 expr 1) (!*link fac expr 1) (!*move (reg 1) (reg 2)) (!*move (frame 1) (reg 1)) (!*linke 1 times2 expr 2) @end(verbatim) @section(BUILDING the CROSS Compiler) The executable @dq[xxxx-CROSS.EXE] is built as follows: @begin(verbatim) @@psl:rlisp ! an RLISP *mapobl function lambda X; *<< RemProp(X, 'OpenCode); * RemProp(X, 'ExitOpenCode) >>; % Remove old compiler opts * % Load common modules *load(zboot, pass!-one!-lap, if!-system, syslisp, lap!-to!-asm); * % Load XXXX specific modules *load(XXXX!-comp, XXXX!-cmac, XXXX!-asm); *off UserMode; *DumpFileName!* := "filename.exe"; % Establish the executable name *Date!*:=Concat("XXXX Cross Assmbler ", Date()); % Establish greeting *DumpLisp(); % Does a Reclaim and save *Quit; @end(verbatim) @subsection(An example of the process) The following is a complete example, from @syslisp to @CMACRO@xs: @begin(verbatim,leftmargin 0) @@PSL:RLISP PSL 3.0 Rlisp, 9-May-82 syslsp procedure Test1(); % Input RLISP syntax code begin scalar x; x := 5; x := x+7; L := '(A B C D); L1 := (CAR L) . CAR(CDR L); print L1; end; @End(verbatim) @begin(verbatim,leftmargin 0) % This is the output from the Compiler/LAP system. % The lines beginning with "(!* ... " are the Abstract % machine CMACRO's output from the compiler. % The indented lines following them are the VAX @sq[LAP] % assembly code the CMACRO patterns % (in the *-CMAC.SL files) produced by the expansion process. (!*PUSH '5) (@op{PUSHL} 5) (!*WPLUS2 (FRAME 1) (WCONST 7)) % WPLUS2 is actually a % CMACRO (OpenFunct) (@op{ADDL2} 7 (DEFERRED (REG ST))) % Note how the FRAME AnyReg % is converted directly to % a machine specific % addressing mode. (!*MOVE '(A B C D) (!$FLUID L)) (@op{MOVL} '(A B C D) (!$FLUID L)) (!*MOVE (CAR (CDR (!$FLUID L))) (REG 2)) % The AnyReg patterns (@op{EXTZV} 0 27 (!$FLUID L) (REG 2)) % for CAR and CDR are used (@op{EXTZV} 0 27 (DISPLACEMENT (REG 2) 4) (REG 2)) (@op{MOVL} (DEFERRED (REG 2)) (REG 2)) (!*MOVE (CAR (!$FLUID L)) (REG 1)) (@op{EXTZV} 0 27 (!$FLUID L) (REG 1)) (@op{MOVL} (DEFERRED (REG 1)) (REG 1)) (!*LINK CONS EXPR 2) % Standard Function Cell % call. (@op{JSB} (ENTRY CONS)) (!*MOVE (REG 1) (!$FLUID L1)) (@op{MOVL} (REG 1) (!$FLUID L1)) (!*LINK PRINT EXPR 1) (@op{JSB} (ENTRY PRINT)) (!*MOVE 'NIL (REG 1)) (@op{MOVL} (REG NIL) (REG 1)) % Reg NIL evaluates to an (!*EXIT 1) % immediate constant. (@op{ADDL2} 4 (REG ST)) (@op{RSB}) TEST1 @end(verbatim) @subsection(Prologues and Epilogues) An example of Prologues and Epilogues for (@APOLLO version of) the @68000 is given below: @begin(ProgramExample,leftmargin 0) lisp procedure CodeFileHeader(); % Pure Code Segment If !*MAIN then <<CodePrintF(" program %w,m0001%n",ModName!*); CodePrintF " data%n"; DataProcState!*:='data; CodePrintF "* Start of execution of the program%n"; CodeDeclareExternal 'SYMVAL; %/ Issue EXTERN.D early CodeDeclareExternal 'SYMFNC; %/ Issue EXTERN.D early CodePrintF "m0001 EQ *%n"; CodePrintF " move.l db,-(sp) Save caller db%n"; CodePrintF " clr.l -(sp) Push reserved word%n"; CodePrintF " move.l a0,-(sp) Push address of ECB%n"; CodePrintF " move.l SYMVAL+512,d0 Init NIL Reg%n"; CodePrintF " link sb,#0 Balance unlink%n"; CodePrintF " movea.l #0,a6 Setup zeroareg%n"; CodePrintF " lea m0001,db Setup db reg%n"; CodePrintF(" jsr %w Call Main routine%n", MainEntryPointNAme!*); CodePrintF "* now return to OS%n"; CodePrintF " movea.l A_PGM_$EXIT,a6%n"; CodePrintF " jsr (a6)%n"; CodePrintF " unlk sb Reload callers SB%n"; CodePrintF " addq.w #8,sp Pop linkage%n"; CodePrintF " movea.l (sp)+,db Reload callers db%n"; CodePrintF " rts Return%n"; ForeignExternList!*:=NIL; CheckForeignExtern 'PGM!_!$EXIT; >> else <<CodePrintF (" module %w,m0000%n",ModName!*); %/ Kludge, since ModuleName set in ASMOUT CodePrintF " data%n"; DataProcState!*:='data; CodeDeclareExternal 'SYMVAL; %/ Issue EXTERN.D early CodeDeclareExternal 'SYMFNC; %/ Issue EXTERN.D early CodePrintF "* this is an Independent Module %n"; ForeignExternList!*:=NIL; >>; lisp procedure DataFileHeader(); Begin DataPrintF(" module %w_D%n",ModName!*); DataPrintF " data%n"; End; lisp procedure DataFileTrailer(); DataPrintF "end%n"; lisp procedure CodeFileTrailer(); <<Foreach Fn in Reverse ForeignExternList!* do <<CodePrintF(" extern.p %w%n",Fn); CodePrintF("A_%w ac %w%n",Fn,Fn)>>; CodePrintF " end%n">>; @end(ProgramExample) The general use of the headers given above is to declare the module name, tell the assembler that this is a data section@Foot[On the @Apollo all of the code and data were put in a data section since the operating system and assembler had a problem with mixed code and data due to expecting a pure code segment with all data references relative to the data base register.], and in the case of the main routine performing the proper operating system dependent linkage for program entry and exit. Note that CodePrintF and DataPrintF are used to direct output to either the @ei[code] segment or @ei[data] segment. This is to allow seperate segements for those machines that allow for pure code segments (on the @Apollo a pure code segment is directly maped into the address space rather than copied, which results in a large difference in start up speed). This could probably be extended to PureCode, PureData, and ImpureData. procedure WW(X); <<print LIST('WW,x); x+1>>; Now a plain resolve function. That does not argument processing best for register conversion: procedure MYREGFN(R,S); <<Print LIST('MYREG, R,S); List('REG,S+10)>>; PUT('MYREG,'ANYREGRESOLUTIONFUNCTION,'MYREGFN); procedure MYANYFN(R,S); <<Print LIST('MYANY, R,S); S:= ResolveOperand('(REG t3),S); List('Weird,S)>>; FLAG('(WEIRD),'TERMINALOPERAND); PUT('MYANY,'ANYREGRESOLUTIONFUNCTION,'MYANYFN); (!*MOVE (WW 1) (WW 2))); ARgs must be WCONSTEVALUABEL (!*MOVE (WW (WW 1)) (WW 2))); (!*MOVE (WW A) (WW 2))); % First WW shouldnt convert (!*MOVE (MYREG 1) (MYREG 2))); % OK (!*MOVE (MYREG (WW 1)) (WW (MYREG 2)))); % Fails since args not processed (!*MOVE (MYREG (MYREG 1)) (MYREG 2))); (!*MOVE (MYANY 1) (MYANY 2))); % OK (!*MOVE (MYANY (WW 1)) (MYANY (MYREG 2)))); % Args processed (!*MOVE (MYANY (MYANY 1)) (MYANY 2))); @section(Sample ANYREGs and CMACROs from various machines) The following choice pieces from the @VAX750, @DEC20 and @68000 illustrate a range of addressing modes, predicates and style. @subsection(VAX) @begin(verbatim,leftmargin 0) (DefCMacro !*Move % ARGONE -> ARGTWO (Equal) % Don't do anything ((ZeroP AnyP) (@op{clrl} ARGTWO)) % 0 -> ARGTWO ((NegativeImmediateP AnyP) % -n -> ARGTWO (@op{mnegl} (immediate (minus ARGONE)) ARGTWO)) ((@op{movl} ARGONE ARGTWO))) % General case (DefCMacro !*WPlus2 % ARGONE+ARGTWO->ARGONE ((AnyP OneP) (@op{incl} ARGONE)) % add 1 ((AnyP MinusOneP) (@op{decl} ARGONE)) % Subtract 1 ((AnyP MinusP) (@op{subl2} (immediate (minus ARGTWO)) ARGONE)) ((@op{addl2} ARGTWO ARGONE))) The Predicates used: @begin(description,spread 0) Equal@\As an atom, rather than in (...), it check both arguments same. Zerop@\Check if argument is 0 AnyP@\Just returns T NegativeImmediateP@\Check that a negative, 32 bit constant. @end(Description) @end(verbatim) @subsection(DEC-20) @begin(verbatim,leftmargin 0) (DefCMacro !*Move % Move ArgOne -> ArgTwo (Equal) ((ZeroP AnyP) (@op{setzm} ARGTWO)) ((MinusOneP AnyP) (@op{setom} ARGTWO)) ((RegisterP AnyP) (@op{movem} ARGONE ARGTWO)) ((NegativeImmediateP RegisterP) (@op{movni} ARGTWO (immediate (minus ARGONE)))) ((ImmediateP RegisterP) (@op{hrrzi} ARGTWO ARGONE)) ((AnyP RegisterP) (@op{move} ARGTWO ARGONE)) ((!*MOVE ARGONE (reg t1)) (@op{movem} (reg t1) ARGTWO))) (DefCMacro !*WPlus2 ((AnyP OneP) (@op{aos} ARGONE)) ((AnyP MinusOneP) (@op{sos} ARGONE)) ((AnyP RegisterP) (@op{addm} ARGTWO ARGONE)) ((RegisterP NegativeImmediateP) (@op{subi} ARGTWO (minus ARGONE))) ((RegisterP ImmediateP) (@op{addi} ARGTWO ARGONE)) ((RegisterP AnyP) (@op{add} ARGONE ARGTWO)) ((!*MOVE ARGTWO (reg t2)) (@op{addm} (reg t2) ARGONE))) The Predicates used: @begin(description,spread 0) Equal@\As an atom, rather than in (...), it check both arguments same. Zerop@\Check if argument is 0 AnyP@\Just returns T MinusOneP@\Check that argument is -1. ImmediateP@\Check that an address or 18 bit constant. Will change for extended addressing. NegativeImmediateP@\Check that a negative 18 bit constant. RegisterP@\Check that is (REG r), a register. @end(Description) @end(verbatim) @subsection(APOLLO) @begin(verbatim,leftmargin 0) (DefCMacro !*Move % (!*Move Source Destination) (Equal) % if source @Value(Eq) dest then do nothing ((ZeroP AregP)(@op{suba!.l} ARGTWO ARGTWO)) ((ZeroP AnyP) (@op{clr!.l} ARGTWO)) % if source @Value(Eq) 0 then dest := 0 ((InumP AregP) (@op{movea!.l} (Iconst ARGONE) ARGTWO)) ((AddressP AregP) (@op{lea} ARGONE ARGTWO)) ((InumP AnyP) (@op{move!.l} (Iconst ARGONE) ARGTWO)) ((AddressP AnyP) (lea ARGONE (reg a0)) (@op{move!.l} (reg a0) ARGTWO)) ((AnyP AregP) (@op{movea!.l} ARGONE ARGTWO)) ((@op{move!.l} ARGONE ARGTWO))) (DefCMacro !*WPlus2 % (!*WPlus2 dest source) ((AnyP QuickIconstP) (@op{addq!.l} (Iconst ARGTWO) ARGONE)) ((AnyP NegativeQuickIconstP) (@op{subq!.l} (Iconst (minus ARGTWO)) ARGONE)) ((AregP MinusP) (@op{suba!.l} (Iconst (Minus ARGTWO)) ARGONE)) ((AnyP MinusP) (@op{subi!.l} (Minus ARGTWO) ARGONE)) ((AregP InumP) (@op{adda!.l} (Iconst ARGTWO) ARGONE)) ((AnyP InumP) (@op{addi!.l} (Iconst ARGTWO) ARGONE)) ((AregP AddressP) (@op{lea} ARGTWO (reg a0)) (@op{adda!.l} (reg a0) ARGONE)) ((AnyP AddressP) (@op{lea} ARGTWO (reg a0)) (@op{add!.l} (reg a0) ARGONE)) ((AregP AnyP)(@op{adda!.l} ARGTWO ARGONE)) ((@op{add!.l} ARGTWO ARGONE))) % really need one a DREG The Predicates used: @begin(description,spread 0) Equal@\As an atom, rather than in (...), it check both arguments same. Zerop@\Check if argument is 0 AregP@\Check that is one of the A registers (which can not be used for arithmetic), and require modified mnemonics. DregP@\Check that is one of the D registers, used for most arithmetic. InumP@\Check that a small integer. AddressP@\Check that an address, not a constant, since we need to use different instruction for Address's, e.g@. @op{lea} vs @op{movi}. AnyP@\Just returns T. NegativeImmediateP@\Check that a negative, 32 bit constant. QuickIconstP@\Small integer in range 1 ..@. 8 for the xxxxQ instructions on 68000. NegativeQuickIconstP@\Small integer in range -8 ..@. -1 for the xxxxQ instructions on 68000. @end(Description) @end(verbatim) @begin(verbatim,leftmargin 0) For example, on the @VAX750: @begin(Group) (DefAnyreg CAR % First ITEM of pair AnyregCAR % Associated function ((@op{extzv} 0 27 SOURCE REGISTER) % Code to extract 27 bit % address, masking TAG (Deferred REGISTER))) % Finally indexed mode used @hinge (DefAnyreg CDR % Second item AnyregCDR ((@op{extzv} 0 27 SOURCE REGISTER) (Displacement REGISTER 4))) % Displace 4 bytes off Register % Both CAR and CDR use a single instruction, so do not use a % predicate to test SOURCE. @hinge (DefAnyreg QUOTE % Note a set of different choices AnyregQUOTE ((Null) (REG NIL)) ((EqTP) (FLUID T)) ((InumP) SOURCE) ((QUOTE SOURCE))) @hinge (DefCMACRO !*Move % !*MOVE Usually has the most cases (Equal) ((ZeroP AnyP) (@op{clrl} ARGTWO)) ((NegativeImmediateP AnyP) (@op{mnegl} (immediate (minus ARGONE)) ARGTWO)) ((@op{movl} ARGONE ARGTWO))) @hinge (DefCMACRO !*Alloc ((ZeroP)) % No BODY - nothing to allocate ((@op{subl2} ARGONE (REG st)))) @end(group) @end(verbatim)