Related Info: Memory Manager Segment Loader

Some Glue for FORTRAN

By Frederick V. Hebard, Meadowview, VA

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