     TTL frontend
;                  update history
; 11/06/2018      version 2.13  loads debugAIF files
; 04/04/2018      version 2.12  will only load once
; 29/08/2017      version 2.10  for 32-bit compiler from ROOL
;                 compiler space upped from 320 to 640K
;                 compiler renamed 'f77' from 'nfc'
; 12/7/2011       version 2.09 convert to 32-bit code
;                new labels are of type x_1,  x_2 etc
;         version 2.08
; 29/11/97 redraw    set minimum y to 77*40 = 3080 (+8) for file windows
; 23/03/03 force option "-apcs /32" in nfc
; 05/11/17 remove option "-apcs /32" in nfc
; 24/03/03 set to use libraries of 32-bit compatible code
;         OPT   2
     GBLS version
version SETS "(2.13 11 Jun 2018)" ; set the version display in "info"
debugon EQU 0 ; set to 1 to include debug routines
NoDebug EQU 0 ; set to 1 to disallow the Debug compiler option
warnoff EQU 1 ; set to 0 to reinstate "Dubious i/o keyword" warning
;
;        options
Verbo    EQU   &00010000
LMap     EQU   &00020000
LXref    EQU   &00040000
UndfX    EQU   &00080000
NlinkOpt EQU   4      ;# link options
LinkOff  EQU   16     ;offset to link options
Ctypes   EQU   &00000001   ;1
CVMSIO   EQU   &00000002   ;2
Nowrn    EQU   &00000004   ;3
Uvars    EQU   &00000008   ;4
Chkdt    EQU   &00000010
INCLUDE  EQU   &00000020   ;6
IBool    EQU   &00000040   ;7
Recurs   EQU   &00000080   ;8
Thrbk    EQU   &00000100   ;9
Holler   EQU   &00000200   ;10
WHILE    EQU   &00000400   ;11
F66      EQU   &00000800   ;12
MixCOM   EQU   &00001000   ;13
VMScom   EQU   &00002000   ;14?
Convers  EQU   &00004000   ;15
Debug    EQU   &00008000   ;16
StatMem  EQU   &00100000   ;21
INTEGER2 EQU   &00200000   ;22
Real8    EQU   &00400000   ;23
NoIMPLI  EQU   &00800000   ;24
BoundsCk EQU   &01000000   ;25
LongLine EQU   &04000000   ;27
Unix     EQU   &08000000
List     EQU   &10000000
Asm      EQU   &20000000
Warnings EQU   &000056AB   ; all no-warnings except Nowrn
StdOpt   EQU   &8DF07EE3   ;mask for all standard nfc options
NcompOpt EQU   12
Mvisfile EQU   5           ;max #visible files in files window
pc   RN  15
lr   RN  14
sp   RN  13
R12  RN  12
R11  RN  11
R10  RN  10
R9   RN  9
R8   RN  8
R7   RN  7
R6   RN  6
R5   RN  5
R4   RN  4
R3   RN  3
R2   RN  2
R1   RN  1
R0   RN  0
;
DDEUtils_ThrowbackStart EQU &42587
DDEUtils_ThrowbackSend  EQU &42588
DDEUtils_ThrowbackEnd   EQU &42589
Hourglass_Off           EQU &406C2
Hourglass_On            EQU &406C0
MessageTrans_FileInfo   EQU &61500
MessageTrans_OpenFile   EQU &41501
MessageTrans_Lookup     EQU &61502
OS_BGet                 EQU &0A
OS_BPut                 EQU &0B
XOS_BPut                EQU &2000B
OS_Byte                 EQU &06
OS_CLI                  EQU &05
OS_ConvertCardinal4     EQU &D8
OS_ChangeEnvironment    EQU &40
OS_Exit                 EQU &11
OS_File                 EQU &08
XOS_File                EQU &20008
OS_Find                 EQU &0D
OS_FSControl            EQU &29
OS_GBPB                 EQU &0C
XOS_Module              EQU &2001E
OS_Plot                 EQU &45
OS_ReadVarVal           EQU &23
OS_ReadModeVariable     EQU &35
OS_Write0               EQU &02
OS_WriteN               EQU &46
TaskManager_EnumerateTasks  EQU &42681
Wimp_Initialise         EQU &400C0
Wimp_CloseDown          EQU &400DD
Wimp_CloseTemplate      EQU &400DA
Wimp_CloseWindow        EQU &400C6
Wimp_CreateIcon         EQU &400C2
Wimp_CreateMenu         EQU &400D4
Wimp_CreateWindow       EQU &400C1
Wimp_DeleteWindow       EQU &400C3
Wimp_ForceRedraw        EQU &400D1
Wimp_DeleteIcon         EQU &400C4
Wimp_GetIconState       EQU &400CE
Wimp_GetPointerInfo     EQU &400CF
Wimp_GetRectangle       EQU &400CA
Wimp_GetWindowInfo      EQU &400CC
Wimp_GetWindowState     EQU &400CB
Wimp_LoadTemplate       EQU &400DB
Wimp_OpenTemplate       EQU &400D9
Wimp_OpenWindow         EQU &400C5
Wimp_Poll               EQU &400C7
Wimp_ProcessKey         EQU &400DC
Wimp_RedrawWindow       EQU &400C8
Wimp_ReportError        EQU &400DF
Wimp_SendMessage        EQU &400E7
Wimp_SetCaretPosition   EQU &400D2
Wimp_SetColour          EQU &400E6
Wimp_SetExtent          EQU &400D7
Wimp_SetIconState       EQU &400CD
Wimp_SlotSize           EQU &400EC
Wimp_StartTask          EQU &400DE
Wimp_UpdateWindow       EQU &400C9
;
cs     EQU   640*1024     ;compiler size
ls     EQU   640*1024     ;linker size
offset EQU   256          ;offset to clean block area
     AREA  FDE_Code,CODE,READONLY
;
     ENTRY
start
     LDR   R1,locb
     BL    init         ;initialise wimp & windows
mainloop;     main Wimp_poll loop
     LDR   R1,locb
     MOV   R0,#&31      ;poll mask
     BL    poll
     B     mainloop
locb DCD   blks
;
addnam; add file at R9 to list R10
     STMFD sp!,{R0-R9,lr}
     BL    search           ;go look for name in list
     LDMEQFD sp!,{R0-R9,pc} ;return if found
;           R9 now address of word containing file count
     LDR   R7,[R9]
     ADD   R7,R7,#1
     CMP   R10,#3
     CMPGT R7,#1
     LDMGTFD sp!,{R0-R9,pc} ;return if already run file
     STR   R7,[R9]          ;store new number of files
     CMP   R10,#3           ;check if lib
     ORREQ R4,R4,R12,LSL#24 ;add link option icon # to the icon name
     ADDLE R8,R1,#24        ;pointer to icon name in block
     ADRGT R8,Aif           ;or indirected Aif file name
     STMIA R8,{R2-R4}       ;store new file name in icon
     BLE   x_01             ;not run file
     ADR   R5,RunOp
     STMIA R5,{R2-R4}       ;store in Run Options
     MOV R2,#10             ;icon to restore   
     BL    setnote          ;restore icon
     B     an1              ;return if aif
;       set up new icon in fortran or object list
x_01 MOV   R2,#0            ;min x
     ADD   R3,R7,R7,LSL#2
     MOV   R3,R3,LSL#3
     RSB   R3,R3,#0         ;min y = -40*(entry number)
     ADD   R4,R2,#192       ;max x
     ADD   R5,R3,#40        ;max y
     LDR   R6,=&C7003031    ;icon flags
     STMIB R1,{R2-R6}
     SWI   Wimp_CreateIcon
     BL    fnamsize         ;go set file name window size
     BL    topopen
an1  CMP   R7,#1
     LDREQ R0,wT
     BLEQ  redraw           ;first file, so redraw top window
     LDMFD sp!,{R0-R9,pc}   ;return
     LTORG
;
checkdates; if doing normal compilation to make object file, check dates
;           of .f against .o files in Name+4
;           result EQ if check not done
;                  HI if object file newer
;                  LO if source newer
     STMFD sp!,{R0-R8,lr}
     LDR   R8,Opt       ;get options
     TST   R8,#Chkdt    ;test for "check dates" option
     CMPEQ R8,R8        ;set carry bit so not 'LO'
     LDMEQFD sp!,{R0-R8,pc};not selected, so return EQ
     ADR   R1,Name+4    ;pointer to name
     MOV   R0,#13       ;path pointed to by R4
     ADR   R4,fpath
     SWI   OS_File      ;get attributes
     CMP   R0,#0
     LDMEQFD sp!,{R0-R8,pc};not found, return EQ
     AND   R6,R2,#&FF   ;save ls byte of "load address"
     MOV   R7,R3        ;save "execution address"
     SUB   R1,R1,#2     ;pointer to o.<name> or s.<name>
     MOV   R0,#17       ;no path
     SWI   OS_File      ;get attributes
     CMP   R0,#0
     LDMEQFD sp!,{R0-R8,pc};not found, return EQ (CS)
     AND   R2,R2,#&FF   ;ms byte of .o. time
     CMP   R2,R6
     CMPEQ R3,R7
     LDMFD sp!,{R0-R8,pc};return appropriate sign
