|
Volume Number: | 6 | |
Issue Number: | 6 | |
Column Tag: | Assembly Lab |
Related Info: Memory Manager Segment Loader
Some Glue for FORTRAN
By Frederick V. Hebard, Meadowview, VA
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.
[Fred Hebard is superintendent of the American Chestnut Foundation’s Research Farm in Meadowview, VA. He has a PhD in Plant Pathology. Donations for the Foundation may be directed to West Virginia University in Morgantown.]
Some Glue for FORTRAN
The last time I sat down to finish up an article for MacTutor it was raining. I had just started a one or two month hiatus between jobs, and that article was to be my first project. It rained that night too, so it was not until the next morning that I unpacked all my stuff from work. That evening I put it all back in the truck, and we evacuated the house in the face of the Kentucky River Flood of 1989. So much for that vacation!, not to mention the article. Well, it is December now, and I have completed another project that may be of interest.
When I first needed to migrate from mainframes to micros, I chose the MC68000 as my CPU because it had a linear 24-bit address space --no 32 or 64 k segments. The Mac had the most bang for the buck amongst 68000 machines, and AbSoft’s MacFortran offered full access to the 68000 --no 32 k segments. The Mac also had spectacular graphics, and a bit-mapped display. It was the slickest computer I had ever seen. Fortran has been derided quite a bit --no Fortran compiler has ever even been mini-reviewed in MacUser,-- but the main things MacFortran lacks in comparison to Pascal or C are complex data types and inline code. Besides, I had a fair amount of code built up from my mainframe and mini days.
I eventually acquired the MDS Assembler and set out to learn 68000 Assembly, mostly because all the wizards seem to know it. When HyperCard came along, I put the MDS package to work since MacFortran could not generate XFCNs, and I am too cheap (or is it broke?) to buy another language.
My cheapness (stubborness?) has led me to write an interface between Hypercard and MacFortran. Yeah, I know I can buy one for $70, but for that amount of money I could almost get Think C or Pascal[Not any more-ed]. Besides, you are definitely closer to the machine in an assembler --it is more fun. Or at least there are fewer pitfalls in Assembly than in higher level languages, even if the bugs are ten times harder to spot in that blizzard of code.
I thought this project would be of interest to XFCN affectionados because it illustrates error trapping in an XFCN. I have not seen that covered here previously. Neophyte assemblers might enjoy it since I am close to that level. The wizards can look at my code and smile. Finally, it is an example of a glue routine. I have not seen any of those in MacTutor.
Error Trapping in XFCNs
An error handle. An XFCN returns its result to HyperCard in a relocatable block pointed to by a handle. The block contains a string of ascii characters terminated by a null (#0). Since XFCNs can have no arguments, we first need to create a result for HyperCard before we check the arguments HyperCard has passed to us. Then, if the arguments are inappropriate for our XFCN, we can return to HyperCard without crashing it. HyperCard will crash if an XFCN returns with no result.
Thus, after setting up a stack frame for local variables, saving all the registers, and doing another manipulation I will discuss below, we allocate a handle for a HyperCard result. We make the handle 2 bytes long, stuff a null in its first byte, and put it in the returnValue slot of the XCmdBlock. It would be nice of Apple to have HyperCard stuff a valid handle in the returnResult of the XCmdBlock before calling an XFCN.
Note that we do not attempt to find out whether allocation of the handle was successful. There is nothing we could do about it if it were unsuccessful since we do not have a result to pass back to HyperCard. If we do get an error here, it is likely that we will not be able to perform any of the other memory allocations which occur in this XFCN. Those errors will be trapped, and we will attempt to inform the user of them. The other alternative is to reboot the machine, and that is very rude to your users!
So, gritting our teeth just a bit because we are no longer bulletproof, we are ready to read our args from the XCmdBlock.
Error handling. Our XFCN expects at least three arguments. If there are fewer than three, we exit by branching to the error-handling routine “badNumArgs.” That routine simply loads an error message for the user and branches to the routine “Err,” which is called by all the error-handling routines. “Err” prepares a HyperCard call back to put up the “Answer” dialog box. The box will contain our error message. “Err” calls the subroutine “callHyper,” which actually jumps to HyperCard. HyperCard returns below our BSR in “Err.” “Err” then branches to the main return point at “dondon” where we restore the registers, unlink, and return to HyperCard. I cribbed most of this code from Andy Hertzfeld’s source code for his importPict XCMD. Somehow, Andy’s code seems to be just a _bit_ more elegant than mine!
I would like to mention the use of the MDS Assembler’s _StringFormat 2 directive in the set of error strings. Our strings need to be Pascal String255s, with a leading length byte (as well as HyperCard strings with a trailing null). It sure is easier to let the assembler count the number of characters in your string than to do it by hand. We also use the .Align 2 directive to ensure that all strings start on a word boundary. Note that we have to restore _String Format to 0 when we are done because AbSoft’s code expects that.
Fortran Glue
Lock the arguments. Assuming we have not taken the branch to “badNumArgs,” we can replace the error handle in the returnResult of the XCmdBlock with one of the arguments passed from HyperCard, since we know the argument exists. MacFortran passes arguments between program units by pushing pointers to the arguments on the stack, whereas HyperCard passes handles to its arguments. Since MacFortran can make Memory Manager calls, we need to lock the handles before dereferencing them and passing them to MacFortran. Note we call MoveHHi before locking the handles. We do not lock the first three handles since they will not be passed along to MacFortran.
Runtime libraries. MacFortran implements almost all of its functions and utilities via calls to a series of routines contained in a runtime library. Floating point operations are not done via SANE calls; rather, MacFortran has its own collection of floating point routines, which are contained in the runtime library. The entire library is needed to implement any MacFotran routine, no matter how simple. Thus the first thing a MacFortran program does is to allocate space on the heap for the runtime library. It then jumps into the runtime library itself where most of the initialization code resides. There actually are two (three?) runtime libraries, depending on which compiler one has purchased. One library, “f77.rl,” implements all floating point operations in software, whereas another, “m81.rl,” can use the 68881 and 68882 math coprocessors.
Load the arguments. The first argument passed to Letsgo should be integer 1, 2 or 3, indicating which of three MacFortran runtime libraries the user possesses. If the integer is negative, we disable MacFortran’s default console window. If the first argument is not 1, 2 or 3, we branch to an error-handling routine, “badRuntimeArg.” This routine is similar to the “badNumArgs” routine except that it calls a subroutine to unlock the argument handles passed from HyperCard before loading its string and branching to “Err.” Later, when we allocate a handle for the real function result, we will have to unlock it also before returning to HyperCard. Note that we did not try to unlock the argument handles if we encountered an error while MoveHHi-ing them and locking them. An error there is an indication of serious problems in the system which are beyond our control, so we tell the user to reboot!
The second argument indicates how much heap space to allocate for the function result, and the third argument is the name of the MacFortran function subprogram the user wishes to call. Any additional arguments will be passed to the Fortran function subprogram.
Let’s not init the Window Manager in the middle of HyperCard! In the previous section, we discussed disabling Fortran’s default console window and selecting the appropriate runtime library. AbSoft very kindly provides a file, Init.asm, which is to be included in assembled Fortran main programs. That file contains comments indicating how to disable the console window, select the runtime library and disable initialization of the Mac Toolbox managers, such as the Window and Menu Managers. AbSoft requests that Init.asm not be modified in code distributed to others, but we have to change the first instruction in Init.asm to disable initialization of the Mac Toolbox Managers. That is the reason for the fourth and fifth instructions in this XFCN: we modify Init.asm in RAM after it has been loaded. Note that on CPUs with instruction caches, you have to flush the cache if you try to modify a nearby instruction. Thus we modify from a distance.
Four things. After we allocate a handle to hold the result of this XFCN, there are four things left to do before we can call our Fortran psuedo-main program, .WILLGO, at its entry point .START. Init.asm is the first part of .WILLGO. Init.asm will allocate a non-relocatable block to hold the runtime library, load the library from disk, then jump into its initialization routine (AbSoft still refers to the runtime library’s non-relocatable block as a “heap” in their documentation, although it no longer is one with version 2.4). We have to deallocate the storage for the Fortran “heap” before returning to HyperCard, since MacFortran does not. After initialization, the runtime library returns to .WILLGO with the Fortran “heap” pointer in register A4. We store the pointer on the stack frame in .WILLGO so we can deallocate the heap when Fortran returns to the main section of our XFCN, Letsgo. In Letsgo, we clear the stack frame storage for the “heap” pointer before the JSR to .START so we will know whether we ever got to .WILLGO.
We will fail to get to .WILLGO if Init.asm can not allocate the Fortran “heap” or can not find the runtime library on disk. In those cases, Init.asm will return directly to us. If Init.asm can allocate the “heap”, it will put a pointer to the end of the “heap” in register D4. Register D4 will not be altered further by Init.asm. Thus Letsgo will be able to distinguish the two error conditions, no heap and no runtime, depending on the contents of register D4 and FortranHeapPtr(A6).
We still have not examined the name of the Fortran function the user wants to call. That is best done in .WILLGO . Thus we need some indication that the user has passed us a valid subroutine name. That indication will be on the stack frame in “errorFlags.” We will fill “errorFlags” in .WILLGO if the function name is invalid, so we clear it here.
Finally, MacFortran mucks with A6, so we have to push its contents onto the stack. Then we will be able to access the stack frame of our main program in .WILLGO. We also will be able to “unlink” easily on return to our main program.
.WILLGO. .Willgo itself does three things: it changes the name of the function the user wants to call into Fortran readable form; it pushes the function result and arguments on the stack; and it calls the function.
MacFortran expects its 6-byte function names to be packed by the radix 50 method into a 4-byte integer. The function names can have no leading blanks and have to be six characters long. Trailing blanks can contribute to that six character length. So we convert the name the user has passed us to the six-byte format and call the Rad50 function Absoft supplies with their compiler. The error-handling routine in Rad50 is modified to set the errorFlag on Letsgo’s stackframe. Then we can use our error-handling code to notify the user if he passes us bad characters in the function name.
MacFortran expects a pointer to the function result on top of the stack, followed by the last argument in the call list, down to the first. Then the two-byte length of the first argument should have been pushed, followed by the length of the second argument, on down to the length of the last argument. Finally, the length of the function result should have been the first thing pushed on the stack. We do that, load data registers with the Rad50 name of the function and the number of arguments and off we go!
A heap of trouble. Well, I got to this point and thought I was done, but nooo...
I was playing around in HyperCard and I noticed that the paint routines were unavailable occasionally. Uhoh. Letsgo was the culprit. So I systematically dumped the heap after successive calls to Letsgo to see what the problem was. It was gook! Well, more precisely, Fortran was allocating non-relocatable blocks on the heap and not trashing them. That knowledge, by the way, enabled me to shorten the heap dumps to only non-relocatable blocks. Now, how do I figure out what Fortran is doing without violating my license agreement not to disassemble MacFortran’s runtime library?
Before we get to that, I would like to make an editorial comment. Both Apple and AbSoft have licensing agreements saying you are not to disassemble their private code. I object strongly to that. I can see vaguely how they can prohibit reverse engineering, to clone the Mac ROMs for instance, but to look at their code? That is equivalent to selling somebody a book and telling them they can not read it. Frankly, I think this whole idea the I do not own the copies of software I have purchased is pure baloney! Sure it is copyrighted, but I still own the book. And that includes my private property right to read my book. Is not this part of the idea of personal computers? They are yours. Do not you have the right (obligation?) to figure out how they work?
So anyway, I started halting execution of the Fortran function .WILLGO called, and looking at the heap. My Fortran function would be in a non-relocatable block on the heap, and various other blocks would be added depending on what the function did. Furthermore, the block containing my Fortran function had some extra data in the first 14 bytes before the code. And that data changed when other blocks were allocated.
In fact, the first long word in the block holding my function pointed to the first additional block which was allocated and was zero otherwise. The second long word pointed back into the runtime library. The location in the runtime library pointed to my function. Likewise, the first long word in any additional blocks pointed to the next block in the chain or was zero if there was none, and the second long word pointed back to the previous block. Aha, a linked list! And that location in the runtime library was the start of the list. It was 8 bytes above the location pointed to by register A0, which Absoft refers to as the communications block pointer. So degooking the heap is a simple matter of traversing the linked list, calling DisposPtr as we go.
After we do this, we merely have to check that .WILLGO liked the function name the user gave us and unlock HyperCard’s handles before returning to HyperCard.
What’s missing? This glue routine lacks three features. First, it does not support callbacks to HyperCard from Fortran. That could be added relatively easily. Second, MacFortran initializes the cursor on startup. I thought it best if the user handled restoring the cursor. We could patch the runtime library, but that would necessitate violating the license agreement. Or we could patch _InitCursor so it does nothing, then unpatch it after startup; that is a pretty heavy-handed approach for a minor problem! The third feature lacking in our glue routine is that it does not support static linking of the runtime library or the user’s function subprogram. Letsgo could be modified to accept hand linking of the runtime library and the function. It would merely have to find out how big it is and act accordingly. Or Absoft could modify their linker to work with assembled main programs, but for now, the best fix is to buy the MPW version of MacFortran. Then you will not need this code at all!
Recommendation. I would like to recommend Don Weston’s two volumes of The Complete Book of Macintosh Assembly Language Programming, especially Volume II. In my opinion, they are the best introduction to the Mac for programmers using any language.
So that’s it folks. Here’s the code. Avoid living in flood plains, even if the housing is inexpensive and you’re only planning to be there 3 years.
; MacFortran interface for HyperCard XFCNs. ; It calls MacFortran character functions. ; Calling syntax: “Put Letsgo(arg1,arg2,arg3 ;[,arg4,...,arg16<optional>]) into ...” ;Arg1 = runtime library name: ;1 = f77.rl ;2 = hdw.rl ;3 = m81.rl ;if arg is positive, console window is called ;up ;if arg is negative, console window is ;suppressed ;Arg2 = Size of result which the fortran ;character function will return. Size has to ;be < 32k to fit into a HyperCard container. ;Arg3 = Name of Fortran character function to be ;called. RESOURCE ‘XFCN’ 1010‘Letsgo’ ;----------------Includes-------------- INCLUDE Traps.D ;--------------Equates-------------------- ;booleans badsubnameEQU 70 ;stack frame numericSizeResultEQU -2 errorFlagsEQU numericSizeResult-4 FortranHeapPtr EQU errorFlags-4 stackframeEQU FortranHeapPtr-4 ;XCmdBlock XCmdBlock EQU 8 paramCountEQU 0 params EQU paramCount+2 returnValue EQU params+64 passFlagEQU returnValue+4 entryPointEQU passFlag+2 request EQU entrypoint+4 result EQU request+2 inArgs EQU result+2 outArgs EQU inArgs+32 ;mnemonics for some of the args in the XCmdBlock nameruntimeEQU params ;handle to first arg sizeResultEQU nameruntime+4;handle to second arg nameroutineEQU sizeResult+4 ;handle to third arg arg16 EQU nameroutine+52;handle to 16th arg Letsgo: ;DC.W $A9FF ;gee, how did this get here LINK A6,#stackframe MOVEM.LA0-A4/D0-D7,-(A7) ;save the world ;-disable initmenus, etc. in runtime library startup ;Modify the first instruction in init.asm from ;MOVEQ #0,D7 to MOVEQ #1,D7. Have to do this up ;here because instruction prefetching screws ;this boy up if he’s right before the ;instruction to be modified! LEA modify,A0 ;load address of the MOVEQ MOVE.W #$7e01,(A0) ;change it ;--create an error message in a zero-terminated---- ;--string in a handle and check that we got------ ;----------enough arguments from Hyper-------------- MOVE.L #2,D0 _NewHandle ;get a handle for an ;error message ;if we get an error here, we’ll bomb if we try ;to cope with it, so the hell with it--there ;shouldn’t be one! MOVE.L (A0),A1 ;deref the handle MOVE.W #0,(A1) ;make the handle point to ;a null string ;put errorhandle in returnValue of XCmdBlock to ;give a polite exit if there aren’t >=3 args. MOVE.L XCmdBlock(A6),A2 ;retrieve pointer for XCmdBlock MOVE.L A0,returnValue(A2);put errorhandle in returnValue ;get number of args MOVE.W paramCount(A2),D3;move number of args to D3 CMPI.W #3,D3 ;exit if there are fewer than 3 args BLT badnumargs ;retrieve errorhandle and substitute 3rd arg in ;returnValue MOVE.L returnValue(A2),A0 MOVE.L params+8(A2),returnValue(A2) ;trash errorhandle _DisposHandle BNE error1 ;------------ lock args 4 - 16 ------------------ ;pull args from XCmdBlock, move high and lock SUBQ.W #3,D3 ;don’t lock first 3 args BEQ.S endlock SUBQ.W #1,D3 ;prepare numargs for dbra MOVE.L #12,D4 ;load offset for arg4 loop1: MOVE.L params(A2,D4),A0 ;get arg, move it high & lock it MOVE.L A0,-(A7) _MoveHHi CMPI.W #0,D0 BLT error2 MOVE.L params(A2,D4),A0 _HLock BNE error3 ADDQ.W #4,D4 ;increment arg offset DBRA D3, loop1 endlock: ;--set flag for init.asm’s handling of different-- ;--runtime libraries and disable initialization---- ;------of MacFortran’s default window-------------- CLR.L D5 MOVE.L nameruntime(A2),A0;get handle to runtime ;libray name code MOVE.L (A0),A0 ;get ptr to name code MOVE.B (A0)+,D5 ;get first char of runtime name CMPI.B #’-’,D5 ;see if no window flag is set BNE.S havewindow MOVE.L #$FFFF0000,D5 ;set highword of D5 to ;instruct init.asm to not ;use default window MOVE.B (A0),D5 ;get second char of runtime name havewindow: SUBI.B #49,D5 ;convert to numeric ;Init.asm wants RuntimeArg to be 0, 1, or 2. ;But if the user passes us “-0”, Hyper strips ;the leading “-” if there are no quotation ;marks. Thus have user load RuntimeArg as ;1, 2, or 3, not 0, 1, or 2. BMI badRuntimeArg;it’s bad if runtime name code < |1| CMPI.B #2,D5 BHI badRuntimeArg;it’s bad if runtime name code > |3| ;--convert sizeResult set by user to numeric so can- ;--------allocate result storage------------------ MOVE.L sizeResult(A2),A1;get handle to sizeResult MOVE.L (A1),A1 ;deref it JSR arglength;pass arg in A1, ;returns length in D1 MOVE.L D1,D3 SUBQ.W #1,D3 ;subtract 1 for tailing nil BEQ badResultSizeArg;sizeResult has to ;have at least one char ;convert sizeResult to numeric, check that all ;chars are numeric SUBQ.W #1,D3 ;D3 is number of chars, prep for dbra MOVEQ.L#1,D2 ;D2 is multiplier for ;position of char in number CLR.L D1;D1 will be numeric form of ResultSize SUBQ.W #1,A1 ;back off of end of string loop3: CLR.L D0;we multiply by large #s, clr first MOVE.B -(A1),D0 ;get rightmost char in string SUBI.B #48,D0 ;convert to numeric BMI badResultSizeArg;ascii code of ;char < 48 (ascii 0 = 48) CMPI.B #9,D0 ;all chars have to be numbers BGT badResultSizeArg;ascii code of ;char > 57 (ascii 9 = 57) MULU D2,D0 ;second char gets ;multiplied by 10, 3rd by 100, etc MULU #10,D2;increment D2 ADD.L D0,D1 ;compute size of FunctionResult DBRA D3, loop3 ;store numeric form of sizeResult for use in ;fortran calling proc (.WILLGO) MOVE.W D1,numericSizeResult(A6) ;--------allocate handle to store function-------- ;----------result and pass back to hyper---------- MOVE.L D1,D3 ;save length in non-trashable reg MOVE.L D1,D0 ;prepare for NewHandle ADDQ.L #1,D0 ;have to add trailing 0 CMPI.L #$8000,D0 BGE resultSizeGT32k ;Hyper restricted to 32k containers _NewHandle BNE couldnotAllocateResultSize MOVE.L A0,A2 ;save in non-trashable reg _MoveHHi BNE error4 MOVE.L A2,A0 _HLock BNE error5 MOVE.L XCmdBlock(A6),A3 MOVE.L A2,returnValue(A3);put in returnValue of XCmdBlock ;put spaces in handle so it will be a valid character variable MOVE.L (A2),A2 ;deref returnValue SUBQ.W#1,D3 ;want to put nil in last byte clrloop: MOVE.B #32,(A2)+ DBRA D3,clrloop MOVE.B #0,(A2)+ ;make it a valid hyper container ;--call a modified version of an assembled-------- ;--------fortran main program---------------------- CLR.L FortranHeapPtr(A6);this will be filled if ;got to .WILLGO CLR.L D4;set flag that couldn’t ;allocate heap. ;Init.asm will fill this ;reg if it does succeed ;in allocating the heap CLR.L errorFlags(A6) ;we’ll fill this in ;.WILLGO if function name ;has bad chars in it MOVE.L A6,-(A7) ;save A6 JSR .START MOVE.L (A7)+,A6 ;restore A6 MOVE.L FortranHeapPtr(A6),D5;find out if got heap ;and runtime BNE.S trashheap CMPI.L #0,D4 ;check that could allocaate heap BEQ noHeapAlloc;if heapPtr = 0 & D4 = 0 BRA noRuntimeLib ;if heapPtr = 0 & D4 ne 0 ;--trash fortran heap gook (traverse a linked list)- trashheap: MOVE.L -8(A0),D3;ptr to first ;non-relocatable block BEQ.S endgook ;fortran has put on heap moregook: MOVE.L D3,A0 MOVE.L (A0),D3 ;ptr to next ;non-relocatable block _DisposPtr BNE error6a ;problems trashing gook TST.L D3 BNE.S moregook endgook: MOVE.L D5,A0 _DisposPtr ;trash fortran heap BNE error6 ;problems trashing it CMPI.W #badsubname,errorFlags(A6) BEQ badSubroutineName ;--------cleanup & exit---------------------------- BSR unlockArgHandles BSR unlockResultHandle dondon: MOVEM.L(A7)+,A0-A4/D0-D7;restore the world UNLK A6 MOVE.L (A7)+,(A7) RTS ;------------error handling---------------------- error1 LEA serror1,A0 BRA errs error2 LEA serror2,A0 BRA errs error3 LEA serror3,A0 BRA errs error4 LEA serror4,A0 BRA.S errs error5 LEA serror5,A0 BRA.S errs error6 LEA serror6,A0 BRA.S errs error6a LEA serror6a,A0 BRA.S errs error7 LEA serror7,A0 BRA.S errs error8 LEA serror8,A0 BRA.S errs badNumArgs;there are fewer than 3 args LEA sbadNumArgs,A0 BRA.S errs badRuntimeArg ;has to equal 1, 2, or 3 BSR unlockArgHandles LEA sbadRuntimeArg,A0 BRA.S errs badResultSizeArg ;arg for FunctionResultSize was bad BSR unlockArgHandles LEA sbadResultSizeArg,A0 BRA.S errs resultSizeGT32k BSR unlockArgHandles LEA sresultSizeGT32k,A0 BRA.S errs couldnotAllocateResultSize BSR unlockArgHandles LEA scouldnotAllocateResultSize,A0 BRA.S errs noHeapAlloc BSR unlockArgHandles BSR unlockResultHandle LEA snoHeapAlloc,A0 BRA.S errs noRuntimeLib BSR unlockArgHandles BSR unlockResultHandle LEA snoRuntimeLib,A0 BRA.S errs badSubroutineName BSR unlockArgHandles BSR unlockResultHandle LEA sbadSubroutineName,A0 BRA errs ;----code to have HyperCard’s callback routine---- ;----------put up the Answer Dialog---------------- errs: MOVEA.LXCmdBlock(A6),A1 ;retrieve pointer for XCmdBlock MOVE.L A0,inArgs(A1);load the answer string’s address MOVE.W #1,request(A1) ;request the Answer dialog box BSR.S callHyper;heh, it works! BRA.S dondon ;get out of here ;------subroutine to do a HyperCard call back---- callHyper: MOVE.L entryPoint(A1),A0 ;load the entry point to Hyper JMP (A0);go to Hyper -- thanks Andy ;----------------error strings-------------------- STRING_FORMAT 2 ;add leading length byte ;to LEAd string serror1 DC.B‘answer “Letsgo error #1, you’’d better reboot now”’,0 .ALIGN 2 ;hyper wants word-aligned strings serror2 DC.B‘answer “Letsgo error #2, you’’d better reboot now”’,0 .ALIGN 2 serror3 DC.B ‘answer “Letsgo error #3, you’’d better reboot now”’,0 .ALIGN 2 serror4 DC.B ‘answer “Letsgo error #4, you’’d better reboot now”’,0 .ALIGN 2 serror5 DC.B ‘answer “Letsgo error #5, you’’d better reboot now”’,0 .ALIGN 2 serror6 DC.B ‘answer “Letsgo error #6, you’’d better reboot now”’,0 .ALIGN 2 serror6a DC.B ‘answer “Letsgo error #6a, you’’d better reboot now”’,0 .ALIGN 2 serror7 DC.B ‘answer “Letsgo error #7, you’’d better reboot now”’,0 .ALIGN 2 serror8 DC.B‘answer “Letsgo error #8, you’’d better reboot now”’,0 .ALIGN 2 sbadNumArgs DC.B ‘answer “Letsgo takes at least 3 args.”’,0 .ALIGN 2 sbadRuntimeArg DC.B‘answer “Letsgo’’s 1st argument has to be 1, 2, or 3.”’,0 .ALIGN 2 sbadResultSizeArg DC.B ‘answer “Letsgo’’s 2nd argument has to be numeric.”’,0 .ALIGN 2 sresultSizeGT32k DC.B ‘answer “Letsgo’’s result has to be < 32 k.”’,0 .ALIGN 2 scouldnotAllocateResultSize DC.B ‘answer “Letsgo out of memory - Result size too big.”’,0 .ALIGN 2 snoHeapAllocDC.B ‘answer “Letsgo out of memory - couldn’’t load Fortran.”’,0 .ALIGN 2 snoRuntimeLib DC.B‘answer “Letsgo couldn’’t find Fortran’’s runtime library.”’,0 .ALIGN 2 sbadSubroutineName DC.B ‘answer “Bad chars in function name passed to Letsgo.”’,0 .ALIGN 2 DC.B ‘Copyright 1988 by Fred Hebard’ .ALIGN 2 STRING_FORMAT 0 ;restore original for ;fortran’s init.asm ;----Subroutine to count number of chars in arg---- arglength: ;arg ptr in A1, return num chars in D1 CLR.LD1;D1 is number of chars charct: MOVE.B (A1)+,D0 ADDQ.W #1,D1 CMPI.B #0,D0 BNE.S charct ;exit when hit end of string RTS ;------Subroutine to unlock handles passed---------- ;-------- from hyper prior to exit------------------ unlockArgHandles: MOVE.L XCmdBlock(A6),A2 ;retrieve pointer for XCmdBlock CLR.L D3 MOVE.W paramcount(A2),D3 SUBQ.W #3,D3 ;1st 3 handles are not locked BEQ.S endunlock SUBQ.W #1,D3 ;prepare numargs for dbra MOVE.L #12,D4 ;prepare offset to handles of other args loop4: MOVE.L params(A2,D4),A0 ;get arg _HUnLock BNE error7 ADDQ.W #4,D4 ;increment offset DBRA D3, loop4 endunlock: RTS ;----Subroutine to unlock the handle of------------ ;--------the result being passed to hyper---------- unlockResultHandle: MOVE.L XCmdBlock(A6),A2 ;retrieve pointer for ;XCmdBlock MOVE.L returnValue(A2),A0 _HUnLock BNE error8 RTS ;------Subroutine to startup Fortran & call a------ ;----------character function---------------------- ;------A modified assembled Fortran main program---- ;stack frame string EQU -6 ;character form of name ;of function to be called rad50 EQU string-4 ;rad50 form (integer) of ;function to be called amtDecrementedStackEQU rad50-4 ;know how ;much to increment stack on return sframe EQU amtDecrementedStack originalA6EQU 8 ;4 for return address, ;4 for link A6 .ALIGN 4 ;init.asm seems to want this .START: LEA .START(PC),A1 ADDA.L #.WILLGO-.START,A1 modify ;Disable initmngrs here INCLUDE INIT.ASM ;will startup fortran then return here XDEF .WILLGO .WILLGO: MOVE.L #L00001-L00002,D1 L00002: LEA L00002(PC,D1.L),A1;?they trash A1 below LINK A6,#sframe MOVEA.L A7,A3 ;let A3 point to current stack MOVE.L #0,54(A0) ;? tell comunications area something. Probably ;thatwe’re a main program MOVE.L originalA6(A6),A2;get A6 from main so can use mnemonics MOVE.L A4,FortranHeapPtr(A2);A4 has ptr to heap, ;we’ll need to trash it in the main program ; program willgo ;------strip leading blanks from name passed from-- ;--------Hyper & pad right side with spaces-------- ; string = ‘ ‘ LEA string(A6),A1 MOVE.B #32,(A1)+ MOVE.B #32,(A1)+ MOVE.B #32,(A1)+ MOVE.B #32,(A1)+ MOVE.B #32,(A1)+ MOVE.B #32,(A1)+ ; string = file name passed from hyper MOVE.L XCmdBlock(A2),A3 MOVE.L nameroutine(A3),A1;get name handle MOVE.L (A1),A1 ;deref LEA string(A6),A3 strip: CMPI.B #32,(A1) BNE.S subname ;strip leading blanks ADDA.W #1,A1 CMPI.B #0,(A1) ;better not hit end of ;string with all BNE.S strip ;blank chars! MOVE.W #badsubname,errorflags(A2) JMP 20(A4);we’re outta here! MOVEQ.L#5,D2 ;prepare to dbra, only move 6 bytes subname: MOVE.B (A1)+,(A3)+;move 1 CMPI.B #0,(A1) BEQ.S endsubname ;exit when hit end of ;subroutine name DBRA D2, subname;loop if D2 >= 0 endsubname: MOVE.L A7,A3;restore A3 - don’t know why Fortran does this ; call rad50(string,rad50) MOVE.L A5,-(A7) ;save only A5 on entry to local proc SUBQ.W #4,A7;make room for lengths (word) of two args PEA string(A6);push first arg MOVE.W #6,4(A7) ;move length word since ;it’s a char variable PEA rad50(A6) ;push second arg MOVE.L #.RAD50-L00003,D1;put offset in D1 L00003: JSR L00003(PC,D1.L) ;jsr to rad50 ADDA.W #12,A7 ;=numargs*6, clr loaded args MOVEA.L (A7)+,A5 ;restore A5 MOVEA.L A7,A3;restore current stack to A3 ;--call sub(arg4-16, depending on number of args)-- MOVEM.L A0/A4/A5,-(A7);save critical regs ;for dynamically loaded routine ; get the number of args hyper has passed to us MOVE.L XCmdBlock(A2),A1 CLR.L D3 MOVE.W paramCount(A1),D3 ;move numargs to D3 SUBQ.W #3,D3 ;first 3 args don’t go to ;fortran function ; prepare stack for numargs + result arg, ; =6*(numargs+1) MOVE.L D3,D5 ADDQ.W #1,D5 ;make room for result too MULU #6,D5 MOVE.W D5,amtDecrementedStack(A6);store so can ;decrement stack at end SUBA.W D5,A7 ; offset of last arg from arg16(XCmdBlock) = ; -(16 - 3 - numargs)*4 MOVE.L D3,D5 ;move num args to D5 MOVE.L #13,D4 SUB.W D5,D4 MULU #4,D4 NEG.W D4;D4 will be offset of last arg from arg16 ; compute A7 offset of length of last arg. = ; (numargs+1)*6 - 2 MOVE.L D3,D6 ADDQ.W #1,D6 ;will be passing function result too MULU #6,D6 SUBQ.W #2,D6 ;store A7 length offset in D6 ; A7 offset of last arg pointer = 0 CLR.L D7;store A7 arg offset in D7 ; push function result and its length MOVE.L returnValue(A1),A1;get function result handle MOVE.L (A1),(A7,D7) ;push function result pointer MOVE.W numericSizeResult(A2),D1 SUBQ.W #1,D1 ;don’t let fortran see tailing 0 MOVE.W D1,(A7,D6) ;push function length ADDQ.W #4,D7 ;increment A7 arg offset SUBQ.W #2,D6 ;increment A7 length offset ; prepare an index for pushing dbra (loop6) & ; don’t push if only 3 args from hyper MOVE.L D3,D5 ;move num args BEQ endpushing;no args to subroutine SUBQ.W #1,D5 ;prepare D5 for dbra ; push args and their lengths MOVE.L XCmdBlock(A2),A2 loop6: MOVE.L arg16(A2,D4),A1 ;get arg handle MOVE.L (A1),A1 ;deref MOVE.L A1,(A7,D7) ;push arg pointer BSR arglength;A1 is pointer to arg. ;Returns length in D1 SUBQ.W #1,D1 ;don’t let Fortran see tailing 0 MOVE.W D1,(A7,D6) ;push length ADDQ.W #4,D7 ;prepare A7 arg offset for next loop SUBQ.W #2,D6 ;prepare A7 length offset for next loop SUBQ.W #4,D4 ;prepare offset from arg16(XCmdBlock) for ;next loop DBRA D5, loop6 endpushing ; blastoff! MOVE.L D3,D0;move # args to D0 MOVE.L rad50(A6),D1;move rad50(subroutine name) to D1 JSR 4(A4) MOVE.W amtDecrementedStack(A6),D1 ADDA.W D1,A7 ;clr stack ((#args+resultArg) * 6) MOVEM.L (A7)+,A0/A4/A5 ;restore regs MOVEA.L A7,A3 ;let A3 point to stack ; stop JMP 20(A4) ; end JMP 20(A4) L00001: DC.W 0 DC.W 0 ;----modified RAD50 subroutine, on---- ;------error, sets errorFlag---------- ; subroutine RAD50 (string,rad50) .RAD50: MOVE.L #L00004-L00005,D1 L00005: LEA L00005(PC,D1.L),A1 LINK A6,#-24 MOVEA.L A7,A3 ; rad50(0)=0; rad50(1)=0 MOVEA.L 8(A6),A1 CLR.W (A1) CLR.W 2(A1) ; do (i=1,6) MOVE.L #1,8(A3) MOVEQ #5,D6 L00006: ; select case (string(i)) MOVE.L 8(A3),D4 MOVEA.L 12(A6),A1 MOVEQ #1,D1 MOVE.L D1,D5 MOVE.B -1(A1,D4.L),-(A5) PEA L00010(PC) MOVEQ #2,D4 BSR.S L00012 DC.B 65,32 L00012: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BGT.S L00011 BSR.S L00013 DC.B 90,32 L00013: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BLT.S L00011 RTS L00011: ADDQ.L #2,D4 BSR.S L00015 DC.B 97,32 L00015: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BGT.S L00014 BSR.S L00016 DC.B 122,32 L00016: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BLT.S L00014 RTS L00014: ADDQ.L #2,D4 BSR.S L00018 DC.B 48,32 L00018: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BGT.S L00017 BSR.S L00019 DC.B 57,32 L00019: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BLT.S L00017 RTS L00017: ADDQ.L #2,D4 BSR.S L00021 DC.B 32,32 L00021: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BNE.S L00020 RTS L00020: ADDQ.L #2,D4 BSR.S L00023 DC.B 46,32 L00023: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BNE.S L00022 RTS L00022: ADDQ.L #2,D4 BSR.S L00025 DC.B 36,32 L00025: MOVEA.L (A7)+,A1 MOVEQ #2,D1 JSR 368(A4) BNE.S L00024 RTS L00024: ADDQ.W #4,A7 CLR.L D4 L00010: ADDA.L D5,A5 LEA L00027(PC,D4.L),A1 ADDA.W (A1),A1 JMP (A1) L00027: DC.W L00028-L00027 L00030: DC.W L00031-L00030 L00032: DC.W L00033-L00032 L00034: DC.W L00035-L00034 L00036: DC.W L00037-L00036 L00038: DC.W L00039-L00038 L00040: DC.W L00041-L00040 ; case (“A”:”Z”) L00031: ; l = 64 MOVE.L #64,20(A3) ; case (“a”:”z”) BRA.S L00029 L00033: ; l = 96 MOVE.L #96,20(A3) ; case (“0”:”9") BRA.S L00029 L00035: ; l = 18 MOVE.L #18,20(A3) ; case (“ “) BRA.S L00029 L00037: ; l = 32 MOVE.L #32,20(A3) ; case (“.”) BRA.S L00029 L00039: ; l = 18 MOVE.L #18,20(A3) ; case (“$”) BRA.S L00029 L00041: ; l = 9 MOVE.L #9,20(A3) ; case default BRA.S L00029 L00028: ; write (9,101) string(i) ;!console window not open ;have to use hyper to tell user MOVE.W #badsubname,errorflags(A2) ; stop JMP 20(A4) ; end select BRA.S L00029 MOVEQ #79,D1 JSR 16(A4) L00029: ; j = (i-1)/3 MOVE.L 8(A3),D0 SUBQ.L #1,D0 MOVEQ #3,D1 JSR 68(A4) MOVE.L D0,12(A3) ; k = RADIX**mod(6-i,3) MOVEQ #40,D0 MOVE.L D0,-(A7) MOVEQ #6,D0 SUB.L 8(A3),D0 MOVE.L D0,-(A7) MOVEQ #3,D0 MOVE.L D0,D1 MOVE.L (A7),D0 JSR 68(A4) JSR 64(A4) NEG.L D0 ADD.L (A7)+,D0 MOVE.L D0,D1 MOVE.L (A7)+,D0 JSR 148(A4) MOVE.L D0,16(A3) ; rad50(j) = rad50(j) + ;(ichar(string(i))-l)*k MOVE.L 12(A3),D4 ADD.L D4,D4 MOVEA.L 8(A6),A1 PEA 0(A1,D4.L) MOVE.L 8(A3),D4 MOVEA.L 12(A6),A1 MOVEQ #1,D1 MOVE.L D1,D5 MOVE.B -1(A1,D4.L),-(A5) MOVEQ #0,D0 MOVE.B (A5),D0 ADDA.L D1,A5 SUB.L D1,D5 SUB.L 20(A3),D0 MOVE.L 16(A3),D1 JSR 64(A4) MOVE.L 12(A3),D4 ADD.L D4,D4 MOVEA.L 8(A6),A1 MOVE.W 0(A1,D4.L),D1 EXT.L D1 ADD.L D1,D0 MOVEA.L (A7)+,A1 MOVE.W D0,(A1) ; repeat L00007: ADDQ.L #1,8(A3) L00008: SUBQ.L #1,D6 BGE.W L00006 L00009: ; return UNLK A6 RTS L00044: ; end UNLK A6 RTS L00004: DC.W 0 DC.W 0 END ;------------linker file-------------- /output :Some Glue for Fortran:Source Code:Test /type ‘????’ ‘????’ /Resources :Some Glue for Fortran:Source Code:letsgo.Rel $ ;------------exec job file------------ asmletsgo.asm execedit link letsgo.link Hard Disk:Utilities:ResEdit edit
- SPREAD THE WORD:
- Slashdot
- Digg
- Del.icio.us
- Newsvine