fpath  DCB "f.",0,0
;
click;    mouse click received
     LDMIB R1,{R9-R12} ;y,buttons,window,icon
     CMP   R11,#-2
     BEQ   mclick      ;window -2 -> icon bar
     ADR   R0,wF
     LDMIA R0,{R2-R8}  ;wF,wL,wR,wFfl,wOfl,wLfl,wT
     CMP   R11,R8
     BEQ   clickwT     ;main window
     CMP   R12,#0
     TSTGE R10,#2
     LDMNEFD sp!,{R0,R1,pc} ;return to wimp poll if menu or not over icon
     CMP   R11,R7      ;check for library list
     CMPEQ R10,#1      ;.and. 'adjust'
     BNE   x_11
     STMIA R1,{R11,R12}
     SWI   Wimp_GetIconState
     LDRB  R12,[R1,#39];get link options icon#
     MOV   R11,R3      ;pretend it is the link options window
x_11 CMP   R11,R2
     BEQ   clickwF     ;fortran options
     CMP   R11,R3
     BEQ   clickwL     ;link options
     CMP   R11,R5
     MOVEQ R0,#1       ;Fortran list
     CMP   R11,R6
     MOVEQ R0,#2       ;Object list
     CMP   R11,R7
     MOVEQ R0,#3       ;Library list
     CMP   R0,#4
     LDMCSFD sp!,{R0,R1,pc};return to wimp poll if not over known window
;         over file list R0
     TST   R10,#4      ;test for 'select'
     MOV   R10,R0      ;set list #
     ADD   R11,R12,#1  ;file #
     BNE   x_23
     BL    delnam      ;delete name if 'adjust'
     LDMFD sp!,{R0,R1,pc};return to wimp poll
x_23 BL    movnam      ;move name if 'select'
     LDMFD sp!,{R0,R1,pc};return to wimp poll
;
clickwF;  click over fortran options window (part of click)
     LDR   R4,Opt        ;get option word
     SUB   R12,R12,#1    ;correct icon number to option bit
     MOV   R2,R4,LSR R12
     AND   R2,R2,#1      ;get option bit
     AND   R0,R10,#1     ;get 'adjust' bit
     CMP   R0,R2
     LDMNEFD sp!,{R0,R1,pc};return if no change
     CMP   R12,#29        ;check for asm
     BNE   cF1
     LDR   R0,Act
     TST   R0,#&FF00     ;check if linking
     LDRNE R0,nlk1
     BLNE  problem
     LDMLTFD sp!,{R0,R1,pc} ;return to wimp poll      
cF1  CMP   R10,#1
     BL    optset        ;change state
     BL    testact       ;check state
     CMP   R10,#1
     LDMEQFD sp!,{R0,R1,pc} ;return to wimp poll if not 'select'
     LDR   R3,wmask
     MOV   R5,#1
     TST   R3,R5,LSL R12
     TSTNE R4,#Nowrn
     MOVNE R12,#2
     BEQ   x_02
     BL    noptset      ;clear 'All' no-warnings option
     LDMFD sp!,{R0,R1,pc}  ;done if not 'All
x_02 CMP   R12,#2
     LDMNEFD sp!,{R0,R1,pc}  ;done if not 'All'
     AND   R4,R4,R3     ;mask of standard 'no-warnings' set
     MOV   R12,#0
cF2  TST   R4,#1
     BLNE  noptset      ;clear standard 'no-warnings'
     ADD   R12,R12,#1
     MOVS  R4,R4,LSR#1
     BNE   cF2          ;loop over set 'no-warnings' options
     LDMFD sp!,{R0,R1,pc}    ;done
nlk1 DCB   "nlk",1
wmask DCD  Warnings     ;mask of standard warnings options
;
clickwL;  click over link options window
     TST   R10,#2
     LDMNEFD sp!,{R0,R1,pc} ;return if 'menu'
     RSBS  R0,R12,#NlinkOpt ;if link option
     ADDGE R12,R12,#LinkOff ;correct for link options offset
     CMPGE R10,#1
     BLT   x_03
     BL    optset           ;set the option
     LDMFD sp!,{R0,R1,pc}   ;and return
x_03 SUB   R3,R12,#NlinkOpt ;library #
     STMIA R1,{R11,R12}
     SWI   Wimp_GetIconState
     LDR   R0,Blk+24
     TST   R0,#&200000      ;test set bit
     ADD   R9,R1,#28        ;pointer to name (not destroyed by iconset)
     BNE   libdl
     CMP   R10,#1           ;test for 'select'
     LDMEQFD sp!,{R0,R1,pc}  ;return
     BL    iconset          ;set icon
     MOV   R10,#3           ;for library list
     BL    addnam           ;set up icon etc.
     LDMFD sp!,{R0,R1,pc}   ;return
libdl CMP  R10,#1           ;library used, test for 'adjust'
     LDMNEFD sp!,{R0,R1,pc} ;return if not 
     BL    iconset          ;clear icon
     MOV   R10,#3           ;for library list
     BL    search
     BEQ   x_12
     SWI   &107             ;ought to find it!
     LDMFD sp!,{R0,R1,pc}   ;return to wimp poll
x_12 LDR   R0,[R1,#4]       ;icon #
     ADD   R11,R0,#1        ;file#
     BL    delnam           ;delete name in files window
     LDMFD sp!,{R0,R1,pc}   ;return to wimp poll
;
clickwT;  click over main window
     CMP   R10,#2         ;check for menu button
     BNE   cnotm
     CMP   R12,#4
     LDMGTFD sp!,{R0,R1,pc}    ;return if not action icon
;         prepare to open options window
     CMP   R12,#3         ;check for 'squeeze' icon
     SUBGT R12,R12,#1     ;if 'run'
     LDRGTB R0,Act+3
     RSBGTS R0,R0,#0      ;check act(4) is TRUE
     LDMGEFD sp!,{R0,R1,pc}
     CMP   R12,#1
     LDMLTFD sp!,{R0,R1,pc}
     ADR   R0,wF-4
     LDR   R2,[R0,R12,LSL#2]!;window handle
     STR   R2,Blk
     SWI   Wimp_GetWindowState
     MOV   R0,#-1
     STR   R0,Blk+28
     CMP   R12,#2         ;check for link options
     LDREQ R0,Mlib        ;total # libraries
     ADDEQ R0,R0,#1
     MOVEQ R0,R0,LSR#1    ;#libraries/2
     ADDEQ R0,R0,R0,LSL#1 ;multiply by 3
     LDREQ R2,[R1,#16]    ;y(top)
     SUBEQ R2,R2,R0,LSL#4 ;subtract 48*[#libraries/2]
     SUBEQ R2,R2,#208
     STREQ R2,[R1,#8]     ;new y(bottom)
     SWI   Wimp_OpenWindow;open options window on top
     LDMFD sp!,{R0,R1,pc}
cnotm;   select or adjust
     SUBS  R0,R10,#1      ;Set R0 FALSE if 'adjust'
     MOVNE R0,#-1         ;Set R0 TRUE if 'select'
     SUBS  R2,R12,#1
     LDMLTFD sp!,{R0,R1,pc};not over icon
     CMP   R12,#8         ;if over "Start"
     BNE   x_04
     BL    exec           ;go and do the works
     LDMFD sp!,{R0,R1,pc}
x_04 BGT   crun           ;over 'run' icon
     CMP   R12,#2
     LDREQ R3,Opt         ;if 'link'
     ANDEQ R3,R3,R0       ;'select'
     ANDEQ R3,R3,#Asm
     TEQ   R3,#Asm        ;and 'asm' selected
     LDREQ R0,nas2
     BLEQ  problem        ;complain
     LDMEQFD sp!,{R0,R1,pc}
     ADR   R3,Act
     STRB  R0,[R3,R2]     ;set Act
     BL    testact
     LDMFD sp!,{R0,R1,pc}
crun CMP   R0,#0          ;check for 'adjust' over run icon
     MOVEQ R11,#1
     MOVEQ R10,#4
     BLEQ  delnam         ;delete 'run' icon
     LDMFD sp!,{R0,R1,pc}
nas2 DCB   "nas",2
retcd1 DCB "Sys$$ReturnCode",0,0 ;4 words
;
comperr;  check for fortran error
     STMFD sp!,{R0-R8,lr}
     ADR   R0,retcd1
     MOV   R2,#20
     MOV   R3,#0
     MOV   R4,#0
     SWI   OS_ReadVarVal    ;get return code
     LDRB  R4,Blk
     CMP   R4,#"0"
     BEQ   compwarn         ;no error, check for warning
cc1  ADR   R0,Name
     ADD   R0,R0,#2
     BL    deldir           ;remove object file
     ADR   R0,dirs          ;pointer to o directory name
     TST   R11,#Asm
     ADDNE R0,R0,#2         ;or s directory name
     BL    deldir           ;delete directory
     TST   R11,#Thrbk       ;throwback
     BEQ   cc3
     BL    throwback
     B     cc2
cc3  CMP   R4,#"0"          ;test for error again
     LDRNE R0,cmp2
     BLNE  problem          ;N.B. returns EQ set 
cc2  ADR   R1,Name
     LDMIB R1,{R6-R8}
     ADD   R1,R1,#2         ;pointer to "e.<name>"
     MOV   R0,#"e"
     STRB  R0,[R1]
     MOV   R0,#18
     MOV   R2,#-1           ;file type &FFF
     SWI   XOS_File         ;set file type
     MOV   R0,R1            ;pointer to file name
     TST   R11,#Thrbk       ;throwback
     LDR   R1,[sp,#4]
     BLEQ  display          ;get SrcEdit to display error file
     ADR   R9,Name+4
     MOV   R10,#2
     BL    search
     LDMNEFD sp!,{R0-R8,pc} ;return NE if aof file not found
     ADD   R11,R0,#1
     BL    delnam
     LDR   R11,Opt          ;restore options to R11
     MOVS  R0,#1
     LDMFD sp!,{R0-R8,pc}   ;return NE if aof file not found
cmp2 DCB   "cer",2
dirs DCB "o",0,"s",0      ;object and source directories
;
compwarn; check for compilation warning (only a part of comperr)
     TST   R11,#Nowrn       ;check for "no warnings" option
     LDMNEFD sp!,{R0-R8,pc} ;return EQ if set
     MOV   R0,#&4D
     ADR   R1,Name+4
     ADR   R2,edire
     SWI   OS_Find          ;open the file "e.<name>"
     MOV   R1,R0
cw0  ADR   R0,warn
     BL    find             ;go look for warning
     [  warnoff=1           ; code to check for "Dubious i/o"
     BNE   cw3              ;"Warning:" not found
     MOV   R2,#20           ;count of characters
     ADR   R3,iowarn
cw1  SWI   OS_BGet          ;get character
     MOVCS R0,#-1
     LDRB  R4,[R3],#1
     CMP   R4,R0
     BNE   cw2              ;not the warning we are looking for
     SUBS  R2,R2,#1
     BGT   cw1
     B     cw0              ;go see if any more warnings
cw2  CMP   R0,R0            ;set EQ
cw3  
     ]                      ; end code to check for "Dubious i/o"
     MOV   R0,#0
     BEQ   cw4              ;warning found
     SWI   OS_Find          ;close file
     CMP   R0,R0
     LDMFD sp!,{R0-R8,pc}   ;return EQ if no warnings
cw4  SWI   OS_Find          ;close file
     LDR   R1,[sp,#4]       ;restore R1
     LDR   R0,cwn3
     BL    problem          ;send warnings message
     BEQ   cc1              ;return to "comperr" if failure
     SWI   Hourglass_On
     CMP   R0,R0
     LDMFD sp!,{R0-R8,pc}   ;return EQ if OK
cwn3 DCB   "cwn",3
edire DCB "e.",0,0
warn DCB "arning:",0
      [  warnoff=1
iowarn DCB " Dubious i/o keyword"; 20 characters
      ]
;
delall; delete all files in windows
     STMFD sp!,{R2-R4,R8,lr}
     ADR   R2,Nf77-4
     MOVS  R4,#2             ;window count
lda1 LDR   R3,[R2,#4]!       ;get # files
     LDR   R0,[R2,#wFfl-Nf77];file window handle
     STR   R0,Blk
     BEQ   lda3
lda2 SUBS  R3,R3,#1
     STRGE R3,Blk+4
     SWIGE Wimp_DeleteIcon   ;delete the icons
     CMP   R3,#0
     BGT   lda2
     STRGE R3,[R2]           ;set # files = 0
     SWI   Wimp_CloseWindow  ;and close the window (27/10/96)
     SUBS  R4,R4,#1
     ADDEQ R2,R2,#4          ;skip library window
     B     lda1              ;loop over windows
lda3 SUBS  R3,R3,#1  
     STRGE R3,[R2]           ;set # aif files = 0
     MOVGE R3,#10
     STRGE R3,Blk+4
     SWIGE Wimp_DeleteIcon   ;delete the icon
     BL    topopen
     LDMFD sp!,{R2-R4,R8,pc}
;
deldir; delete directory/file at R0
     STMFD sp!,{R0-R5,lr}
     MOV   R1,R0
     MOV   R0,#6
     SWI   XOS_File       ;delete the file
     LDMFD sp!,{R0-R5,pc}
;
delnam; delete file R11 (>0) in list R10
     STMFD sp!,{R0-R5,R8,lr}
     ADR   R5,Nf77-4
     LDR   R3,[R5,R10,LSL#2]!;get count in list
     CMP   R11,R3
     LDMGTFD sp!,{R0-R5,R8,pc};return if beyond list
     SUB   R3,R3,#1
     STR   R3,[R5]           ;update list length
     LDR   R4,[R5,#wFfl-Nf77]!;list window handle
     CMP   R10,#4            ;run list is special
     BNE   x_05
     MOV   R2,#10
     BL    setnoted
     LDR   R0,wT
     BL    redraw
     B     pdn2
x_05 SUB   R5,R11,#1
     STMIA R1,{R4,R5}        ;window and icon handles
     SWI   Wimp_DeleteIcon
     CMP   R3,#0             ;check if any files left
     BGT   x_13
     SWI   Wimp_CloseWindow  ;none, so delete window and
     LDR   R0,wT
     BL    redraw            ;redraw top window to remove tick-mark
x_13 CMP   R5,R3
     BGE   pdn1              ;skip if last icon
;        now move higher icons down to fill the gap
     ADD   R5,R5,#1
ldn1 STR   R5,[R1,#4]        ;store icon # to move  
     SWI   Wimp_GetIconState
     SWI   Wimp_DeleteIcon
     LDR   R0,[R1,#20]       ;top of old position
     STR   R0,[R1,#12]       ;becomes bottom of new
     ADD   R0,R0,#40
     STR   R0,[R1,#20]       ;top is 40 higher
     LDR   R0,[R1],#4
     STR   R0,[R1]           ;move up window handle
     SWI   Wimp_CreateIcon   ;remake icon
     ADD   R5,R5,#1
     STR   R5,[R1],#-4       ;store next icon handle
     CMP   R5,R3
     BLE   ldn1
pdn1 SUBS  R0,R3,#1
     STRGE R4,Blk
     BLGE  fnamsize          ;go set file name window size
pdn2 BL    testact           ;all done, test the actions
     BL    topopen
     LDMFD sp!,{R0-R5,R8,pc} ;return
;
delnote; delete note icon
     STMFD sp!,{R0-R4,lr}
     MOV   R2,#9
     BL    setnoted
     LDR   R0,wT    ;window handle
     MOV   R1,#200
     MOV   R2,#-100
     MOV   R3,#600
     MOV   R4,#0
     SWI   Wimp_ForceRedraw
     LDMFD sp!,{R0-R4,pc}
;
display; ask SrcEdit to display the file at R0
     STMFD sp!,{R0-R3,lr} 
     MOV   R2,#0
     MOV   R3,#40
dis1 STR   R2,[R1,R3]
     SUBS  R3,R3,#4
     BGT   dis1          ;clear Blk
     MOV   R2,#5
     STR   R2,[R1,#16]
     MOV   R3,#-1
     STR   R3,[R1,#20]
     MOV   R3,R3,LSR#20  ;&FFF
     STR   R3,[R1,#40]   ;file type
     ADD   R2,R1,#44
dis2 LDRB  R3,[R0],#1
     STRB  R3,[R2],#1
     CMP   R3,#0
     BGT   dis2
     SUB   R2,R2,R1
     ADD   R2,R2,#3
     BIC   R2,R2,#3
     STR   R2,[R1]       ;store length
     MOV   R0,#18
     MOV   R2,#0
     SWI   Wimp_SendMessage
     LDR   R0,[R1,#8]
     STR   R0,Ref        ;store reference number
     LDMFD sp!,{R0-R3,pc}
;
draw;     re-draw window
     SWI   Wimp_RedrawWindow
drl1 CMP   R0,#0
     LDMEQFD sp!,{R0,R1,pc};finished poll loop
     LDMIB R1,{R3-R8}     ;get useful parameters
     SUB   R3,R3,R7       ;x origin
     SUB   R6,R6,R8       ;y origin
     MOV   R3,R3,LSL#16   ;move x to bits 16-31
     ORR   R3,R3,#&1D00   ;insert 29 in bits 8-15
     STMIB R1,{R3,R6}
     ADD   R0,R1,#5       ;point to the 29
     MOV   R1,#5          ;5 bytes to write
     SWI   OS_WriteN      ;VDU29,x;y; (move origin)
     LDR   R1,[sp,#4]     ;restore R1
     BL    drawW1         ;draw top window
     ADR   R0,restor      ;restore origin
     MOV   R1,#5
     SWI   OS_WriteN
     LDR   R1,[sp,#4]     ;restore R1
     SWI   Wimp_GetRectangle
     B     drl1           ;loop over rectangles
restor DCB   29,0,0,0,0,0
;
     ALIGN
drawW1; draw top window
     STMFD sp!,{R0-R9,lr}
     ADR   R3,Nlib
     MOV   R1,#544
drw2 MOV   R0,#4
     LDR   R2,[R3],#-4    ;get number of files
     CMP   R2,#0
     MVNGT R2,#320        ;bottom if there are files
     MVNLE R2,#256        ;bottom if no files
     SWI   OS_Plot        ;move to top of line
     MVN   R2,#192
     MOV   R0,#5
     SWI   OS_Plot        ;draw line
     SUBS  R1,R1,#204
     BGT   drw2           ;loop over vertical lines
     LDR   R2,[R3,#16]
     CMP   R2,#0          ;check for run file
     MOV   R0,#4
     MOV   R1,#720
     MVN   R2,#128
     SWI   OS_Plot
     MOV   R0,#5
     MVNGT R2,#256
     MVNLE R2,#192
     SWI   OS_Plot
     LDMFD sp!,{R0-R9,pc};return
;
drnotex; print action immediately; R0 points to message,
;        R2 to null terminated continuation
     STMFD sp!,{R0-R4,lr}
     MOV   R4,R2
     ADR   R0,Msgds
     ADR   R2,Note
     MOV   R3,#24
     LDR   R1,[sp]
     SWI   MessageTrans_Lookup
     MOV   R2,#9
     LDR   R1,[sp,#4]
     BL    setnote
     LDMFD sp!,{R0-R4,pc} ;finished,
;
exec; do the compile/link/run
     STMFD sp!,{R1,lr}
     SWI   Hourglass_On
     BL    setdir
     MOV   R0,#-1
     MOV   R1,#-1
     SWI   Wimp_SlotSize ;get slot sizes
     MOV   R3,R1
     LDR   R1,[sp]   ;restore R1
     STR   R3,Next
     STR   R2,Free
     LDR   R9,Act        ;get current actions
     LDR   R11,Opt       ;get current options
     BL    execfile      ;check files
     BLEQ  execf77       ;compile
     BLEQ  execlink      ;link
     BLEQ  execsqueeze   ;squeeze
     BLEQ  execrun       ;run
     SWI   Hourglass_Off
     BL    delnote
     ADR   R0,cerr
     BL    deldir
     MOV   R0,#21
     MOV   R1,#9
     SWI   OS_Byte       ;*FX21,9 : flush mouse buffer
     LDMFD sp!,{R1,pc}
cerr DCB   "e",0,0,0
;
stc0 DCB   "stc",0
cmm1 DCB   "cmm",1
execf77; do compilations
     STMFD sp!,{R0,R1,R9,lr}
     TST   R9,#&FF       ;test for compilation
     LDMEQFD sp!,{R0,R1,R9,pc};no compilation
     LDR   R0,Free       ;check for sufficient space
     CMP   R0,#cs
     LDRLT R0,cmm1
     BLLT  problem
     LDMLTFD sp!,{R0,R1,R9,pc};not enough space, return NE
     MOV   R6,#0         ;count of files to compile
xc1  LDR   R5,Nf77       ;total # files
     RSBS  R4,R5,#Mvisfile  ;see if scroll bar
     BGE   xc3           ;no, so skip moving round the window 
     LDR   R0,wFfl
     STR   R0,Blk
     SWI   Wimp_GetWindowState
;     LDR   R0,Blk+24     ;scroll offset to top of window
     RSBS  R0,R6,#1
     MOVGT R0,#0
     CMP   R0,R4
     MOVLT R0,R4
     ADD   R0,R0,R0,LSL#2
     MOV   R0,R0,LSL#3
xc2  STR   R0,Blk+24     ;store new scroll offset
     SWI   Wimp_OpenWindow;move scroll
xc3  STMFD sp!,{R0-R6,R11}
     LDR   R0,fwpoll
     BL    poll          ;do little wimp poll
     LDMFD sp!,{R0-R6,R11}
     CMP   R6,R5
     LDMGEFD sp!,{R0,R1,R9,pc};return if finished
     LDR   R0,wFfl
     MOV   R2,R6
     BL    getnam
     MOV   R2,R0         ;pointer to name
     ADR   R0,stc0       ;start loop over files
     BL    drnotex       ;display action
     ADR   R10,Name
     TST   R11,#Asm      ;assembler listing option
     MOVEQ R3,#"o"
     MOVNE R3,#"s"
     STRB  R3,[R10,#2]   ;store "o." or "s."
     BL    checkdates    ;check if o. file is more recent than f.
     BHI   xc7           ;if so, skip compilation
     LDR   R0,wFfl
     MOV   R7,#&200000
     MOV   lr,#&200000
     STMIA R1,{R0,R6,R7,lr}
     SWI   Wimp_SetIconState;select icon in source list
     ADR   R0,f77op      ;address of command line stuff
     STMFD sp!,{R6}      ;save R6
     LDMIA R0!,{R3-R7,lr};6 words of introduction
     STMIA R1!,{R3-R7,lr};store compiler introduction
;     LDMIA R0!,{R3-R5}   ;3 more words of introduction
;     STMIA R1!,{R3-R5}   ;3 more words of compiler introduction
     STMFD sp!,{R0,R2}   ;save registers
     LDR   R0,nfcopt
     AND   R0,R0,R11     ;standard nfc options set
     ORR   R0,R0,#&C     ;+ the two case conversion options
     MOV   R2,#12        ;space for conversion
     SWI   OS_ConvertCardinal4; convert to an unsigned decimal ASCII string
     MOV   R2,#" "
xc4  STRB  R2,[R1],#1    ;fill with spaces to word boundary
     TST   R1,#3
     BNE   xc4
     LDMFD sp!,{R0,R2,R6};restore registers
     LDMIA R0!,{R3,R4,R5,lr}
     TST   R11,#Nowrn    ;no warnings option
     STRNE R3,[R1],#4    ;"-w  "
     BNE   xc5
     TST   R11,#Uvars    ;unset variables option
     STREQ R4,[R1],#4    ;"-fa "
xc5  TST   R11,#Debug    ;debug option
     STRNE R5,[R1],#4    ;"-g  "
     TST   R11,#Asm      ;assembler listing option
     STRNE lr,[R1],#4    ;"-s  "
     LDMIA R0!,{R3,R4,R5}
     TST   R11,#List     ;list option
     STMNEIA R1!,{R3,R4} ;"-list   "
     LDMIB R10,{R7-R9}   ;collect name into registers R7-R9
     STMIA R1!,{R5,R7-R9};store directory and name
     SUB   R4,R1,#12     ;address of name
xc6  LDRB  R3,[R4],#1
     CMP   R3,#31
     MOVLE R3,#" "
     STRLEB R3,[R4,#-1]  ;change padding to blanks
     STRB  R3,[R4,#19]   ;store 'error' name
     CMP   R4,R1
     BLT   xc6           ;loop over name
     LDMIA R0!,{R4,R5,R7}
     STMIA R1!,{R4,R5}   ;store error file introduction
     STR   R7,[R1,#12]   ;and terminator
     LDR   R1,[sp,#4]    ;restore R1
;****
;     MOV   R0,R1
;     BL debuga
;****
     LDR   R0,Free
;
     BL    runtask       ;do compilation  - at last !!!!
;
     LDR   R0,wFfl
     MOV   R7,#&0
     MOV   lr,#&200000
     STMIA R1,{R0,R6,R7,lr}
     SWI   Wimp_SetIconState;deselect icon in source list
     BL    comperr       ;check for compilation error
     LDMNEFD sp!,{R0,R1,R9,pc};failed, return NE
     ADR   R0,Name
     MOV   R3,#"e"
     STRB  R3,[R0,#2]!   ;pointer to "e.<name>"
     BL    deldir        ;delete if OK
xc7  TST   R11,#Asm      ;assembler listing option
     ADREQ R9,Name+4     ;address of <name>
     MOVEQ R10,#2        ;aof list
     BLEQ  addnam        ;add to aof list
     ADD   R6,R6,#1
     B     xc1           ;loop over files to compile
nfcopt DCD StdOpt
f77op
       DCB "<F77cl$Dir>.";3 words for compile/link directory
       DCB "f77 -c  -zpx";3 words for introduction
;       DCB " /32    -zpx";3 more words for introduction
       DCB "-w  "        ;1 word for no warnings
       DCB "-fa "        ;1 word for unset variables
       DCB "-g  "        ;1 word for debug
       DCB "-s  "        ;1 word for assembler
       DCB "-list   "    ;2 words for listing
       DCB "  f."        ;1 word for source directory
       DCB "  { > e."    ;2 words introducing error file
       DCB " }",0,0      ;line terminator
;
execfile; check files and set up directories
;R9 has current actions, R11 the current options
     STMFD sp!,{R0-R12,lr}
     ADR   R0,stf0
     MOV   R2,#0
     BL    drnotex       ;identify
     ADR   R12,Name      ;pointer to Name
     ADD   R12,R12,#2    ;name actually starts with [00][00]f. etc.
     MOVS  R0,R9,LSL#16  ;test for compile or link
     MOVNE R0,#8         ;if so, then
     MOVNE R4,#0
     ADRNE R1,cerr
     SWINE OS_File       ;*CDIR e
     LDR   R1,[sp,#4]    ;pointer to Blk
     ADR   R7,Nf77
     LDR   R8,[R7],#4    ;# files to compile
     TST   R9,#&FF
     BEQ   xfl5          ;no compile
;        check files for compile step
     TST   R11,#Asm      ;test for asm option
     ADRNE R1,casm
     ADREQ R1,caof
     SWI   OS_File       ;*CDIR o or s
     TST   R11,#List     ;test for lis option
     ADRNE R1,clis
     SWINE OS_File       ;*CDIR l
     MOV   R9,#0         ;count of files in aof
     MOV   R0,#9
     LDR   R2,[sp,#4]    ;pointer to Blk
     MOV   R4,#0
     MOV   R5,#256
     MOV   R6,#0
xfl1 MOV   R3,#20
     SWI   OS_GBPB       ;get file name
     ADD   R9,R9,R3      ;accumulate # files
     BCS   xfl1
     MOV   R1,R2         ;restore R1
xfl2 LDR   R0,wFfl       ;window handle
     SUB   R2,R8,#1      ;icon handle
     BL    getnam        ;get file name into Name+4
     MOV   R2,#"f"
     STRB  R2,[R0,#-2]!
     BL    file          ;check it for Read access
     TSTGT R3,#1
     LDRLE R0,nor1
     BLLE  problem       ;file is not readable
     LDMLTFD sp!,{R0-R12,pc};so finish
     ADR   R2,xlis       ;address list of directories l,s
     MOV   R10,R11,LSR#NlinkOpt+2
     AND   R10,R10,#3
     TST   R11,#Asm      ;test for asm option
     ORREQ R10,R10,#&1C  ;add bits for o & e (if asm not selected)
     ORRNE R10,R10,#&14  ;add bit for e (if asm selected)
xfl3 MOVS  R10,R10,LSR#1
     BEQ   xfl4
     LDRB  R3,[R2],#1
     BCC   xfl3
     ADR   R0,Name
     STRB  R3,[R0,#2]!   ;make up "aof." (etc)+file name
     BL    file          ;check it for write access if it exists
     ANDNE R3,R3,#10
     CMPNE R3,#2
     LDRNE R0,now1
     BLNE  problem       ;aof (etc) file is not writeable
     LDMLTFD sp!,{R0-R12,pc};so finish
     B     xfl3
xfl4 CMP   R3,#0
     ADDEQ R9,R9,#1      ;increment count of new aof files
     SUBS  R8,R8,#1
     BGT   xfl2          ;loop over files
     RSBS  R0,R9,#77
     LDRLT R0,a781
     BLLT  problem       ;too many aof files
     LDMLTFD sp!,{R0-R12,pc};so finish
     LDR   R9,Act        ;restore current actions
xfl5;  end of compile file setup
     LDR   R8,[R7],#4    ;# files to link
     TST   R9,#&FF00
     BEQ   xfl8          ;no link
xfl6 SUBS  R8,R8,#1
     BLT   xfl7
     MOV   R2,R8
     LDR   R0,wOfl
     BL    getnam
     MOV   R3,#"o"
     STRB  R3,[R0,#-2]!
     BL    file          ;check it for Read access if it exists
     TSTGT R3,#1
     LDRLE R0,nor1
     BLLE  problem       ;file is not readable
     LDMLTFD sp!,{R0-R12,pc};so finish
     B     xfl6          ;loop over files
xfl7 ADR   R0,Aif
     BL    file          ;check AIF file for write access if it exists
     ANDNE R3,R3,#10
     CMPNE R3,#2
     LDRNE R0,now1
     BLNE  problem       ;aif file is not writeable
     LDMFD sp!,{R0-R12,pc};finished if linking
xfl8 MOVS  R0,R9,LSR#16
     LDMEQFD sp!,{R0-R12,pc};finished if no squeeze or run 
     ADR   R0,Aif        ;AIF file
     BL    file          ;check its access
     TSTGT R3,#1
     LDRLE R0,nor1
     BLLE  problem       ;file is not readable
     LDMLTFD sp!,{R0-R12,pc};so finish
     TST   R9,#&FF0000
     LDMEQFD sp!,{R0-R12,pc};finished if no squeeze  
     AND   R3,R3,#10
     CMPNE R3,#2
     LDRNE R0,now1
     BLNE  problem       ;aif file is not writeable
     LDMFD sp!,{R0-R12,pc}
caof   DCB "o",0,0,0
casm   DCB "s",0,0,0
clis   DCB "l",0,0,0
xlis   DCB "lseo"  ;l,s are for options 6,7; e,o for error and objects
stf0 DCB "stf",0
       ALIGN
nor1 DCB   "nor",1
now1 DCB   "now",1
a781 DCB   "a78",1 
;                          
lmm1 DCB   "lmm",1
ler1 DCB   "ler",1
stl0 DCB   "stl",0
execlink; do link step
     STMFD sp!,{R0,R1,R9,lr}
     TST   R9,#&FF00       ;test for link request
     LDMEQFD sp!,{R0,R1,R9,pc};no link, return EQ
     ADR   R0,stl0
     ADR   R2,Aif
     BL    drnotex         ;display action
     LDR   R0,Free         ;check for sufficient space
     CMP   R0,#ls
     LDRLT R0,lmm1
     BLLT  problem
     LDMLTFD sp!,{R0,R1,R9,pc};not enough space, return NE
     MOV   R2,R1           ;prepare to make up command line
     ADR   R0,lnkcmd
     LDMIA R0!,{R4-R8}     ;"<F77cl$Dir>.link -o " 
     STMIA R2!,{R4-R8}     ;for the universal linker v 4.11
     ADR   R3,Aif
     LDMIA R3,{R4-R6}
     STMIA R2!,{R4-R6}     ;file name, but is null terminated
     MOV   R4,R2
     MOV   R7,#" "
xlk1 LDRB  R8,[R4,#-1]!
     CMP   R8,#0
     STREQB R7,[R4]
     BEQ   xlk1            ;pad with blanks
     LDMIA R0!,{R4-R10}    ;5 options + 2 words for -u
     TST   R11,#Verbo      ;test verbose option
     STRNE R4,[R2],#4
     TST   R11,#LMap       ;test option 1 (map)
     STRNE R5,[R2],#4
     TST   R11,#LXref      ;test option 3 (x-ref)
     STRNE R6,[R2],#4
     TST   R11,#Debug      ;test for any debug
     STRNE R7,[R2],#4
     TST   R11,#UndfX      ;test for undefined externals
     STMNEIA R2!,{R8-R10}
     LDMIA R0,{R4-R10}     ;7 words of via / err
     STMIA R2!,{R4-R10}
     SUB   R10,R2,#2       ;pointer to start of "e.xxx" 
     LDMIA R3,{R4-R6}
     STMIA R2!,{R4-R6}     ;file name, but is null terminated
     SUB   R9,R2,#12
xlk2 LDRB  R8,[R9,#1]!
     CMP   R8,#0
     BNE   xlk2            ;pad with blanks
     MOV   R7,#" "
     STRB  R7,[R9],#1
     MOV   R7,#"}"
     STRB  R7,[R9],#1
     MOV   R7,#0
     STRB  R7,[R9],#1
     LDR   R5,Naof         ;get vital addresses
     LDR   R3,Nlib
     MOV   R0,#&83         ;to open a new file
     ADR   R1,scrap        ; a scrap file
     SWI   OS_Find         ;open the file
     MOV   R4,R0           ;save the file handle
     MOV   R1,R0
xlk3 MOV   R0,#"o"
     SWI   OS_BPut
     MOV   R0,#"."
     SWI   OS_BPut
     LDR   R1,[sp,#4]
     SUB   R2,R5,#1
     LDR   R0,wOfl
     BL    getnam
     ADR   R6,Name+4
     MOV   R1,R4           ;restore file handle
xlk4 LDRB  R0,[R6],#1
     CMP   R0,#" "
     BLE   x_14
     SWI   OS_BPut
     B     xlk4
x_14 MOV   R0,#10
     SWI   OS_BPut
     SUBS  R5,R5,#1
     BGT   xlk3            ;loop over object file names
xlk5 ADR   R2,Libdr1
xlk6 LDRB  R0,[R2],#1
     SWI   OS_BPut         ;write out "<F77lib$$Dir>."
     CMP   R0,#"."
     BNE   xlk6
     CMP   R5,R3           ;check for fortlib
     BGE   x_06
     LDR   R1,[sp,#4]
     MOV   R2,R5
     LDR   R0,wLfl
     BL     getnam
     ADR   R6,Name+4
     MOV   R1,R4           ;restore file handle
     B     xlk7
x_06 ADREQ R6,fortl
xlk7 LDRB  R0,[R6],#1
     CMP   R0,#" "
     BLE   x_15
     SWI   OS_BPut
     B     xlk7
x_15 MOV   R0,#10
     SWI   OS_BPut
     ADD   R5,R5,#1
     CMP   R5,R3
     BLE   xlk5             ;loop over libraries
     MOV   R0,#0
     SWI   OS_Find          ;close scrap file
     LDR   R1,[sp,#4]
     LDR   R0,Free
;     MOV   R0,#ls
     BL    runtask          ;do the linking
     MOV   R0,#6
     ADR   R1,scrap
     SWI   XOS_File         ;remove the scrap file
     ADR   R0,retcod
     LDR   R1,[sp,#4]
     MOV   R2,#20
     MOV   R3,#0
     MOV   R4,#0
     SWI   OS_ReadVarVal    ;get return code
     MOV   R0,#0
     STRB  R0,[R9,#-2]      ;null terminate "e.name"
     LDRB  R0,Blk           ;load return code
     CMP   R0,#"0"
     BEQ   xlk8             ;is zero if good
     LDR   R0,ler1
     BL    problem
     MOV   R0,#6
     ADD   R1,R10,#2        ;pointer to run file name
     SWI   XOS_File         ;remove
     MOV   R1,R10           ;pointer to "e."+filename
     MOV   R0,#18
     MOV   R2,#-1           ;file type &FFF
     SWI   XOS_File         ;set file type
     MOVS  R0,R1            ;pointer to file name, setting NE flag
     LDR   R1,[sp,#4]
     BL    display          ;get SrcEdit to display error file
     MOVS  R0,#1
     LDMFD sp!,{R0,R1,R9,pc};return NE
xlk8 TST   R11,#LMap:OR:Verbo:OR:LXref ;test for link listings
     MOV   R1,R10           ;pointer to "e."+filename
     MOVNE R0,#18           ;either set file type
     MOVNE R2,#-1           ;to &FFF
     MOVEQ R0,#6            ;or remove file
     SWI   XOS_File         ;set file type
     MOVS  R0,#0
     LDMFD sp!,{R0,R1,R9,pc};return EQ
retcod DCB "Sys$$ReturnCode",0,0 ;4 words
lnkcmd DCB "<F77cl$Dir>."  ;3 words for compile/link directory
       DCB "link -o "      ;2 words link -o " for the universal linker v 4.11
       DCB " -v "          ;1 word (verbose)
       DCB "-map"          ;1 word
       DCB " -x "          ;1 word (Cross reference)
       DCB " -d "          ;1 word (debug)
       DCB "  -u s_stop "  ;3 words (undefined externals)
       DCB "  -via <Wimp$$Scrap>   { > e." ;7 words ($$ = 1 character)
fortl  DCB "fortlib "      ;2 words
scrap  DCB "<Wimp$$Scrap>",0,0,0,0;4 words
Libdr1 DCB "<F77lib$$Dir>.",0,0,0 ;4 words
;
str0   DCB "str",0
execrun; run program
     STMFD sp!,{R0-R6,R12,lr}
     TST   R9,#&FF,8       ;test for run
     LDMEQFD sp!,{R0-R6,R12,pc};no run, return EQ
     ADR   R0,str0
     ADR   R2,Aif
     BL    drnotex         ;display action
     ADDS  R0,R0,#0        ;clear V flag
     LDR   R0,Opt
     TST   R0,#Debug       ;test for debug
     BEQ   x_16
     MOVS  R0,#0           ;set Z flag
     MOV   R0,#18
     ADR   R1,ddtmod
     SWI   XOS_Module      ;if debug, check DDT is loaded
     LDR   R1,[sp,#4]
x_16 LDRVS R0,nod1
     BLVS  problem         ;debug, but no DDT
     LDMNEFD sp!,{R0-R6,R12,pc};return NE
     SWI   Hourglass_Off
     MOV   R0,#&4F
     ADR   R1,Aif
     SWI   OS_Find         ;open aif file for reading
     MOV   R1,R0           ;move file handle
     LDR   R2,[sp,#4]      ;buffer Blk
     MOV   R3,#36          ;to read 36 bytes
     MOV   R0,#4           ;read from beginning
     SWI   OS_GBPB
     MOV   R0,#0
     SWI   OS_Find         ;close file
     LDR   R1,[sp,#4]      ;restore R1
     ADD   R0,R1,#16       ;pointer to lengths
     LDMIA R0,{R2-R6}      ;load lengths
     ADD   R3,R3,R4        ;sum lengths
     ADD   R3,R3,R5
     ADD   R6,R3,R6
     ADR   R3,RunOp
     LDR   R0,runcmd
     STR   R0,[R1],#4      ;set up 'run' command
run1 LDRB  R0,[R3],#1
     STRB  R0,[R1],#1      ;move command
     CMP   R0,#0
     BNE   run1
     LDR   R1,[sp,#4]      ;restore R1
     LDR   R4,Free         ;available space
     LDR   R5,swex
     CMP   R5,R2           ;word 4 ought to be SWI OS_Exit
     ADDEQ R0,R6,#&6000    ;extra 24 Kbytes to size
     LDRNE R0,Next
     CMP   R0,R4           ;check available space
     BLLE  runtask         ;run the program
     ADR   R0,point
     SWI   OS_CLI          ;restore normal pointer
     CMP   R0,R4
     LDRGT R0,nos2
     BLGT  problem
     LDMFD sp!,{R0-R6,R12,pc};return
runcmd DCB "run "
ddtmod DCB "DDT",0
nod1 DCB   "nod",1
nos2 DCB   "nos",2
point DCB "POINTER",0
swex DCD   &EF000011       ;exit instruction at word 4
;
sts0 DCB "sts",0
execsqueeze; do squeeze
     STMFD sp!,{R0-R8,lr}
     TST   R9,#&FF0000     ;test for squeeze
     LDMEQFD sp!,{R0-R8,pc};no squeeze, return EQ
     ADR   R0,sts0
     ADR   R2,Aif
     BL    drnotex         ;display action
     MOV   R0,R1
     ADR   R8,sqztxt
     LDMIA R8!,{R3-R7}     ;load and
     STMIA R0!,{R3-R7}     ;store "squeeze "
     LDMIA R2,{R3-R5}      ;get file name
     STMIA R0!,{R3-R5}     ;store file name
     MOV   R2,R0
     MOV   R3,#" "
sqz1 LDRB  R4,[R2,#-1]!
     CMP   R4,#31
     STRLEB R3,[R2]        ;replace zeros with blanks
     BLE   sqz1
     LDMIA R8,{R3-R5}      ;load and 
     STMIA R0,{R3-R5}      ;store "{ > null: }",0
     LDR   R0,Free         ;maximum space
     BL    runtask         ;do squeeze
     MOVS  R0,#0
     LDMFD sp!,{R0-R8,pc}  ;return EQ
sqztxt DCB "<F77cl$Dir>.squeeze "      ;5 words
       DCB "{ > null: }",0 ;3 words
;
file; determine existence of file pointed to by R0
;   returns =0 if not found (R3=0), <0 if directory (R3=-15)
;   >0 if file (R3 bits 0,1,3 for R,W,L), length in R0
     STMFD sp!,{R1,R2,R4,R5,lr}
     MOV   R1,R0         ;complete file name
     MOV   R0,#17        ;no path to file
     MOV   R3,#0         ;initialise answer flags
     SWI   OS_File       ;get file characteristics
     ADDS  R0,R0,R0
     MOVEQ R3,#0         ;file does not exist
     RSBNES R0,R0,#3     ;file exists
     MOVLT R3,#-15       ;is directory
     MOVGT R3,R5         ;is file, get attributes
     MOVGT R0,R4
     LDMFD sp!,{R1,R2,R4,R5,pc}
;
find; look through file with handle in R1 for string at R0
;      return EQ if found, NE if not
     STMFD sp!,{R0-R3,lr}
fnd1 LDR   R3,[sp]       ;pointer to string
fnd2 LDRB  R2,[R3],#1    ;first character in R2
     CMP   R2,#0         ;check for end of string (setting carry)
     SWINE OS_BGet       ;get character
     LDMCSFD sp!,{R0-R3,pc};EOF found
     CMP   R0,R2
     BEQ   fnd2
     B     fnd1
;
fnamsize; set file name window size: R0=last icon#, Blk has window handle
     STMFD sp!,{R0-R6,lr}
     CMP   R0,#Mvisfile
     BGT   x_17
     SWI   Wimp_GetWindowInfo
     SWI   Wimp_DeleteWindow
     LDR   R2,[R1,#32]!    ;window flags
x_17 LDR   R0,[sp]
     CMP   R0,#Mvisfile
     ORREQ R2,R2,#&10000000;insert vertical scroll bar
     BICLT R2,R2,#&10000000;remove vertical scroll bar
     BGT   x_18
     STR   R2,[R1],#-28    ;save window flags
     SWI   Wimp_CreateWindow
     STR   R0,[R1,#-4]!
     ADR   R2,wFfl-4
     STR   R0,[R2,R10,LSL#2];store new window handle
     STR   R0,Blk          ;and in block
x_18 LDR   R0,[sp]         ;restore icon #
     ADD   R0,R0,#1
     ADD   R0,R0,R0,LSL#2
     MOV   R3,R0,LSL#3
     RSB   R3,R3,#0        ;bottom of window
     ADDGE R6,R3,#40*Mvisfile
     MOV   R2,#0           ;low-x
     MOV   R4,#192         ;high-x
     MOV   R5,#0
     LDR   R0,Blk          ;window handle
     STMIA R1,{R2-R5}      ;store dimensions in block
     MOV   R5,R0           ;save window handle
     SWI   Wimp_SetExtent
     BGE   x_19
     MOV   R0,R5           ;restore window handle
     LDMIA R1,{R1-R4}    ;get dimensions
     SWI   Wimp_ForceRedraw;redraw window
     LDMFD sp!,{R0-R6,pc}
x_19 STR   R5,Blk
     SWI   Wimp_GetWindowState
     SWI   Wimp_CloseWindow
     STR   R6,Blk+24       ;set y-scroll
     SWI   Wimp_OpenWindow
     LDMFD sp!,{R0-R6,pc}
;
getnam; icon name into Name+4 (R0: window handle, R2:name number (0,1,...)
;         returns R0 pointer to Name+4
     STMFD sp!,{R1-R4,lr}
     ADD   R1,R1,#216         ;don't overwrite Blk
     STMIA R1,{R0,R2}
     SWI   Wimp_GetIconState
     ADD   R0,R1,#28
     LDMIA R0,{R2-R4}
     ADR   R0,Name+4-216
     STMIA R0,{R2-R4}
     LDMFD sp!,{R1-R4,pc}
;
Help; create error message for !Help
     ADD    R1,R1,#32
     LDMIA  R1,{R11-R12}   ;get window & icon handles at pointer
     CMP    R12,#0
     BLT    x_20
     SWI    Wimp_GetIconState
     LDR    R10,[R1,#24]  ;get icon flags (bit 21 = selected, 22 = grey)
x_20 SUB    R1,R1,#32     ;restore R1
     ADR    R0,wF
     LDMIA  R0,{R3,R4,R6-R9,lr} ;get window handles:
;        R3:wF, R4:wL, R6:wR, R7:wFfl, R8:wOfl  R9:wLfL lr:wT
     ADR    R0,Msgds      ;pointer to message file descriptor
     ADR    R2,Blk+20     ;starting point for message
     MOV    R5,#0
     CMP    R9,R11        ;if Library file list,
     MOVEQ  R9,#3         ;flag with 3
     MOVNE  R9,#0
     CMP    R8,R11
     MOVEQ  R9,#2         ;flag 2 for Object file list
     CMP    R7,R11
     MOVEQ  R9,#1         ;flag 1 for Fortran file list
     MOV    R7,#0
     CMP    R11,R4        ;check for Link options
     MOV    R4,#0
     BEQ    Hlinkopt      ;over Link options
     CMP    R11,R6
     MOV    R6,#0
     ADREQ  R3,hra0       ;over run options window
     BEQ    Hsend
     CMP    R11,R3
     BEQ    Hfortopt      ;fortran options
     CMP    R11,lr
     BEQ    Hmain         ;over main window
     CMP    R9,#0
     BGT    Hfiles
     CMP    R11,#-2
     LDMNEFD sp!,{R0,R1,pc};unknown window return to wimppoll
; pointer over baricon
     ADR    R3,hia0
     ADR    R5,hib0
     ADR    R6,hic0
     B      Hsend
hra0 DCB    "hra",0
hia0 DCB    "hia",0
hib0 DCB    "hib",0
hic0 DCB    "hic",0
Hmain; pointer over main window
     CMP    R12,#10       ;check for 'run' icon #10
     MOVEQ  R12,#0        ;make it icon 0
     MOVEQ  R9,#4         ;of list 4
     BEQ    Hfiles        ;fugde for 'run' icon
     LDRGTB lr,Dir        ;icon 11 is working directory
     CMPGT  lr,#0         ;make sure there is a working directory
     ADRGT  R3,htt0
     BGT    Hsend
     CMP    R12,#1        ;check icon number
     BLT    Hmx           ;not over icon
     BGT    Hm1           ;not over 'compile'
     ADR    R6,hta0       ;compiler menu option
     LDR    lr,Nf77
     CMP    lr,#1
     ADRLT  R3,htb0       ;ask for files if there are none
     MOVGE  R3,#0         ;otherwise no main message
     TSTGE  R10,#&200000  ;check if selected
     ADRGT  R7,htc0
     ADREQ  R5,htc0
     B      Hsend
Hm1  CMP    R12,#3        ;check icon number
     BGE    Hm2           ;not 'link'
     ADR    R6,htd0       ;link option menu
     LDR    R11,Act
     TST    R11,#255
     LDREQ  lr,Naof
     CMPEQ  lr,#1
     ADRLT  R3,hte0       ;if not, ask for some
     MOVGE  R3,#0
     TSTGE  R10,#&200000  ;check if selected
     ADRGT  R7,htf0       ;'adjust' not to link
     ADREQ  R5,htf0       ;or 'select' to link
     B      Hsend
Hm2  LDR    lr,Nrun       ;# aif files
     BGT    Hm3           ;not 'squeeze'
     CMP    lr,#1
     ADRLT  R3,htg0
     MOVGE  R3,#0
     TSTGE  R10,#&200000  ;check if selected
     ADRGT  R7,hth0       ;'adjust' not to squeeze
     ADREQ  R5,hth0       ;or 'select' to squeeze
     B      Hsend
Hm3  CMP    R12,#4
     BGT    Hmx           ;not 'run'
     CMP    lr,#1
     ADRCC  R3,hti0       ;no file, so ask for one
     MOVCS  R3,#0
     TSTGE  R10,#&200000  ;check if selected
     ADRGT  R7,htj0       ;'adjust' not to run
     ADREQ  R5,htj0       ;or 'select' to run
     ADRGT  R6,htk0       ;'menu'
     B      Hsend
Hmx  CMP    R12,#8        ;check for 'start'
     ADRNE  R3,htl0
     ADREQ  R5,htm0
     MOVEQ  R3,#0
     B      Hsend
;
Hfiles;   help over files window, R9=1,2,3 for Fortran, Object, library
     CMP    R12,#0
     ADRLT  R3,htl0
     BLT    Hsend
     ADR    lr,Nf77-4
     LDR    lr,[lr,R9,LSL#2];get # files
     CMP    R9,#3
     ADRGT  R3,hto0
     ADREQ  R3,htp0
     RSBLES lr,R12,#1
     ADRLE  R5,htq0
     CMP    R9,#2
     ADREQ  R3,htr0
     ADRLT  R3,hts0
     CMP    R9,#3
     LDRGTB lr,Act+1
     CMPGT  lr,#0
     ADRLE  R7,htn0
     ORRLE  R7,R7,#8,4   ;set top bit
     B      Hsend
hta0 DCB    "hta",0
htb0 DCB    "htb",0
htc0 DCB    "htc",0
htd0 DCB    "htd",0
hte0 DCB    "hte",0
htf0 DCB    "htf",0
htg0 DCB    "htg",0
hth0 DCB    "hth",0
hti0 DCB    "hti",0
htj0 DCB    "htj",0
htk0 DCB    "htk",0
htl0 DCB    "htl",0
htm0 DCB    "htm",0
htn0 DCB    "htn",0 
hto0 DCB    "hto",0
htp0 DCB    "htp",0
htq0 DCB    "htq",0
htr0 DCB    "htr",0
hts0 DCB    "hts",0
htt0 DCB    "htt",0
;
Hlinkopt; pointer over link options window
     MOV    R6,#0
     CMP    R12,#0
     BLT    Hl1          ;not over an icon
     CMP    R12,#4
     BEQ    Hl1          ;icon 4 is libraries heading
     BGT    Hl2          ;over a library
     LDR    lr,hlz0
     STR    lr,[R1,#252]
     ADD    R12,R12,#&32 ;make into ASCII 2,3,4,5
     STRB   R12,[R1,#254]
     TST    R10,#&200000 ; test bit 21 (selected bit)
     ADDNE  R7,R1,#252
     ADDEQ  R5,R1,#252
Hl1  ADR    R3,hl00
     B      Hsend
Hl2  STMFD  sp!,{R0,R2}
     ADD    R2,R1,#208   ;space for extra message
     ADD    R1,R1,#60    ;pointer to library name
     MOV    R3,#48
     SWI    MessageTrans_Lookup; try to find library name
     MOVVC  R4,R2        ;address of library message
     LDMFD  sp!,{R0,R2}
     ADRVC  R3,hly0
     ADRVS  R3,hlx0
     TST    R10,#&200000 ; test bit 21 (selected bit)
     ADRNE  R7,hlu0
     ADREQ  R5,hlu0
     B      Hsend
hl00 DCB    "hl0",0
hlu0 DCB    "hlu",0
hlx0 DCB    "hlx",0
hly0 DCB    "hly",0
hlz0 DCB    "hlz",0
;
Hfortopt; pointer over fortran options window
     CMP    R12,#0
     BLT    Hf1          ;not over an icon
     STMFD  sp!,{R0-R2}
     LDR    lr,hf90
     STR    lr,[R1,#252]!
     ADD    R12,R12,#96  ;icon 1 -> "a" etc
     STRB   R12,[R1,#2]
     MOV    R2,#0
     SWI    MessageTrans_Lookup; try to find icon name
     LDMFD  sp!,{R0-R2}
     BVS    Hf1
     TST    R10,#&200000 ; test bit 21 (selected bit)
     ADDNE  R7,R1,#252
     ADDEQ  R5,R1,#252
Hf1  ADR    R3,hf00
     B      Hsend
hf00 DCB    "hf0",0
hf90 DCB    "hf9",0
;
Hsend; to send message to !Help
; R3: pointer to main message token, R4: pointer to substitution
; R5,R6,R7: pointers to tokens of select, menu and adjust parts
; any unused parts have pointers = 0
     MOVS   R1,R3
     MOVNE  R3,#232        ;maximum length for message
     MOVEQ  R3,#-2
     SWINE  MessageTrans_Lookup; transfer first line of general info.
     ADD    R2,R2,R3       ;pointer to next message
     RSB    R3,R3,#232     ;remaining space
     MOVS   R8,R5
     ADRNE  R1,prs0
     BLNE   Hadd           ;add 'select' piece
     MOVS   R8,R6
     ADRNE  R1,prm0
     BLNE   Hadd           ;add 'menu' piece
     ADDS   R8,R7,#0
     BIC    R8,R8,#8,4     ;clear top bit
     ADRGT  R1,pan0        ;'ADJUST not to'
     ADRLT  R1,pat0        ;'ADJUST to'
     BLNE   Hadd           ;add 'adjust' piece
     LDR    R1,[sp,#4]     ;restore pointer
     RSB    R2,R3,#256
     BIC    R2,R2,#3       ;message length
     STR    R2,Blk
     MOV    R0,#&500
     ADD    R0,R0,#3
     STR    R0,Blk+16     ;message type &503
     LDR    R0,Blk+8
     STR    R0,Blk+12     ;reference number
     LDR    R2,Blk+4
     MOV    R0,#17        ;User message
     SWI    Wimp_SendMessage ;send message to !Help
     LDMFD  sp!,{R0,R1,pc};return to wimp poll
prs0 DCB    "prs",0
prm0 DCB    "prm",0
pan0 DCB    "pan",0
pat0 DCB    "pat",0
;
Hadd;    add piece from R1 followed by piece from R8
     MOV    R9,R3         ;remaining space
     SWI    MessageTrans_Lookup; transfer the R1 piece
     ADD    R2,R2,R3
     RSB    R3,R3,R9
     MOV    R1,R8
     MOV    R9,R3         ;remaining space
     SWI    MessageTrans_Lookup; transfer the R8 piece
     ADD    R2,R2,R3
     RSB    R3,R3,R9
     MOVS   pc,lr
;
iconset; set icon R12 in window R11, (assumes R1 is set)
; sets it if <>0, clears it if =0
     STMFD sp!,{R0,lr}
     MOV   R0,#&200000;'select and delete' bit mask
     STR   R0,Blk+12 ;'clear' word
     MOVEQ R0,#0
     STR   R0,Blk+8  ;'EOR' word
     STMIA R1,{R11,R12};store window/icon
     SWI   Wimp_SetIconState
     LDMFD sp!,{R0,pc}
;
fwpoll DCD &E1970
fixsto EQU   Msgs-Blk     ;uses messagetrans buffer for window templates
infoN  DCB   "Inf",0
f77N   DCB   "Top",0
f77ON  DCB   "Fop",0
linkON DCB   "Lop",0
runON  DCB   "Rop",0
fllN   DCB   "Lis",0
task   DCB "TASK"
iconin DCD -1             ;pointer to icon bar (right)
       DCD 0,0,68,68,&1700300A
       DCB "!fde",0 ;icon block
name   DCB "DeskTopF77",0 ;task name in RISC-OS
vers   DCB version,0
tmplt  DCB "<FDE$$Dir>.Windows",0
     ALIGN
init;  procedure to start wimp and load windows etc.
     MOV   sp,R1        ;stack pointer
     STMFD sp!,{R1,lr}
;                check it is not already loaded
     MOV   R0,#0
ini1 SUB   R1,sp,#16
     MOV   R2,#16
     SWI   TaskManager_EnumerateTasks
     LDR   R1,[sp,#-12]      ;address of task name
     ADR   R2,name
     MOV   R3,#10          ;#bytes in name
ini2 LDRB  R4,[R1,R3]
     LDRB  R5,[R2,R3]
     CMP   R4,R5
     BNE   ini3           ;not this task
     SUBS  R3,R3,#1
     BGE   ini2
     B     stop           ;so return to OS
ini3 CMP   R0,#0
     BGT   ini1           ;try next task
     MOV   R0,#200
     LDR   R1,task
     ADR   R2,name
;     ADR   R3,zero
     SWI   Wimp_Initialise ;start wimp task
     ADR   R1,tmplt
     SWI   Wimp_OpenTemplate
     LDR   R1,[sp]
     ADD   R1,R1,#fixsto   ;address of temporary store
     LDR   R9,Menuptr      ;address of menu block
     ADR   R2,Icons-fixsto ;address for indirected icons
     ADD   R3,R2,#licons
     MOV   R4,#-1
     ADR   R5,fllN
     MOV   R6,#0
     SWI   Wimp_LoadTemplate
     SWI   Wimp_CreateWindow
     STR   R0,wFfl-fixsto   ;created fortran list window
     SWI   Wimp_CreateWindow
     STR   R0,wOfl-fixsto   ;created object list window
     SWI   Wimp_CreateWindow
     STR   R0,wLfl-fixsto   ;created library list window
     ADR   R5,runON
     MOV   R6,#0
     SWI   Wimp_LoadTemplate
     SWI   Wimp_CreateWindow
     STR   R0,wR-fixsto   ;created run options
     ADR   R5,f77ON
     MOV   R6,#0
     SWI   Wimp_LoadTemplate
   [ NoDebug=1   ;grey out the Debug option
     LDR   R0,greyI
     STR   R0,[R1,#88+16+32*16];grey out 'Debug' icon
   ]  ;end NoDebug
     SWI   Wimp_CreateWindow
     STR   R0,wF-fixsto   ;created fortran options
     ADR   R5,linkON
     MOV   R6,#0
     SWI   Wimp_LoadTemplate
     MOV   R5,#"s"
     STRB  R5,[R1,#83]    ;fix up "Link Options"
     SWI   Wimp_CreateWindow
     STR   R0,wL-fixsto   ;created link options
     ADR   R5,infoN
     MOV   R6,#0
     SWI   Wimp_LoadTemplate
     ADR   R5,vers
     STR   R5,[R1,#204]
     SWI   Wimp_CreateWindow
     STR   R0,[R9,#32]    ;store 'info' handle in menu
     ADR   R2,Note-fixsto ;address for note icon
     ADD   R3,R2,#36+256  ;length of note+Aif icons
     ADD   R2,R2,#1       ;skip dir length byte
     ADR   R5,f77N
     MOV   R6,#0
     SWI   Wimp_LoadTemplate
;        fix pointers to 3 indirected icons (9,10 & 11)
     ADR   R0,Note-fixsto
     STR   R0,Blk+88+9*32+20
     ADD   R0,R0,#Aif-Note
     STR   R0,Blk+88+10*32+20
     ADD   R0,R0,#Dir+1-Aif
     STR   R0,Blk+88+11*32+20
     SWI   Wimp_CreateWindow
     STR   R0,wT-fixsto   ;created main window
     SWI   Wimp_CloseTemplate
     LDR   R1,[sp],#4     ;restore R1
     BL    initmess
     BL    optload        ;load options
     MOV   R2,#10
     BL    setnoted       ;'delete' Aif icon
     MOV   R2,#".",8
     STR   R2,Name        ;store directory separator "."
     BL    initlib        ;load library information
     BL    testact
     ADR   R1,iconin      ;to create icon bar icon
     SWI   Wimp_CreateIcon
     LDMFD sp!,{pc}       ;return to main program
greyI  DCD &0740303D      ;greyed out icon data
;
initlib;  set up libraries menu
     STMFD sp!,{R0-R8,lr}
     LDR   R0,wL       ;link options window handle
     MOV   R2,#24
     MOV   R3,#-232    ;y of first library name
     MOV   R4,#183
     ADD   R5,R3,#40
     LDR   R6,=&C7003039
     STMIA R1,{R0,R2-R6}
     MOV   R4,#0       ;file name offset for OS_GBPB
     MOV   R6,#0       ;match any string
     MOV   R8,#0       ;count of libraries read
     MOV   R10,#3      ;screen list #
libl1 MOV  R3,#1       ;one name at a time
     ADD   R2,R1,#24   ;buffer for name
     MOV   R5,#12      ;buffer length
     ADR   R1,Libdir   ;pointer to directory name
     MOV   R0,#9       ;OS_GBPB flag to read names
     SWI   OS_GBPB     ;get file name
     LDMCCFD sp!,{R0-R8,pc} ;finished
     LDR   R1,[sp,#4]  ;restore block pointer
;          check if fortlib
     ADR   R5,f77l     ;address of "FORTLIB"
     MOV   R3,#7       ;length of name
libl2 LDRB R0,[R2,R3]
     CMP   R0,#96
     SUBGT R0,R0,#32
     LDRB  R9,[R5,R3]
     CMP   R9,R0
     BNE   libl3
     SUBS  R3,R3,#1
     BGE   libl2
     B     libl1       ;ignore "FORTLIB"
libl3 ADD  R8,R8,#1    ;count libraries
     STR   R8,Mlib
     SWI   Wimp_CreateIcon
     LDMIB R1,{R0,R2,R3,R5}
     CMP   R0,#80
     RSB   R0,R0,#232
     ADD   R3,R0,#159
     SUBGT R2,R2,#48
     ADD   R5,R2,#40
     STMIB R1,{R0,R2,R3,R5};point to next icon
     B     libl1
       LTORG
f77l   DCB "FORTLIB",0
Libdir DCB "<F77lib$Dir>",0
;
     ALIGN
initmess; initialise the messages
     STMFD sp!,{R1,lr}
     ADR   R1,msgfl
     SWI   MessageTrans_FileInfo
     BVS   inim1        ;can't find file
     TST   R0,#1
     MOVNE R2,#0
     CMP   R2,#lmsgs
     BGT   inim2        ;file too big
     LDR   R1,[sp]
     ADR   R0,Msgds     ;pointer to file descriptor
     ADR   R2,Msgs      ;pointer to file space
     ADR   R1,msgfl
     SWI   MessageTrans_OpenFile
     LDMFD sp!,{R1,pc}  ;return to init
inim1;  can't find messages file
     ADR   R4,msgfl
     ADR   R1,noflf
     B     inm3
inim2;  file too big
     ADR   R1,msgtb
inm3 LDR   R2,[sp]
     ADD   R2,R2,#lstack+4;buffer space
     MOV   R0,#0
     MOV   R3,#252      ;length of buffer
     SWI   MessageTrans_Lookup
     SUB   R0,R2,#4
     MOV   R1,#2
     ADR   R2,pgnam
     SWI   Wimp_ReportError
     B     close         ;kill!
msgfl DCB "<FDE$Dir>.Messages",0
noflf DCB "NoFile",0
msgtb DCB "BufOFlo",0
pgnam DCB "DeskTop Fortran",0
     ALIGN
;
key;      key press received
     LDR   R0,[R1,#24]    ;get key pressed
     CMP   R0,#13         ;check for <Return>
     BEQ   x_21
     SWI   Wimp_ProcessKey;if not, send back to Wimp
     LDMFD sp!,{R0,R1,pc}           ;and return
x_21 ADR   R0,RunOp
key1 LDRB  R2,[R0],#1
     CMP   R2,#" "
     BEQ   key1           ;find first non-blank
     SUB   R3,R0,#1
key2 LDRB  R2,[R0],#1
     CMP   R2,#" "
     BGT   key2           ;find end of file name
     SUB   R4,R0,R3       ;length of file name
     CMP   R4,#12
     BLT   x_07
     LDR   R0,lnm2
     BL    problem
     LDMGEFD sp!,{R0,R1,pc}
x_07 ADR   R0,Aif
key3 LDRB  R2,[R3],#1
     CMP   R2,#" "
     MOVLE R2,#0
     STRB  R2,[R0],#1     ;store new file name
     BGT   key3
     LDR   R0,wT
     BL    redraw          ;display new file name
     LDR   R0,wR
     STR   R0,[R1]        ;close run options window
     SWI   Wimp_CloseWindow
     MOV   R0,#-1         ;release caret
     SWI   Wimp_SetCaretPosition
     LDMFD sp!,{R0,R1,pc};return to wimp poll
lnm2 DCB   "lnm",2
;   
mclick;  click on icon bar to produce menu
     CMP   R10,#2      ;check for menu button
     LDREQ R2,Blk
     SUBEQ R2,R2,#60   ;x of menu
     MOVEQ R3,#Ntop*44+156
     LDREQ R1,Menuptr
     SWIEQ Wimp_CreateMenu ;open menu
     CMP   R10,#4      ;check for 'select'
     LDMNEFD sp!,{R0,R1,pc}
     LDR   R0,wT
     STR   R0,Blk
     SWI   Wimp_GetWindowState
     MOV   R0,#-1
     STR   R0,Blk+28   ;to open window on top
     BL    topopen1
     LDMFD sp!,{R0,R1,pc}
;
helpnm DCB "<FDE$$Dir>.!Help",0
menu;        click over menu item
     LDR   R10,Blk        ;index
     CMP   R10,#1         ;help
     ADREQ R0,helpnm
     BLEQ  display
     CMP   R10,#2         ;Save Options
     BLEQ  optsave
     CMP   R10,#3         ;check for "check dates"
     LDREQ R0,Menuptr     ;pointer to menu
     LDREQB R3,[R0,#Chkdis]
     EOREQ R3,R3,#1       ;toggle arrow
     STREQB R3,[R0,#Chkdis]
     LDREQ R3,Opt
     EOREQ R3,R3,#Chkdt   ;toggle option
     STREQ R3,Opt
     CMP   R10,#Ntop
     BEQ   quit           ;quit request
     SWI   Wimp_GetPointerInfo
     LDR   R0,Blk+8
     CMP   R0,#1          ;check for 'adjust'
     LDREQ R2,Blk
     SUBEQ R2,R2,#60      ;x of menu
     MOVEQ R3,#Ntop*44+156
     LDREQ R1,Menuptr
     SWIEQ Wimp_CreateMenu;open menu
     LDMFD sp!,{R0,R1,pc} ;return to wimp poll
Menuptr DCD  Menu
;
message;  message received
     LDMIB R1,{R2-R6}
     CMP   R5,#0
     BEQ   quit           ;shut down request
     SUB   R0,R5,#&500
     CMP   R0,#2
     BEQ   Help           ;request from !Help
     SUBS  R0,R5,#&40000
     BGT   msmc           ;go check for mode change
     CMP   R5,#3
     LDMNEFD sp!,{R0,R1,pc};not dataload message
     STR   R3,Blk+12
     MOV   R0,#4
     STR   R0,Blk+16
     MOV   R0,#17
     SWI   Wimp_SendMessage;acknowledge message
     ADR   R5,Blk+44      ;start of message
     CMP   R6,#-2         ;check for icon bar
     LDRNE R0,wT
     CMPNE R0,R6
     LDRNE R0,wFfl
     CMPNE R0,R6
     LDRNE R0,wOfl
     CMPNE R0,R6
     LDRNE R0,wLfl
     CMPNE R0,R6
     LDMNEFD sp!,{R0,R1,pc};not in useful window
     MOV   R12,R6         ;save window handle
     MOV   R2,#-1         ;initialise length
ms3  ADD   R2,R2,#1
     LDRB  R0,[R5,R2]
     CMP   R0,#0          ;search for end of message
     BNE   ms3
ms4  SUB   R2,R2,#1
     LDRB  R0,[R5,R2]
     CMP   R0,#"."        ;search for beginning of file name
     BNE   ms4
     ADC   R9,R2,R5       ;save for storing name
     LDR   R11,Blk+40     ;get file type
     LDR   R10,=&FF8      ;aif file type
     SUBS  R10,R10,R11
     CMPNE R10,#(&FF8-&FD3); debugAIF 
     MOVEQ R10,#4         ;aif file
     BEQ   ms5
     CMP   R11,#&1000     ;check for directory
     LDREQB R0,[R9,#1]
     CMPEQ R0,#0
     LDREQB R0,[R9]
     BEQ   msa            ;1-character directory name       
     SUB   R2,R2,#2
     LDRB  R0,[R5,R2]
     CMP   R0,#"."        ;check directory has unit length
     BNE   msb
     LDRB  R0,[R9,#-2]
msa  CMP   R0,#"a"
     SUBGE R0,R0,#32
     CMP   R0,#"F"
     MOVEQ R10,#1         ;f77 file
     BEQ   ms5
     CMP   R0,#"O"
     MOVEQ R10,#2         ;aof file
     BEQ   ms5
msb  LDR   R0,ntf2
     BL    problem
     LDMEQFD sp!,{R0,R1,pc} ;not recognised type
ms5  ADR   R6,Dir         ;address of working directory
     MOV   R4,#1          ;equality flag
     ADD   R3,R2,#1       ;pointer to end
     STRB  R2,[R5,#-1]!   ;store count in first byte
ms6  LDRB  R7,[R5,R2]     ;compare new byte
     LDRB  R8,[R6,R2]     ;with old byte
     CMP   R7,R8
     MOVNE R4,#0          ;not equal, set flag
     CMP   R4,#0
     STREQB R7,[R6,R2]    ;store new directory
     SUBS  R2,R2,#1
     BGE   ms6            ;loop over directory characters
     CMP   R4,#0          ;if new directory,
     STREQB R4,[R6,R3]    ;store terminating zero
     CMP   R3,#32
     MOVGT R3,#&220       ;right justify if >32 characters
     MOVLE R3,#&20        ;no right justify if <=32 characters
     CMP   R4,#0          ;if new directory,
     BNE   x_08
     LDR   R0,wT
     MOV   R2,#11
     MOV   R4,#&220       ;also make background filled 
     STMIA R1,{R0,R2-R4};window/icon/clear/EOR of directory icon
     SWI Wimp_SetIconState
     BL    delall
     BL    testact        ;clear actions
x_08 MOV   R4,#0          ;to read first directory entry
     CMP   R11,#&1000     ;check for directory
     BNE   msd
     ADR   R8,Dir
     LDRB  R2,[R8]        ;length of name
     ADD   R8,R8,R2       ;R8 points at last char in name
     CMP   R10,#2 
     MOVEQ R0,#"o"
     MOVLT R0,#"f"
     STRB  R0,[R8,#2]     ;store directory name
     STRB  R4,[R8,#3]     ;and terminate
     MOV   R7,R10         ;save R10
msc  MOV   R0,#'.'
     STRB  R0,[R8,#1]     ;store '.' in directory name
     MOV   R0,#9          ;to read just the name
     ADR   R2,Name+4      ;place to read name to
     ADR   R1,Dir
     ADD   R1,R1,#1       ;address of directory
     MOV   R3,#1          ;read 1 name
     MOV   R5,#12         ;length of buffer for name
     MOV   R6,#0          ;no match required
     SWI   OS_GBPB        ;get file name
     LDR   R1,[sp,#4]     ;restore R1
     MOV   R9,R2          ;address of name
     MOV   R0,#0
     STRB  R0,[R8,#1]     ;null terminate directory name
     MOV   R10,R7         ;restore R10     
msd  CMP   R10,#2
     BNE   ms8            ;skip if not object file
     STMFD sp!,{R4,R7-R9} ;save R4,R7,R8,R9
     BL    search         ;see if file already in list
     LDMFD sp!,{R4,R7-R9} ;restore R4,R7,R8,R9
     BEQ   ms9            ;skip if file exists
     BL    setdir
     MOV   R0,#"o"
     STRB  R0,Name+2
     BL    checkdates     ;check source & object dates
     MOVLO R10,#1         ;if source more recent, add source
ms8  BL    addnam         ;add name to list
ms9  CMP   R4,#0
     BGT   msc            ;loop over file names in directory
     CMP   R12,#-2
     BLEQ  topopen        ;open top window 
     LDMFD sp!,{R0,R1,pc} ;return to wimp poll
ntf2 DCB   "ntf",2
     LTORG
msmc;  possible mode change
     SUBS  R2,R0,#&C1     ;mode change=&400C1
     LDMNEFD sp!,{R0,R1,pc};no, return to wimp poll
     MOV   R4,#3
     ADR   R3,Nf77
msm1 LDR   R0,[R3],#4     ;# of files
     CMP   R0,#0
     ADDNE R2,R2,#1       ;count # active files windows
     SUBS  R4,R4,#1
     BGT   msm1           ;loop over files windows
     STR   R2,mcf         ;store # open files windows
     LDMFD sp!,{R0,R1,pc} ;return to wimp poll
;
movnam; move file R11 to top ot list R10
     STMFD  sp!,{R0-R5,lr}
     ADR    R5,Nf77-4
     LDR    R3,[R5,R10,LSL#2]!;get count in list
     CMP    R3,R11
     CMPLT  R11,#2
     LDMLTFD sp!,{R0-R5,pc}   ;return if beyond list or 1st item
     LDR    R2,[R5,#wFfl-Nf77];list window handle
     SUB    R5,R11,#1
     STMIA  R1,{R2,R5}        ;window and icon handles
     STR    R2,[R1,#offset]
     SWI    Wimp_GetIconState ;get name of one to be moved up
     MOV    R3,#0             ;icon to move
     MOV    R4,R1             ;old block area
     ADD    R1,R1,#offset     ;new block area
lmn1 STR    R3,[R1,#4]        ;icon to be moved down
     SWI    Wimp_GetIconState
     SWI    Wimp_DeleteIcon
     LDR    lr,[R1,#12]       ;minimum y of deleted icon
     STR    lr,[R4,#12]       ;store in old icon
     LDR    lr,[R1,#20]       ;minimum y of deleted icon
     STR    lr,[R4,#20]       ;store in old icon
     MOV    lr,R4             ;swop blocks
     MOV    R4,R1
     ADD    R1,lr,#4
     STR    R2,[R1]           ;store window handle
     SWI    Wimp_CreateIcon
     SUB    R1,R1,#4
     ADD    R3,R3,#1
     CMP    R3,R5
     BLE    lmn1
     MOV    R0,R2
     BL     redraw            ;redraw file window
     LDMFD  sp!,{R0-R5,pc}
;
openw;   wimp poll call to open window
     LDR   R0,[R1]        ;window handle
     LDR   lr,wT          ;top window handle
     CMP   R0,lr
     BEQ   x_22
     SWI   Wimp_OpenWindow;if not files window
     LDMFD sp!,{R0,R1,pc} ;end poll loop
x_22 BL    topopen1       ;open top window
     LDMFD sp!,{R0,R1,pc} ;end poll loop
;
optload;  load options from file
     STMFD sp!,{R1,lr}
     MOV   R0,#&43
     ADR   R1,optfil
     SWI   OS_Find        ;open options file to read
     MOVS  R1,R0          ;move file handle
     MOVEQ R2,#0
     BEQ   opl3           ;choices file does not exist
     MOV   R2,#1          ;initialise OptOld
opl2 SWI   OS_BGet
     SUB   R0,R0,#"0"     ;convert to hex
     CMP   R0,#9
     SUBGT R0,R0,#7
     ORRS  R2,R0,R2,LSL#4
     BCC   opl2
     MOV   R0,#0
     SWI   OS_Find        ;close file
opl3 LDR   R1,[sp]
     STR   R2,OptOld      ;store the 'old options'
     TST   R2,#Chkdt      ;test for "check" bit
     LDRNE R0,Menuptr     ;pointer to menu
     MOVNE R12,#1
     STRNEB R12,[R0,#Chkdis];set arrow in menu
     MOV   R12,#0         ;option counter
     STR   R12,Opt
opl4 TST   R2,#1
     BL    optset         ;set the 'new' options
     ADD   R12,R12,#1
     MOVS  R2,R2,LSR#1
     BNE   opl4
     ADR   R0,sqz
     BL    file         ;check squeeze exists
     LDRLE R0,wT        ;if not, grey-out icon
     STRLE R0,Blk
     MOVLE R0,#3
     STRLE R0,Blk+4
     MOVLE R0,#&400000
     STRLE R0,Blk+8
     STRLE R0,Blk+12
     SWILE Wimp_SetIconState
     LDMFD sp!,{R1,pc}
optfil DCB "<FDE$$Dir>.Choices",0
sqz  DCB "<F77cl$Dir>.squeeze",0
;
     ALIGN
optsave; save options to file
     STMFD sp!,{R0-R3,lr}
     LDR   R3,Opt
     STR   R3,OptOld      ;set old to new options
     MOV   R0,#&C3
     ADR   R1,optfil
     SWI   OS_Find        ;open options file to write
     CMP   R0,#0
     MOVEQ R0,#&83
     SWIEQ OS_Find
     MOV   R1,R0          ;move file handle
     MOV   R2,#28         ;8 hex digits
opl5 MOV   R0,R3,LSR R2
     AND   R0,R0,#15
     CMP   R0,#9
     ADDGT R0,R0,#7
     ADD   R0,R0,#"0"     ;make hex digit
     SWI   XOS_BPut       ;write out options
     SUBS  R2,R2,#4
     BGE   opl5
     MOV   R0,#0
     SWI   OS_Find        ;close file
     LDMFD sp!,{R0-R3,pc}
;
noptset; does opposite of optset
     BEQ   op16
     CMP   R0,R0      ;zero flag
     B     optset
op16 CMP   lr,#0      ;non-zero flag
optset; set the option in R12 according to the Z flag:
;  set it if <>0, clear it if =0. Expects R1 to point to Blk
     STMFD sp!,{R0,R2,R11,R12,lr}
     LDR   R0,Opt
     MOV   R2,#1
     BICEQ R0,R0,R2,LSL R12;clear option
     ORRNE R0,R0,R2,LSL R12;set option
     STR   R0,Opt    ;store options
     MOVEQ R2,#0     ;save flag
     CMP   R12,#4                    ;don't change Chkdt 'icon'
     LDMEQFD sp!,{R0,R2,R11,R12,pc}  ;fixed in version 1.54
     SUBS  R12,R12,#LinkOff
     RSBGES lr,R12,#NlinkOpt
     LDRGT R11,wL
     LDRLE R11,wF
     ADDLE R12,R12,#1+LinkOff;fortran icons are +1
     CMP   R2,#0     ;restore flag
     BL    iconset
     LDMFD sp!,{R0,R2,R11,R12,pc}
;
poll;       wimp polling loop
     STMFD sp!,{R0,R1,lr}
     LDR   R0,[sp]      ;restore mask
     SWI   Wimp_Poll
     CMP   R0,#1
     LDMLTFD sp!,{R0,R1,pc}
     CMP   R0,#2
     BLT   draw         ;redraw window
     BEQ   openw        ;open window    
     CMP   R0,#6
     BLT   windc        ;close window request
     BEQ   click        ;mouse click
     CMP   R0,#8
     BEQ   key          ;key press
     CMP   R0,#9
     BEQ   menu         ;click over menu
     CMP   R0,#17
     LDMLTFD sp!,{R0,R1,pc}
     CMP   R0,#19
     BLT   message      ;message received
     BEQ   reply        ;reply to message
     LDMFD sp!,{R0,R1,pc}         ;endless poll loop
;
problem; to make wimp triangle window
; R0 contains 3-character message token + error byte
; if the string contains %0, substitution is taken from R12
; error byte is: 2 if only 'cancel' is allowed
;                3 if 'OK' and cancel are allowed
; returns Z set if 'cancel' requested, <0 if 'OK'
     STMFD sp!,{R0-R4,lr}
     ADR   R0,Msgds      ;message file descriptor
     ADD   R2,R1,#160    ;buffer
     MOV   R3,#96
     LDRB  lr,[sp,#3]    ;error byte
     MOV   R4,#0
     STRB  R4,[sp,#3]    ;null terminate message
     MOV   R4,R12        ;substitution string
     MOV   R1,sp         ;pointer to token
     SWI   MessageTrans_Lookup
     SUB   R0,R2,#4      ;pointer to error block
     ADR   R2,pname
     MOV   R1,lr         ;flags
     SWI   Wimp_ReportError
     CMP   R1,#2
     LDMFD sp!,{R0-R4,pc};return with flags set
pname DCB "DeskTop Fortran",0
;
quit; request from menu or shutdown request
     LDR   R2,Opt
     LDR   R3,OptOld
     CMP   R2,R3
     LDRNE R0,sop3
     BLNE  problem
     BLNE  optsave     ;save options if 'OK'
close;    shut down the task
     SWI   Wimp_CloseDown ;stop the wimp task
stop ADR   R0,zero
     SWI   OS_Exit        ;return to OS
sop3 DCB   "sop",3
zero DCD 0
;
redraw;  force a redraw of window with handle R0
     STMFD sp!,{R0-R4,lr}
     MOV   R1,#0
     MVN   R2,#3088     ;minimum y (was 512 29/11/97)
     MOV   R3,#800
     MOV   R4,#0
     SWI   Wimp_ForceRedraw
     LDMFD sp!,{R0-R4,pc}
;
reply; call up !SrcEdit or !DDT if not loaded
     LDR   R0,Ref
     LDR   R2,[R1,#8]    ;get reference number in message
     CMP   R0,R2
     LDREQ R2,Run
     STREQ R2,[R1,#40]
     ADDEQ R0,R1,#40
     SWIEQ Wimp_StartTask
     LDMFD sp!,{R0,R1,pc}
Run  DCB "run "
;
runtask; runs task pointed to by R1 in memory size R0
     STMFD sp!,{R0-R2,lr}
     MOV   R1,R0
     MOV   R0,#-1
     SWI   Wimp_SlotSize ;set up space for task
     LDR   R0,[sp,#4]    ;address of Blk (command script)
     SWI   Wimp_StartTask;do task
     LDR   R1,[sp,#4]
     LDR   R1,Next
     MOV   R0,#-1
     SWI   Wimp_SlotSize ;set up nominal slot size
     LDMFD sp!,{R0-R2,pc}
;
search; look for name at R9 in list R10
;    returns EQ if found, LT if not found
;    sets R9 to address of word containing file count
;    clobbers R0,R2-R8 and first 40 bytes of data block.
;        first get name
     ADR   R5,Name+4
     MOV   R3,#11         ;count to move
sch1 LDRB  R0,[R9],#1
sch2 STRB  R0,[R5],#1
     SUBS  R3,R3,#1
     CMPGE R0,#0
     BGT   sch1           ;copy name or
     BEQ   sch2           ;fill with zeros
     LDMDB R5,{R2-R4}     ;get name into R2 to R4
     ADR   R9,wFfl-4
     LDR   R0,[R9,R10,LSL#2]!;get list window handle
     STR   R0,[R1]
     LDR   R0,[R9,#Nf77-wFfl]!;get length of list
     ADD   R8,R1,#28      ;pointer to icon name
sch3 SUBS  R0,R0,#1
     MOVLT pc,lr          ;not found
     STR   R0,[R1,#4]
     SWI   Wimp_GetIconState  
     LDMIA R8,{R5-R7}
     BIC   R7,R7,#255,8   ;clear last byte which may contain lib#
     CMP   R2,R5
     CMPEQ R3,R6
     CMPEQ R4,R7
     BNE   sch3           ;loop over files
     MOV   pc,lr          ;found
;
setdir; set current directory to working directory
     STMFD sp!,{R0,R1,lr}
     MOV   R0,#0
     ADR   R1,Dir
     ADD   R1,R1,#1
     SWI   OS_FSControl  ;set CSD to working directory
     LDMFD sp!,{R0,R1,pc} 
;
setnote; to un-delete icon #R2
     STMFD  sp!,{R0,R3-R4,lr}
     MOV    R3,#0
     B      sn1
setnoted; to delete icon #R2
     STMFD  sp!,{R0,R3-R4,lr}
     MOV    R3,#&800000
sn1  LDR    R0,wT    ;window handle
     MOV    R4,#&800000
     STMIA  R1,{R0,R2-R4}
     SWI    Wimp_SetIconState
     LDMFD  sp!,{R0,R3-R4,pc}
;
testact; check and set up action list
     STMFD sp!,{R0,R2,R3,R4,R8-R12,lr}
     LDR   R4,Act         ;get actions
     LDR   R2,Nf77
     LDR   R0,wFfl
     CMP   R2,#0          ;if no f77 files
     BICEQ R4,R4,#&FF     ;clear f77 action
     TST   R4,#&FF        ;if no compilation
     LDREQ R2,Naof
     LDREQ R0,wOfl
     CMPEQ R2,#0          ;and if no aof files
     BICEQ R4,R4,#&FF00   ;clear link action
     MOV   R10,#4         ;run display column
     TST   R4,#&FF00
     BEQ   x_09
     MOV   R2,#0
     BL    getnam         ;get name of first Fortran or object file
     ADR   R9,Name+4
     STR   R2,Nrun
     BL    addnam         ;store new run file
     B     tsta
x_09 LDR   R11,Nrun
     CMP   R11,#0
     BLE   x_10
     BL    setdir
     ADR   R0,Aif
     BL    file
     BGT   tsta           ;file exists
x_10 BIC   R4,R4,#&FF0000 ;clear squeeze action
     BIC   R4,R4,#&FF,8   ;clear run action
     SUBS  R11,R11,#1
     BNE   tsta
     STR R11,Nrun       ;remove run count
     MOV R2,#10
     BL    setnoted       ;and icon
     LDR   R0,wT
     BL    redraw         ;redraw top window
tsta STR   R4,Act         ;store action list
     LDR   R11,wT         ;main window handle
     MOV   R12,#4
tst1 MOV   R4,R4,ROR#24
     TST   R4,#&FF
     BL    iconset        ;set the icons according to actions
     SUBS  R12,R12,#1
     BGT   tst1           ;loop over 4 icons
     TST   R4,#&FF,8
     LDREQ R0,wR          ;if no run action
     STREQ R0,Blk
     SWIEQ Wimp_CloseWindow ;close run line window
     BL    delnote        ;delete action notice
     CMP   R4,#0
     LDR   R0,wT          ;window handle
     MOV   R2,#8          ;'start' icon handle
     MOVEQ R3,#&400000    ;grey
     MOVNE R3,#0          ;not grey
     MOV   R4,#&400000
     STMIA R1,{R0,R2-R4}
     SWI   Wimp_SetIconState
     LDMFD sp!,{R0,R2,R3,R4,R8-R12,pc}
;
throwback; sends compiler errors & warnings to DDTUtils
     STMFD sp!,{R0-R8,lr}
     SWI   DDEUtils_ThrowbackStart+&20000
     BVC   thr0
     ADR   R0,redit          ;get load instruction for !SrcEdit
     MOV   R2,#lblk
     MOV   R3,#0
     MOV   R4,#0
     SWI   OS_ReadVarVal+&20000
     MOVS  R0,#0             ;set zero flag for problem
     LDMVSFD sp!,{R0-R8,pc}  ;return zero
     STRB  R0,[R1,R2]       ;null terminate
     MOV   R0,R1
     SWI   Wimp_StartTask+&20000    ;load !SrcEdit
     SWI   DDEUtils_ThrowbackStart+&20000
thr0 MOV   R2,R1
     ADR   R4,Name+4         ;address of <name>
     ADR   R0,Dir
thr1 LDRB  R3,[R0,#1]!
     CMP   R3,#0
     STRNEB R3,[R1],#1       ;move directory to Blk
     BNE   thr1
     MOV   R3,#"."           ;add ".f." for fortran source
     STRB  R3,[R1],#1
     MOV   R8,R1             ;address for file name
     STRB  R3,[R1,#1]
     MOV   R3,#"f"
     STRB  R3,[R1],#2
thr2 LDRB  R3,[R4],#1
     STRB  R3,[R1],#1        ;add <name>
     CMP   R3,#0
     BNE   thr2
     MOV   R1,R2             ;restore R1
     MOV   R0,#0             ;for "reason processing"
     SWI   DDEUtils_ThrowbackSend
     MOV   R0,#&4D
     ADR   R1,Name+4
     ADR   R2,edirt
     SWI   OS_Find           ;open the file "e.<name>"
     MOV   R1,R0
     LDR   R2,[sp,#4]        ;restore R2
     MOV   R7,#0             ;count of errors
thr3 ADR   R0,quot           ;search for file name
     BL    find
     BNE   thr8
     MOV   R5,R8             ;address for file name
thr4 SWI   OS_BGet
     SUBS  lr,R0,#34
     STRNEB R0,[R5],#1
     BNE   thr4
     STRB  lr,[R5],#1
     ADR   R0,line
     BL    find              ;search for " line "
     BNE   thr8
     MOV   R3,#0             ;line # accumulator
thr5 SWI   OS_BGet
     CMP   R0,#":"
     SUBLT R0,R0,#"0"
     ADDLT R3,R3,R3,LSL#2
     ADDLT R3,R0,R3,LSL#1    ;accumulate line number
     BLT   thr5
     SWI   OS_BGet
     SWI   OS_BGet           ;1st character of error type
     CMP   R0,#"F"
     ADREQ R5,ftl0
     BEQ   thr9
     MOV   R4,#2             ;serious error
     CMP   R0,#"W"
     MOVEQ R4,#0             ;warning
     CMP   R0,#"E"
     MOVEQ R4,#1             ;error
thr6 SWI   OS_BGet
     CMP   R0,#":"
     BNE   thr6              ;skip rest of error type
     SWI   OS_BGet           ;skip blank
     MOV   R6,R5
thr7 SWI   OS_BGet
     CMP   R0,#31
     MOVLE R0,#0             ;null terminate
     STRB  R0,[R6],#1        ;store error message
     BGT   thr7
     MOV   R0,#1             ;error details
     SWI   DDEUtils_ThrowbackSend
     ADD   R7,R7,#1          ;count errors
     B     thr3              ;loop for more errors
thr8 CMP   R7,#0             ;check if any errors
     BNE   thra
     ADR   R5,esc0
     MOV   R3,#0             ;"line" zero
thr9 STMFD sp!,{R1-R3}       ;save file handle & line number
     ADD   R0,R2,#Msgds-Blk  ;messagetrans file descriptor
     ADD   R2,R2,#200        ;message address
     MOV   R3,#56
     MOV   R1,R5
     SWI   MessageTrans_Lookup
     MOV   R5,R2
     LDMFD sp!,{R1-R3}       ;restore file handle and line number
     MOV   R0,#2
     MOV   R4,#0
     SWI   DDEUtils_ThrowbackSend
thra MOV   R0,#0
     SWI   OS_Find           ;close file
     SWI   DDEUtils_ThrowbackEnd
     LDMFD sp!,{R0-R8,pc}  ;return
esc0 DCB   "esc",0
ftl0 DCB   "ftl",0
edirt  DCB "e.",0,0
quot   DCB 13,34,0,0     ;<return>"  changed from 10 to 13 for 32-bit compiler 30/11/2017
redit  DCB "FDE$edit",0
line   DCB " line ",0,0
;
     ALIGN
topopen;  open top window on top;
     STMFD sp!,{R0-R10,lr}
top0 LDR   R0,wT
     STR   R0,Blk
     SWI   Wimp_GetWindowState; (uses Blk to 36)
top1 LDMIB R1,{R2-R8}      ;get dimensions: x,y(min), x,y(max), x,y(scroll),
     ADR   R9,Nf77-4
     ADD   R1,R1,#offset   ;get to new block area
     SUB   R5,R5,#304      ;absolute y for top of file windows
     ADD   R5,R5,#4        ;move it inside top window
     MOV   R10,#4          ;#windows to open
     ADD   R6,R2,#24-256
     MOV   R3,#0           ;max # files
tpl1 ADD   R6,R6,#256
     LDR   R7,[R9,#4]!     ;get next # files
     CMP   R10,#1
     SUBLE R1,R1,#offset   ;return to main window
     BLE   tpl2
     CMP   R7,#1
     BLT   tpl3            ;skip file window with no files
     CMP   R7,#Mvisfile
     MOVGT R7,#Mvisfile    ;limit it to allowed maximum
     ADD   R7,R7,R7,LSL#2
     MOV   R7,R7,LSL#3     ;height of window
     CMP   R7,R3
     MOVGT R3,R7           ;get 40 * max # files (other than aif file)
     LDR   R0,[R9,#wFfl-Nf77];window handle
     STR   R0,Blk
     SWI   Wimp_GetWindowState
     STR   R5,Blk+16       ;maximum y
     SUB   R0,R5,R7
     STR   R0,Blk+8        ;minimum y
     STR   R6,Blk+4        ;minimum x
     ADD   R0,R6,#192
     STR   R0,Blk+12       ;maximum x
tpl2 STR   R8,Blk+28       ;window stack position
     LDR   R8,Blk          ;current window handle
     CMP   R10,#1          ;check for top window
     ADDEQ R3,R3,#312      ;add top window size with no files
     LDREQ R0,Blk+16       ;top of top window
     SUBEQ R0,R0,R3
     STREQ R0,Blk+8        ;bottom of top window
     SWI   Wimp_OpenWindow ;open window
tpl3 SUBS  R10,R10,#1
     BGT   tpl1            ;go do next window
     LDR   R0,mcf          ;mcf is count of filer widows to be reopened
     SUBS  R0,R0,#1        ;now &81, &41, &01 or negative
     STRGE R0,mcf          ;reset flag
     LDRGE R0,fwpoll
     LDMLTFD sp!,{R0-R10,pc} ;return after main window
     BL    poll            ;do little wimp poll
     B     top0            ;do it all again 3 times after mode change!
topopen1;  entry with window state loaded from Wimp_Poll
     STMFD sp!,{R0-R10,lr}
     B     top1
;
windc;    close window
     SWI   Wimp_CloseWindow
     LDR   R0,wT
     LDR   R2,Blk
     CMP   R0,R2
     LDMNEFD sp!,{R0,R1,pc};return if not top window
     ADR   R2,wF
     MOV   R3,#6        ;6 windows to close
lwc1 LDR   R0,[R2],#4   ;window handle
     STR   R0,Blk
     SWI   Wimp_CloseWindow
     SUBS  R3,R3,#1
     BGT   lwc1
     LDMFD sp!,{R0,R1,pc};return
;
   [ debugon=1    ; debug routines
;
debuga; print string at R0 on screen
     STMFD sp!,{R0,lr}
     SWI   &100+4        ;VDU4,26
     SWI   &100+26
     SWI   &02           ;print string
     SWI   &100+5        ;VDU5
     LDMFD sp!,{R0,pc}
;
debugfa;   send string to file 'dbg'
     STMFD sp!,{R0-R2,lr}
     MOV   R2,R0           ;pointer to string
     MOV   R0,#&83         ;to open a new file
     ADR   R1,dbgnam       ;file name
     SWI   OS_Find         ;open the file
     MOV   R1,R0           ;move the file handle
dbf1 LDRB  R0,[R2],#1
     CMP   R0,#32
     BLT   dbf2
     SWI   OS_BPut         ;write bytes to file
     B     dbf1
dbf2 MOV   R0,#0
     SWI   OS_Find         ;close file
     LDMFD sp!,{R0-R2,pc}
dbgnam DCB "$.debug",0
;
debugf;   send hex of R0 to 'dbg'
     STMFD sp!,{R0-R4,lr}
     ADR   R1,debugs+2
     MOV   R2,#14
     SWI   &D4             ;convert to ASCII(hex)
     MOV   R0,#&C3         ;to open a new file
     ADR   R1,dbgnam       ;file name
     SWI   OS_Find         ;open the file
     CMP   R0,#0
     MOVEQ R0,#&83
     SWIEQ OS_Find
     MOV   R1,R0           ;move the file handle
     MOV   R0,#2
     SWI   &09             ;OS_Args to find extent
     MOV   R4,R2
     ADR   R2,debugs+2
     MOV   R3,#8
     MOV   R0,#1
     SWI   OS_GBPB
     MOV   R0,#10
     SWI   OS_BPut         ;line feed to end
     MOV   R0,#0
     SWI   OS_Find         ;close file
     LDMFD sp!,{R0-R4,pc}
;
debug; print R0 on screen in hex
     STMFD sp!,{R0-R2,lr}
     SWI   &01
     DCB   4,28,70,59,79,1,31,0 ;VDU4,28,70,59,79,1,31:PRINTTAB(
     ADR   R1,debugs+2
     MOV   R2,#14
     SWI   &D4           ;convert to ASCII(hex)
     LDRB  R1,[R0,#-1]!  ;get line number
     ADD   R1,R1,#1
     CMP   R1,#50
     MOVGE R1,#0
     STRB  R1,[R0],#-1   ;store line number
     MOV   R1,#10
     SWI   OS_WriteN     ;row,line)STR$~number
     SWI   &105          ;VDU5
     LDMFD sp!,{R0-R2,pc}
debugs
     DCB    0    ;column
     DCB   50    ;line number
     %     14
     ]    ; end debug routines
;
     AREA   FDE_Menu,DATA
Menu
Ntop   EQU   4            ;#menu items -1
       DCB   "Fortran 77",0,0 ;12 bytes of title
       DCB   7,2,7,0      ;colours
       DCD   200,44,0     ;width, height and gap
       DCD   0,-1,&07009031
       DCB   "info  ",0,0,0,0,0,0
       DCD   0,-1,&07009031
       DCB   "help",0,0,0,0,0,0,0,0
       DCD   0,-1,&07009031
       DCB   "save options"
Chkdat DCD   0,-1,&07009031
       DCB   "check dates",0
       DCD   128,-1,&07009031
       DCB   "quit",0,0,0,0,0,0,0,0
Chkdis EQU   Chkdat-Menu
;
     AREA   FDE_Data,DATA,NOINIT
;                     
; stack required for:-
; poll:click:exec:execf77:comperr:delnam:testact:addnam:topopen
;  3     0    2      4     10       8      10      11      13
;      total = 61 (+3 for luck) = 256 bytes
lstack EQU   256      ;length of stack
licons EQU   264      ;length for indirected icons
lmsgs  EQU   4096     ;space for messages
lblk   EQU   300      ;length of standard block
        ^    0,R1
Blk    #     lblk     ;standard wimp block
wF     #     4        ;fortran options window
wL     #     4        ;link options window
wR     #     4        ;run options window
wFfl   #     4        ;fortran file list window
wOfl   #     4        ;object file list window
wLfl   #     4        ;library file list window
wT     #     4        ;Top window handle
Opt    #     4        ;current options
OptOld #     4        ;original options
Act    #     4        ;action flag bytes 0 or >0
Next   #     4        ;next slot size
Free   #     4        ;free memory
mcf    #     4        ;mode change flag
Ref    #     4        ;message reference number
Mlib   #     4        ;total # libraries
Nf77   #     4        ;# source files
Naof   #     4        ;# aof files                
Nlib   #     4        ;# selected libraries
Nrun   #     4        ;# aif files (0 or 1)
Name   #     16       ;current file name (why not 12 bytes?)
Note   #     24       ;action icon text
Aif    #     12       ;aif file name
Dir    #     256      ;working directory, byte 1 = count, null term.
Icons  #     licons   ;space for icons
RunOp  EQU   Icons
;       #     (Blk-@):AND:15
;;   must arrive here at a 16 byte boundary
Msgds  #     16       ;messages file descriptor
Msgs   #     lmsgs    ;space for messages
lcmn   EQU   Msgs-Blk+lmsgs+lstack ; length of workspace
store  %     lcmn     ;location for following variables
blks   EQU   store+lstack
     END
